/ / /B/F BDC DAILY SCHEDULE PRINT /- - - - -- / /RCF/TJU:930 / /TO PRINT DAILY SCHEDULE ON INDEX CARDS / /MODIFIED VERSION OF BFNDSU (714) /MODIFIED VERSION 840 - DEC 76 - TO LOOP TO BEGINNING / .IODEV -2,-3,1,7,4,2 /INITIALIZE: .INIT -2,0,0 .INIT -3,1,0 .INIT 7,0,MTERR# .INIT 4,1,0 LAC (MES3 JMS WRITE LAC (MES3A JMS WRITE JMS READ /WAIT FOR /READ IN TSTAB BEGIN .INIT 1,0,0 .TRAN 1,0,2,DBUF,911 .WAIT 1 .CLOSE 1 .INIT 2,1,0 LAC DBUF+66 DAC YRI# E2 LAC (MES2 JMS WRITE JMS READ LAC RBUF+2 SAD (64000 JMP REWIND-2 /READ IN DATE LAC (E2 DAC ERJ# LAC (C1BUF-1 /USED TEMP. DAC* (10 LAC (RBUF+1 DAC* (11 LAW -11 DAC CNT# GO1 LAC* 11 /UNPACK MO/DA/YR INTO C1BUF LMQ LLS 1007 JMS STORE LLS 1007 JMS STORE LLS 1004 DAC SAV1# LAC* 11 LMQ LAC SAV1 LLS 3 JMS STORE LLS 1007 JMS STORE LLS 1007 JMS STORE JMP GO1 DON1 LAC (C1BUF-1 DAC* (10 LAC (MOE-1 DAC* (11 LAC (EC DAC PT# LAW -3 DAC CNT /WORD COUNTER LAW -12 DAC CNT2# /CHAR COUNTER DZM SAV2# LAW -3 DAC CNT1# /DIGIT COUNTER GO2 ISZ CNT2 /ASSEMBLE DATE JMP .+2 JMP ERR LAC* 10 SAD* PT JMP DON2 JMS NUMCHK DAC SAV1 LAC SAV2 JMS MUL10 TAD SAV1 DAC SAV2 ISZ CNT1 JMP GO2 JMP ERR DON2 LAC SAV2 DAC* 11 ISZ PT ISZ CNT JMP GO2-3 LAC MOE /CHECK FOR LEGAL MONTH TAD (-15 SMA JMP ERR TAD (15 SPA!SNA!CLL JMP ERR ALS 5 /MOE INTO SCWD DAC SCWD# LAC MOE TAD (DBUF-1 DAC PT LAC DAE SPA!SNA JMP ERR TAD* PT SMA!SZA /CHK IF LEGAL DAY FOR MOE JMP ERR LAC DAE XOR SCWD CLL ALS 11 DAC SCWD /DAY IN SCWD LAC DBUF+66 /YRI JMS MINUS TAD YRE DAC YRE CLL!RAR SZA!RAL JMP ERR /0,1 ALLOWED /FIND ADD OF DAY IN TSTAB LAC YRE SZA LAC (14 TAD MOE DAC SAV1 LAC DBUF+64 /MOI JMS MINUS TAD SAV1 DAC SAV1 /RELMO SPA JMP ERR /BEHIND TABLE TAD (-11 SMA JMP ERR /AHEAD OF TABLE LAC SAV1 TAD (DBUF+15 DAC PT LAC* PT TAD DAE /NRD DAC SAV1 SPA JMP ERR /IN FRONT OF DAI .DEC TAD (-213 .OCT SMA!CLL JMP ERR /TOO FAR AHEAD LAC SAV1 CLL RTL TAD (DBUF+71 DAC SAV1 TAD (1 DAC SAV2 LAC* SAV1 /GET TS SZA JMP .+5 LAC SAV1 /HERE IF 1ST SHIFT IS NW => USE 2ND TAD (2 DAC PT LAC* PT AND (1 DAC S1# CLL!RAL JMS MINUS DAC SHIFT1# /0=AM/PM, -2=PM/EVE LAC* SAV2 SZA JMP .+5 LAC SAV2 TAD (2 DAC PT LAC* PT AND (1 DAC S2# CLL!RAL JMS MINUS DAC SHIFT2# LAC DBUF+64 JMS MINUS TAD MOE SMA!CLA JMP .+2 LAC (1 TAD DBUF+66 CLL RTL XOR SCWD .DEC DAC PBUF+129 .OCT LAC (PBUF-1 DAC* (11 LAW -77 DAC CNT1 LAC (C1BUF-1 DAC* (10 LAW -100 DAC CNT DZM* 10 /ZERO C1BUF,C2BUF ISZ CNT JMP .-2 GO3 LAC (INBUF DAC PT1# /PTR FOR OUTPUT DAC* (13 /PTR FOR SCWD TAD (-1 DAC* (14 /PTR FOR EOF DAC* (10 /PTR FOR PNAME LAW -12 DAC CNT LAW -12 DAC MCNT# MTR1 DZM MTERR .TRAN 7,0,0,DBUF-1,801 /READ BLK OF MASTER .WAIT 7 LAC MTERR SNA JMP GO4 ISZ MCNT JMP .+2 JMP BADBLK .MTAPE 7,2 .WAIT 7 JMP MTR1 /CHECK EACH SCHEDULED PATIENT FOR MATCH GO4 LAC* 14 DAC* (15 LAC* 15 SAD (-1 JMP DONE LAC* 13 DAC PT LAC* PT /GET SCWD AND (777000 /MASK YR,TS,SHIFT,CNUM XOR SCWD SNA JMP .+3 ISZ* (10 JMP NEXT /MOVE 1ST 2 WORDS OF NAME TO PBUF ISZ CNT1 JMP .+2 JMP NERR LAC* 10 DAC* (15 LAC* 15 DAC* 11 LAC* 15 DAC* 11 /WRITE SCHED BUFFER OUT LAC* PT1 TAD (1 DAC TRO+3 TRO .TRAN 2,3,274,DBUF,80 /STORE BLOCK # IN APPROPRIATE SLOT LAC* PT RTR AND (3 DAC SAV1 /SHIFT LAC* PT RTR RTR AND (17 DAC SAV3# /TS LAC* PT AND (3 SZA JMP C2A LAC SAV1 /C#1 - GET SHIFT TAD SHIFT1 /CORRECT FOR AM/PM OR PM/EVE DAC SAV2 LAC (C1BUF JMP .+5 C2A LAC SAV1 TAD SHIFT2 DAC SAV2 LAC (C2BUF DAC SWPT# LAC SAV2 CLL MUL 20 LACQ /CORRECT FOR SHIFT TAD SAV3 /CORRECT FOR TS TAD SWPT DAC SWPT LAC TRO+2 DAC* SWPT /STORE BLOCK # .WAIT 2 LAC TRO+2 TAD (-1 DAC TRO+2 NEXT ISZ PT1 ISZ CNT JMP GO4 JMP GO3 DONE .MTAPE 7,0 LAW -117 DAC CNT LAC (DBUF-1 DAC* (10 LAW -1 DAC* 10 DZM* 10 ISZ CNT JMP .-2 LAC TRO+2 DAC .+3 .TRAN 2,3,274,DBUF,80 /WRITE EOF .WAIT 2 /READY FOR PRINT OUT .CLOSE 2 .INIT 2,0,0 LAW -2 DAC SWPT /CNTR FOR 2 CENTERS LAC S1 DAC SHIFT# TAD (STIM DAC PT LAC* PT DAC PTIM# /PT TO TIME FOR SHIFT1, TS 0 LAC (C1BUF-1 DAC* (10 LAC (C2BUF-1 DAC* (13 LAW -2 DAC CNT0# LAW -1 DAC TS# GOPRNT LAC (MES17 /FF - 3" JMS PUNCH LAC (MES22 JMS PUNCH ISZ TS NOP LAC (M9B DAC PT LAC TS CLL MUL 14 LACQ TAD* PTIM DAC SAV2 .DEC TAD (-720 /AM OR PM .OCT SMA JMP .+3 LAC (AM-1 JMP AMGO DAC SAV2 .DEC TAD (-60 .OCT SMA JMP .+4 LAC SAV2 .DEC TAD (720 .OCT DAC SAV2 LAC (PM-1 AMGO DAC* (15 LAC* 15 DAC M9B+4 LAC* 15 DAC M9B+5 LAC SAV2 /STORE TIME CLL IDIV 74 DAC SAV2 /MIN LACQ /HR JMS TDSTR LAC (35000 /":" AS 4TH CHAR DAC M9B+1 LAC (M9B+2 DAC PT LAC SAV2 JMS TDSTR LAC M9B+2 /CHK IF LEADING 0 OF MINUTE REMOVED AND (774000 XOR (200000 SZA JMP .+4 LAC M9B+2 XOR (100000 /MAKE SPACE A 0 DAC M9B+2 LAC (M9C /STORE DATE DAC PT LAC MOE JMS TDSTR LAC (27400 /"/" AS 4TH CHAR DAC M9C+1 LAC (M9C+2 DAC PT LAC DAE JMS TDSTR LAC (27400 DAC M9C+3 LAC (M9C+4 DAC PT LAC YRE TAD YRI JMS TDSTR LAC SWPT SAD (-1 JMP .+3 LAC* 10 JMP .+2 LAC* 13 SNA JMP NOPAT DAC TR3+2 TR3 .TRAN 2,2,10,DBUF,80 /READ IN PATIENT FILE .WAIT 2 LAC (MES9 JMS PUNCH LAC (MES22 JMS PUNCH LAC (DBUF-1 DAC* (11 LAC (M10A-1 DAC* (12 LAW -14 JMS MOVE /MOVE PAT NAME TO MES10 LAC (MES10 JMS PUNCH LAC (DBUF+13 /STREET TO MES11 DAC* (11 LAC (M11A-1 DAC* (12 LAW -14 JMS MOVE LAC (MES11 JMS PUNCH LAC (DBUF+27 /CITY TO MES11 DAC* (11 LAC (M11A-1 DAC* (12 LAW -14 JMS MOVE LAC (MES11 JMS PUNCH LAC (DBUF+43 DAC* (11 LAC (M13A-1 DAC* (12 LAW -6 JMS MOVE LAC (MES13 JMS PUNCH LAC (MES22 JMS PUNCH LAC (M14A /SETUP MES14 - STORE AGE DAC PT LAC DBUF+116 LMQ LLS 1007 /AGE TAD (55 JMS TDSTR LAC DBUF+116 /STORE NEW OR REPEAT AND (2000 SZA JMP .+3 LAC (NEW-1 JMP .+2 LAC (OLD-1 DAC* (15 LAC* 15 DAC M14B LAC* 15 DAC M14B+1 LAC* 15 DAC M14B+2 LAC* 15 DAC M14B+3 LAC (M14C /ORG DAC PT LAC DBUF+116 RTR RTR AND (77 JMS TDSTR LAC (M14D /OPR DAC PT LAC DBUF+116 AND (17 JMS TDSTR LAC (MES14 JMS PUNCH LAC (MES22 JMS PUNCH LAC (DBUF+51 /DR NAME TO MES15 DAC* (11 LAC (M15A-1 DAC* (12 LAW -14 JMS MOVE LAC (MES15 JMS PUNCH LAC (DBUF+65 /STREET TO MES16 DAC* (11 LAC (M16A-1 DAC* (12 LAW -14 JMS MOVE LAC (MES16 JMS PUNCH LAC (DBUF+101 /CITY INTO MES16 DAC* (11 LAC (M16A-1 DAC* (12 LAW -14 JMS MOVE LAC (MES16 JMS PUNCH JMP OUT NOPAT LAC (MES9 JMS PUNCH OUT LAW -1 TAD TS DAC TS ISZ SWPT JMP GOPRNT ISZ TS NOP LAW -2 DAC SWPT LAC TS SAD (17 JMP OUT1 JMP GOPRNT OUT1 LAW -1 DAC TS ISZ PTIM ISZ CNT0 JMP GOPRNT .CLOSE 2 .WAIT 7 JMP BEGIN LAC (MES26 JMS WRITE REWIND .INIT 2,1,0 .CLEAR 2 .CLOSE 7 .CLOSE 4 .CLOSE -2 .CLOSE -3 .CLOSE 2 .EXIT / BADBLK LAC (MES28 JMS WRITE JMP REWIND / WRITE XX DAC .+3 .WRITE -3,2,MES1,34 .WAIT -3 JMP* WRITE / READ XX .READ -2,2,RBUF,20 .WAIT -2 JMP* READ RBUF .BLOCK 22 / ERR LAC (MES1 JMS WRITE JMP* ERJ / NUMCHK XX TAD (-72 SMA JMP ERR TAD (12 SPA JMP ERR JMP* NUMCHK / MUL10 XX CLL MUL 12 LACQ JMP* MUL10 / MOE 0 DAE 0 YRE 0 EC 57 57 15 .DEC DBUF .BLOCK 801 PBUF .BLOCK 130 C1BUF .BLOCK 32 C2BUF .BLOCK 32 .OCT / PUNCH XX DAC .+3 .WRITE 4,2,MES1,34 .WAIT 4 JMP* PUNCH / MINUS XX CMA TAD (1 JMP* MINUS / TDSTR XX CLL IDIV 12 DAC SAV3 LACQ SNA LAW -20 TAD (60 ALSS 13 DAC* PT LAC SAV3 TAD (60 ALSS 4 XOR* PT DAC* PT JMP* TDSTR / STIM TIME0 TIME1 .DEC TIME0 495 750 TIME1 750 1005 .OCT AM .ASCII " AM " PM .ASCII " PM " / MOVE XX DAC CNTM# LAC* 11 DAC* 12 ISZ CNTM JMP .-3 JMP* MOVE / NEW .ASCII "NEW " OLD .ASCII "REPEAT " / STORE XX DAC* 10 SAD (15 JMP DON1 ISZ CNT JMP* STORE JMP ERR .DEC INBUF DBUF-1 DBUF+79 DBUF+159 DBUF+239 DBUF+319 DBUF+399 DBUF+479 DBUF+559 DBUF+639 DBUF+719 DBUF+799 .OCT / NERR LAC (MES25 JMS WRITE JMP REWIND / MES1 MES2-MES1/2*1000 0 .ASCII "?"<15> MES2 MES3-MES2/2*1000 0 .ASCII "ENTER DATE (MO/DA/YR) [CR TO QUIT]:"<175> MES3 MES3A-MES3/2*1000 0 .ASCII " "<12><12>"**BFDSPR [930]**"<12>"MOUNT SCHEDULE FILE" .ASCII " ON MT #1"<15> MES3A MES9-MES3A/2*1000 0 .ASCII "DST ON DT#1, SCRATCH ON DT#2, LOAD INDEX CARDS & TYPE" .ASCII " A RETURN"<15> MES9 MES10-MES9/2*1000 0 .ASCII " " M9B .BLOCK 6 .ASCII " " M9C .BLOCK 6 .ASCII <15> MES10 MES11-MES10/2*1000 0 .ASCII " PATIENT: " M10A .BLOCK 14 .ASCII <15> MES11 MES13-MES11/2*1000 0 .ASCII " " M11A .BLOCK 14 .ASCII <15> MES13 MES14-MES13/2*1000 0 .ASCII " PHONE # " M13A .BLOCK 6 .ASCII <15> MES14 MES15-MES14/2*1000 0 .ASCII " AGE: " M14A .BLOCK 2 .ASCII " " M14B .BLOCK 4 .ASCII "ORG: " M14C .BLOCK 2 .ASCII " OPR: " M14D .BLOCK 2 .ASCII <15> MES15 MES16-MES15/2*1000 0 .ASCII " PHYSICIAN: " M15A .BLOCK 14 MES16 MES17-MES16/2*1000 0 .ASCII " " M16A .BLOCK 14 .ASCII <15> MES17 MES22-MES17/2*1000 0 .ASCII <14><15> MES22 MES25-MES22/2*1000 0 .ASCII " "<15> MES25 MES26-MES25/2*1000 0 .ASCII " "<12><12>"TOO MANY SCHEDULED"<12><15> MES26 MES28-MES26/2*1000 0 .ASCII " "<12>"DONE"<12><12><15> MES28 END28-MES28/2*1000 0 .ASCII " "<12>"TERMINAL MTAPE ERROR"<15> END28=. .ENDW