| 1 | SDAMOL ;ALB/CAW - Retroactive Appt. List; 4/15/92 | 
|---|
| 2 | ;;5.3;Scheduling;**132**;Aug 13, 1993 | 
|---|
| 3 | ; | 
|---|
| 4 | ; | 
|---|
| 5 | EN ; main entry point | 
|---|
| 6 | ; | 
|---|
| 7 | N DIC,SDBEG,SDEND,SDBD,SDED,SDSEL,VAUTD,VAUTC,VAUTS,SDNPDB | 
|---|
| 8 | I '$$INIT G ENQ | 
|---|
| 9 | I '$$NPDB G ENQ | 
|---|
| 10 | I '$$RANGE() G ENQ | 
|---|
| 11 | I '$$DIV() G ENQ | 
|---|
| 12 | I '$$SELECT() G ENQ | 
|---|
| 13 | I SDSEL=1,'$$STOP() G ENQ | 
|---|
| 14 | I SDSEL=2,'$$CLINIC() G ENQ | 
|---|
| 15 | W !! S %ZIS="PMQ" D ^%ZIS I POP G ENQ | 
|---|
| 16 | I '$D(IO("Q")) D MAIN^SDAMOL1 G ENQ | 
|---|
| 17 | S Y=$$QUE | 
|---|
| 18 | ENQ D:'$D(ZTQUEUED) ^%ZISC | 
|---|
| 19 | K ^TMP("SDRL",$J),^TMP("SDRAL",$J) | 
|---|
| 20 | Q | 
|---|
| 21 | ; | 
|---|
| 22 | INIT() ; -- init vars | 
|---|
| 23 | S SDDIV=0 | 
|---|
| 24 | Q 1 | 
|---|
| 25 | ; | 
|---|
| 26 | RANGE() ; select date range | 
|---|
| 27 | ;  input: none | 
|---|
| 28 | ; output: SDBEG := begin date | 
|---|
| 29 | ;         SDEND := end date | 
|---|
| 30 | ; return: was selection made [ 1|yes   0|no] | 
|---|
| 31 | ; | 
|---|
| 32 | W !!,$$LINE("Date Range Selection") | 
|---|
| 33 | N BEGDATE,ENDDATE | 
|---|
| 34 | S (SDBEG,SDEND)=0 | 
|---|
| 35 | S SDT00="AEX" D DATE^SDUTL I $D(SDED) S SDBEG=SDBD,SDEND=SDED+.2359 | 
|---|
| 36 | Q SDEND | 
|---|
| 37 | DIV() ; -- get division data | 
|---|
| 38 | ;  input: none | 
|---|
| 39 | ; output: VAUTD := divs selected (VAUTD=1 for all) | 
|---|
| 40 | ; return: was selection made [ 1|yes   0|no] | 
|---|
| 41 | ; | 
|---|
| 42 | W !!,$$LINE("Division Selection") | 
|---|
| 43 | D ASK2^SDDIV I Y<0 K VAUTD | 
|---|
| 44 | Q $D(VAUTD)>0 | 
|---|
| 45 | STOP() ; -- get stop code data | 
|---|
| 46 | ;  input: none | 
|---|
| 47 | ; output: VAUTS := stop codes selected (VAUTS=1 for all) | 
|---|
| 48 | ; return: was selection made [ 1|yes   0|no] | 
|---|
| 49 | ; | 
|---|
| 50 | W !!,$$LINE("Stop Code Selection") | 
|---|
| 51 | S VAUTSTR="Stop Code",VAUTNI=2,VAUTVB="VAUTS" | 
|---|
| 52 | S DIC="^DIC(40.7,",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),U,3)=""""" | 
|---|
| 53 | D FIRST^VAUTOMA I Y<0 K VAUTS | 
|---|
| 54 | Q $D(VAUTS)>0 | 
|---|
| 55 | SELECT() ; -- get selection criteria | 
|---|
| 56 | ;  input: none | 
|---|
| 57 | ; output: SDSEL := criteria selected | 
|---|
| 58 | ; return: was selection made [ 1|yes   0|no] | 
|---|
| 59 | ; | 
|---|
| 60 | W !!,$$LINE("Visit Selection Criteria") | 
|---|
| 61 | S DIR(0)="S^1:Stop Code(s);2:Clinic(s)" | 
|---|
| 62 | S DIR("A")="Find Visits By",DIR("B")="Stop Code(s)" | 
|---|
| 63 | D ^DIR K DIR S SDSEL=$S($D(DIRUT):0,1:+Y) | 
|---|
| 64 | Q SDSEL>0 | 
|---|
| 65 | ; | 
|---|
| 66 | CLINIC() ; -- get clinic data | 
|---|
| 67 | ;  input: VAUTD  := divisions selected | 
|---|
| 68 | ; output: VAUTC := clinic selected (VAUTC=1 for all) | 
|---|
| 69 | ; return: was selection made [ 1|yes   0|no] | 
|---|
| 70 | ; | 
|---|
| 71 | W !!,$$LINE("Clinic Selection") | 
|---|
| 72 | D CLINIC^SDAMO0 | 
|---|
| 73 | I Y<0 K VAUTC | 
|---|
| 74 | CLINICQ Q $D(VAUTC)>0 | 
|---|
| 75 | ; | 
|---|
| 76 | NPDB() ; -- get which type of database check (credit or database) | 
|---|
| 77 | ;  input: none | 
|---|
| 78 | ; output: SDNPDB -- type of database check [WORLOAD | DATABASE] | 
|---|
| 79 | ; return: was selection made [ 1|yes   0|no] | 
|---|
| 80 | ; | 
|---|
| 81 | W !!,$$LINE("NPDB Close-Out Check Selection") | 
|---|
| 82 | S DIR(0)="S^D:Database Update Only;W:Workload Credit" | 
|---|
| 83 | S DIR("A")="Type of Close-Out Check",DIR("B")="Workload Credit" | 
|---|
| 84 | D ^DIR K DIR | 
|---|
| 85 | ; | 
|---|
| 86 | ; -- set piece number related to CLOSEOUT^SCDXFU04 call or 0 | 
|---|
| 87 | S SDNPDB=$S($D(DIRUT):0,Y="D":1,Y="W":2,1:0) | 
|---|
| 88 | Q SDNPDB>0 | 
|---|
| 89 | ; | 
|---|
| 90 | LINE(STR) ; -- print line | 
|---|
| 91 | ;  input: STR := text to insert | 
|---|
| 92 | ; output: none | 
|---|
| 93 | ; return: text to use | 
|---|
| 94 | ; | 
|---|
| 95 | N X | 
|---|
| 96 | S:STR]"" STR=" "_STR_" " | 
|---|
| 97 | S $P(X,"_",(IOM/2)-($L(STR)/2))="" | 
|---|
| 98 | Q X_STR_X | 
|---|
| 99 | ; | 
|---|
| 100 | QUE() ; -- que job | 
|---|
| 101 | ; return: did job que [ 1|yes   0|no ] | 
|---|
| 102 | ; | 
|---|
| 103 | K ZTSK,IO("Q") | 
|---|
| 104 | S ZTDESC="Retroactive Appointment List",ZTRTN="MAIN^SDAMOL1" | 
|---|
| 105 | F X="VAUTD(","SDBEG","SDEND","VAUTD","VAUTC","VAUTC(","VAUTS","VAUTS(","SDSEL","SDBD","SDED","SDNPDB" S ZTSAVE(X)="" | 
|---|
| 106 | D ^%ZTLOAD W:$D(ZTSK) "   (Task: ",ZTSK,")" | 
|---|
| 107 | Q $D(ZTSK) | 
|---|
| 108 | ; | 
|---|