source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW17.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.4 KB
Line 
1SCRPW17 ;RENO/KEITH/MRY - Prompts for clinic related outputs ; 21 JUL 2000 1:45 PM
2 ;;5.3;Scheduling;**139,144,155,222**;AUG 13, 1993
3ASK(SDADD,SDRES,SD,SDFMT,SDORD,SDSDT) ;Ask for clinic report parameters
4 ;Required input: SDADD='1' to prompt user for "addons", "0" to not ask
5 ;Required input: SDRES='1' to prompt user for clinic to restart run from, '0' to not ask
6 ;Required input: SD=array name to return clinic selection parameters
7 ;Optional input: SDFMT=default format^suppress prompt (1=yes, 0=no)
8 ;Optional input: SDORD=default print order (A:alphabetic, D:date/time, T:terminal digit)^suppress prompt (1=yes, 0=no)
9 ;Optional input: SDSDT='1' to suppress date prompt
10 ;Output: SD("ADDON")=add-ons date, if selected
11 ; SD("RESTART")="clinic IFN^clinic name" to restart run from, if selected
12 ; SD("DATE")=appointment date to print
13 ; SD("CLINIC",clinicname)=clinic IFN
14 ; SD("FORMAT")=report format (AC:all clinics, SC:selected clinics, RC:range of clinics, SS:selected stop codes, RS:range of stop codes, AG:all clinic groups, SG:selected clinic group)
15 ; SD("GROUP")="clinic group IFN^clinic group name"
16 ; SD("ORDER")=output order (A:alphabetic, D:date/time, T:terminal digit)
17 ; SD("STOPCODE",stopcodenumber)=stop code name
18 ;Output: '0' if abnormal exit occured, '1' otherwise
19 ;
20 N %DT,SDCL1,SDCL2,SDDICA,SDI,SDOUT,SDSC1,SDSC2,DIC,DIR,DTOUT,DUOUT,X,Y
21DT I $G(SDSDT) S SD("DATE")="" G ADD
22 S %DT="AEFX",%DT("A")="Select Appointment Date to Print: " W ! D ^%DT Q:(Y'>0!$D(DTOUT)) 0 S SD("DATE")=$P(Y,".")
23ADD I SDADD K SD("ADDON"),DIR S DIR(0)="S^A:ALL;O:ONLY ADD-ONS",DIR("A")="Include (A)LL or (O)NLY ADD-ONS",DIR("B")="ALL" D ^DIR Q:($D(DTOUT)!$D(DUOUT)) 0 I Y="O" D ADDON Q:'$D(SD("ADDON")) 0
24 I SDRES K SD("RESTART"),DIR S DIR(0)="Y",DIR("A")="Would you like to re-start output from specific clinic",DIR("B")="NO" W ! D ^DIR Q:($D(DTOUT)!$D(DUOUT)) 0 I Y D CLIN Q:'$D(SD("RESTART")) 0
25 I $L($G(SDFMT)),$P(SDFMT,U,2)=1 S SD("FORMAT")=$P(SDFMT,U) G ORD
26 K DIR I $L($G(SDFMT)) S DIR("B")=$S(SDFMT="AC":"ALL CLINICS",SDFMT="SC":"SELECTED CLINICS",SDFMT="RC":"RANGE OF CLINICS",SDFMT="AG":"ALL CLINIC GROUPS",SDFMT="SG":"SELECTED CLINIC GROUP",1:"")
27 I $L($G(SDFMT)) S DIR("B")=$S(SDFMT="SS":"SELECTED STOP CODES",SDFMT="RS":"RANGE OF STOP CODES",1:DIR("B")) K:'$L(DIR("B")) DIR("B")
28 S DIR(0)="S^AC:ALL CLINICS;SC:SELECTED CLINICS;RC:RANGE OF CLINICS;SS:SELECTED STOP CODES;RS:RANGE OF STOP CODES;AG:ALL CLINIC GROUPS;SG:SELECTED CLINIC GROUP",DIR("A")="Select report format"
29 D ^DIR Q:$D(DTOUT)!$D(DUOUT) 0 S SD("FORMAT")=Y
30 K SD("CLINIC") I "SC^RC"[SD("FORMAT") D @SD("FORMAT") Q:'$D(SD("CLINIC")) 0
31 I "SS^RS"[SD("FORMAT") K SD("STOPCODE") D @SD("FORMAT") Q:'$D(SD("STOPCODE")) 0
32 I SD("FORMAT")="SG" K SD("GROUP") D SG Q:'$D(SD("GROUP")) 0
33ORD I $P($G(SDORD),U,2)=1,$L($P(SDORD,U)),"ADT"[$P(SDORD,U) S SD("ORDER")=$P(SDORD,U) G END
34 K DIR S DIR(0)="S^A:ALPHABETIC;D:DATE/TIME;T:TERMINAL DIGIT",DIR("A")="Within clinic, print patients in what order"
35 I $L($P($G(SDORD),U)) S SDORD=$P(SDORD,U),SDORD=$S(SDORD="A":"ALPHABETIC",SDORD="D":"DATE/TIME",SDORD="T":"TERMINAL DIGIT",1:"")
36 S:$L($G(SDORD)) DIR("B")=SDORD D ^DIR Q:$D(DTOUT)!$D(DUOUT) 0 S SD("ORDER")=Y
37END Q 1
38 ;
39CLIN S DIC="^SC(",DIC(0)="AEMQZ",DIC("A")="Select CLINIC: " W ! D ^DIC Q:($D(DTOUT)!$D(DUOUT)) I $P(Y(0),U,3)'="C" W !!,$C(7),"Location selected must be a clinic!",! G CLIN
40 S:+Y>0 SD("RESTART")=Y Q
41 ;
42ADDON K DIR S DIR(0)="D^::AEPX",%DT("A")="Produce output for patients scheduled since what date?",DIR("?",1)="Enter the date of your initial run of this appointment date, that way only"
43 S DIR("?")="appointments scheduled since that date will be included in this run." D ^DIR Q:$D(DTOUT)!$D(DUOUT) S:Y>0 SD("ADDON")=Y Q
44 ;
45SC ;Clinic selector
46 S SDOUT=0 F SDI=1:1:30 S SDCL1=$$SC1("Select CLINIC: ") Q:SDOUT
47 Q
48 ;
49RC ;Clinic range selector
50 S SDCL1=$$SC1("Select beginning CLINIC: ") Q:'$L(SDCL1)
51RCE S SDCL2=$$SC1("Select ending CLINIC: ") I '$L(SDCL2) W !,"Ending clinic must be specified!" K SD("CLINIC") Q
52 I SDCL2']SDCL1 K SD("CLINIC",SDCL2) W !!,$C(7),"Ending clinic must collate after beginning clinic!" G RCE
53 Q
54 ;
55SS ;Stop Code selector
56 S SDOUT=0 F SDI=1:1:30 S SDSC1=$$SS1("Select STOP CODE: ") Q:SDOUT
57 Q
58 ;
59RS ;Stop Code range selector
60 S SDSC1=$$SS1("Select beginning STOP CODE: ") Q:'$L(SDSC1)
61RSE S SDSC2=$$SS1("Select ending STOP CODE: ") I '$L(SDSC2) W !,"Ending Stop Code must be specified!" K SD("STOPCODE") Q
62 I SDSC2']SDSC1 K SD("STOPCODE",SDSC2) W !!,$C(7),"Ending Stop Code must collate after beginning Stop Code!" G RSE
63 Q
64 ;
65SS1(SDDICA) ;Select a Stop Code
66SS2 K DIC S DIC("A")=SDDICA,DIC="^DIC(40.7,",DIC(0)="AEMQZ" D ^DIC I $D(DTOUT)!$D(DUOUT)!(X="") S SDOUT=1 Q ""
67 I '$P(Y(0),U,2) W $C(7)," ???" G SS2
68 I $P(Y(0),U,3),$P(Y(0),U,3)'>DT W !,"Only active Stop Codes can be selected!",! G SS2
69 S SD("STOPCODE",$P(Y(0),U,2))=$P(Y,U,2) Q $P(Y(0),U,2)
70 ;
71SG ;Select clinic group
72 K DIC S DIC="^SD(409.67,",DIC(0)="AEMQ" D ^DIC Q:$D(DTOUT)!$D(DUOUT) S:+Y>0 SD("GROUP")=Y Q
73 ;
74SC1(SDDICA) ;Select a clinic
75SC2 K DIC S DIC("A")=SDDICA,DIC="^SC(",DIC(0)="AEMQZ" D ^DIC I $D(DTOUT)!$D(DUOUT)!(X="") S SDOUT=1 Q ""
76 I $P(Y(0),U,3)'="C" W !,"Location selected must be a clinic!",! G SC2
77 S SD("CLINIC",$P(Y,U,2))=$P(Y,U) Q $P(Y,U,2)
78 ;
79DIVA(SDDIV) ;Ask for division(s)
80 ;Required input: SDDIV=array to return responses (pass by reference)
81 ;Output: '1' if successful, '0' if not
82 ;Output: SDDIV='0' if 'all', '1' if specific divisions^text: "all" or institution name^division ifn, for non-multidivisional
83 ;Output: SDDIV(division ifn)=division name
84 N SDX,SDOUT S SDOUT=0 K SDDIV
85 S SDX=$G(^DG(43,1,"GL")) I '$$PRIM^VASITE() W !!,$C(7),"No medical center defined in site parameters!" Q 0
86 I '$P(SDX,U,2) S SDDIV="0^"_$P($G(^DG(40.8,$$PRIM^VASITE(),0)),U)_U_$$PRIM^VASITE() Q 1
87 F SDX=1:1 D DIVA1 Q:SDOUT
88 I $D(SDDIV)>1 S SDDIV="1^SELECTED DIVISIONS" Q 1
89 Q $D(SDDIV)
90 ;
91DIVA1 N DIC W ! S DIC="^DG(40.8,",DIC(0)="AEMQ",DIC("A")=$S(SDX=1:"For Medical Center Division: ALL// ",1:"Select another division: ")
92 D ^DIC I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
93 I SDX=1,X="" S SDOUT=1,SDDIV="0^ALL DIVISIONS" Q
94 I X="" S SDOUT=1 Q
95 I Y>0 S SDDIV(+Y)=$P(Y,U,2)
96 Q
97 ;
98ERRSUB(SDX) ;Return substitute error message for ^SD(409.76) entry
99 ;Required input: SDX=external message code from ^SD(409.76) file
100 ;Output: Substitute error message if successful, null if not
101 Q $P($T(@("Z"_SDX)),";",3)
102 ;
103 ;Substitute error messages for ^SD(409.76)
104Z0009 ;0009;No Procedures defined for encounter (PR1 segment)
Note: See TracBrowser for help on using the repository browser.