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