| 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 |  ;
 | 
|---|