source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMOL.m@ 1078

Last change on this file since 1078 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1SDAMOL ;ALB/CAW - Retroactive Appt. List; 4/15/92
2 ;;5.3;Scheduling;**132**;Aug 13, 1993
3 ;
4 ;
5EN ; 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
18ENQ D:'$D(ZTQUEUED) ^%ZISC
19 K ^TMP("SDRL",$J),^TMP("SDRAL",$J)
20 Q
21 ;
22INIT() ; -- init vars
23 S SDDIV=0
24 Q 1
25 ;
26RANGE() ; 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
37DIV() ; -- 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
45STOP() ; -- 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
55SELECT() ; -- 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 ;
66CLINIC() ; -- 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
74CLINICQ Q $D(VAUTC)>0
75 ;
76NPDB() ; -- 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 ;
90LINE(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 ;
100QUE() ; -- 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 ;
Note: See TracBrowser for help on using the repository browser.