source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW303.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1SCRPW303 ; BPFO/JRC - Performance Monitor Report Utils; 30 Jul 2003 ; 4/2/04 7:21am
2 ;;5.3;SCHEDULING;**292,313,438**; AUG 13, 1993
3 ;
4DSS(SCRNARR) ;Set Stop Codes into screen array (prompt is one/many/all)
5 ;Input : SCRNARR - Screen array full global reference
6 ;Output : 1 = OK 0 = User abort/timeout
7 ; @SCRNARR@("DSS") = User pick all stop codes ?
8 ; 1 = Yes (all) 0 = No
9 ; @SCRNARR@("DSS-NTNL") = Only stop codes in national cohort ?
10 ; 1 = Yes 0 = No
11 ; @SCRNARR@("DSS",PtrStopCode) = Stop Code Name
12 ; @SCRNARR@("DSS-EXCLUDE",PtrStopCod) = SC Name
13 ;Note : @SCRNARR@("DSS") is initialized (KILLed) on input
14 ; : @SCRNARR@("DSS",PtrStopCode) is only set when the user
15 ; picked individual stop codes (i.e. didn't pick all) OR
16 ; when user selected stop codes by range (i.e. 100,102-300)
17 ; : @SCRNARR@("DSS-EXCLUDE") is only set if the user picked ALL
18 ; stop codes and choose to only use stop codes & credit pairs
19 ; from the national cohort
20 ; : @SCRNARR@("DSS-EXCLUDE") is set when
21 ; @SCRNARR@("DSS-NTNL") equals 1
22 ;
23 ;Declare variables
24 N VAUTSTR,VAUTVB,VAUTNI,DSS,SCANARR,DIC,DIR,Y,X,CODE,ARRY,DIRUT,FLG
25 K @SCRNARR@("DSS")
26 ;Prompt user wether to use range for stop code selection or not
27 S DIR(0)="Y",DIR("B")="No",FLG=0
28 S DIR("A")="Would you like to select the Stop Codes by range "
29 D ^DIR
30 I $D(DIRUT)!$D(DTOUT) Q FLG
31 I Y D RANGE(SCRNARR) Q FLG
32 ;Get stop code selection using VAUTOMA
33 I '$D(@SCRNARR@("DSS"))
34 S DIC="^DIC(40.7,"
35 S VAUTSTR="Stop Code"
36 S VAUTVB="SCANARR"
37 S VAUTNI=2
38 D FIRST^VAUTOMA
39 I Y<0 Q 0
40 ;Does selection of ALL mean all stop codes in national cohort
41 I $G(SCANARR)=1 D
42 .N DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
43 .S DIR(0)="Y"
44 .S DIR("B")="YES"
45 .S DIR("A",1)="By ALL do you mean stop codes from the"
46 .S DIR("A")="Performance Monitor national cohort "
47 .D ^DIR
48 .I $D(DIRUT) K SCANARR Q
49 .I Y D NTNLESC(SCRNARR)
50 .Q
51 I '$D(SCANARR) Q 0
52 I $D(@SCRNARR@("DSS")) Q 1
53 S @SCRNARR@("DSS-NTNL")=0
54 M @SCRNARR@("DSS")=SCANARR
55 Q 1
56 ;
57SORT(SORTARR) ; Set sort order into sort array
58 ;Input : SORTARR - Sort array full global reference
59 ;Output : 1 = OK 0 = User abort/timeout
60 ; @SORTARR = Sort1Code^Sort2Code
61 ; Codes: 1 = Division 2 = Clinic
62 ; 3 = Provider 4 = Stop Code
63 ; 5 = Date 6 = Patient
64 ; @SORTARR@("TEXT") = Sort1Text^Sort2Text
65 ;Note : @SORTARR is initialized (KILLed) on input
66 ;
67 ;Declare variables
68 N DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
69 K @SORTARR
70 ;Get sort level 1
71 S DIR(0)="SC^1:DIVISION;2:CLINIC;3:PROVIDER;4:STOP CODE;5:DATE;6:PATIENT"
72 S DIR("A")="Select primary sorting criteria"
73 D ^DIR
74 I $D(DIRUT) Q 0
75 S @SORTARR=Y
76 S @SORTARR@("TEXT")=$$SRT2TXT(Y)
77 ;Get sort level 2
78 K DIR,X,Y
79 S DIR(0)="SC^1:DIVISION;2:CLINIC;3:PROVIDER;4:STOP CODE;5:DATE;6:PATIENT"
80 S DIR("A")="Within "_@SORTARR@("TEXT")_" sort by"
81 S DIR("S")="I Y'="_@SORTARR
82 D ^DIR
83 I $D(DIRUT) K @SORTARR Q 0
84 S @SORTARR=@SORTARR_"^"_Y
85 S @SORTARR@("TEXT")=@SORTARR@("TEXT")_"^"_$$SRT2TXT(Y)
86 Q 1
87SRT2TXT(CODE) ;Convert sort code to sort text
88 ;Input : CODE - Sort code
89 ;Output : Text for sort code
90 ;
91 I CODE=1 Q "division"
92 I CODE=2 Q "clinic"
93 I CODE=3 Q "provider"
94 I CODE=4 Q "stop code"
95 I CODE=5 Q "date"
96 I CODE=6 Q "patient"
97 Q ""
98 ;
99ROLLUP(SCRNARR,SORTARR) ;Set screen and sort arrays for national rollup
100 ;Input : SCRNARR - Screening array
101 ; SORTARR - Sort array full global reference
102 ;Output : None
103 ; Nodes in @SCRNARR are set to denote the following:
104 ; Time limit of 10
105 ; Include all divisions
106 ; Use excluded stop codes from national cohort array
107 ; Count encounters with scanned progress notes
108 ; Nodes in @SORTARR are set to denote the following:
109 ; Primary sort is division
110 ; Secondary sort is date
111 ;Note : @SCRNARR and @SORTARR are initialized (KILLed) on input
112 ;
113 K @SCRNARR,@SORTARR
114 S @SCRNARR@("TLMT")=10
115 S @SCRNARR@("DIVISION")=1
116 S @SCRNARR@("PROVIDERS")=1
117 D NTNLESC(SCRNARR)
118 S @SCRNARR@("SCANNED")=1
119 S @SORTARR="1^5"
120 S @SORTARR@("TEXT")="division^date"
121 Q
122 ;
123NTNLSC(SCRNARR) ;Set inclusion array of stop codes for national reporting
124 ;Input : SCRNARR - Screening array
125 ;Output : National list of acceptable stop code & credit pairs
126 ; @SCRNARR@("DSS") = 0
127 ; @SCRNARR@("DSS-NTNL") = 1
128 ; @SCRNARR@("DSS",PtrStopCode) = Stop Code Name
129 ; @SCRNARR@("DSS-PAIR",PtrStopCode,PtrStopCode) = SC Name ^ SC Name
130 ;
131 N OFF,TEXT,J,CODE,PTR1,TMP,PTR2
132 S @SCRNARR@("DSS")=0
133 S @SCRNARR@("DSS-NTNL")=1
134 F OFF=1:1 S TEXT=$P($T(STOP+OFF),";;",2) Q:TEXT="END" D
135 .F J=1:1:$L(TEXT,"^") S CODE=$P(TEXT,"^",J) D
136 ..S TMP=$L(CODE) Q:((TMP'=3)&(TMP'=6))
137 ..I TMP=3 D Q
138 ...;Individual stop code
139 ...S PTR1=$$SC2PTR(CODE) Q:'PTR1
140 ...S @SCRNARR@("DSS",+PTR1)=$P(PTR1,"^",2)
141 ..;Credit pair
142 ..S PTR1=$$SC2PTR($E(CODE,1,3)) Q:'PTR1
143 ..S PTR2=$$SC2PTR($E(CODE,4,6)) Q:'PTR2
144 ..S @SCRNARR@("DSS-PAIR",+PTR1,+PTR2)=$P(PTR1,"^",2)_"^"_$P(PTR2,"^",2)
145 Q
146NTNLESC(SCRNARR) ;Set exclusion array of stop codes for national reporting
147 ;Input : SCRNARR - Screening array
148 ;Output : National list of stop codes to be excluded
149 ; @SCRNARR@("DSS") = 0
150 ; @SCRNARR@("DSS-NTNL") = 1
151 ; @SCRNARR@("DSS-EXCLUDE",PtrStopCode) = Stop Code Name
152 ;
153 N OFF,TEXT,J,CODE,PTR1,TMP,PTR2
154 S @SCRNARR@("DSS")=0
155 S @SCRNARR@("DSS-NTNL")=1
156 F OFF=1:1 S TEXT=$P($T(EXCSTOP+OFF),";;",2) Q:TEXT="END" D
157 .F J=1:1:$L(TEXT,"^") S CODE=$P(TEXT,"^",J) D
158 ..S TMP=$L(CODE) Q:((TMP'=3)&(TMP'=6))
159 ..I TMP=3 D Q
160 ...;Individual stop code for exclusion
161 ...S PTR1=$$SC2PTR(CODE) Q:'PTR1
162 ...S @SCRNARR@("DSS-EXCLUDE",+PTR1)=$P(PTR1,"^",2)
163 Q
164RANGE(SCRNARR) ;Screen array by range
165 N DIR,DIRUT,DTOUT,Y,SUB,NODE,CODE,PTR1,J
166 S @SCRNARR@("DSS")=0
167 S @SCRNARR@("DSS",1)=""
168 S @SCRNARR@("DSS-NTNL")=0
169 S DIR("A")="Select individual Stop Code or a range of Codes "
170 S DIR("?")="This response must be a list or range, e.g., 100,302 or 200-450,800 "
171 S DIR(0)="L"
172 D ^DIR
173 I $D(DIRUT)!$D(DTOUT) Q
174 I Y D
175 .S FLG=1
176 .S SUB="" F S SUB=$O(Y(SUB)) Q:SUB="" D
177 ..S NODE=(Y(SUB))
178 ..F J=1:1:$L(NODE,",") S CODE=$P(NODE,",",J) I CODE D
179 ...S PTR1=$$SC2PTR(CODE) Q:'PTR1
180 ...S @SCRNARR@("DSS",+PTR1)=$P(PTR1,"^",2)
181 Q
182SC2PTR(CODE) ;Get pointer to stop code
183 ;Input : CODE - Stop code
184 ;Output : Pointer #40.7 ^ Name (#.01)
185 ;
186 N NODE,PTR
187 S PTR=+$O(^DIC(40.7,"C",CODE,0)) I 'PTR Q "0^INVALID STOP CODE"
188 S NODE=$G(^DIC(40.7,PTR,0))
189 Q PTR_"^"_$P(NODE,"^",1)
190 ;
191STOP ;List of acceptable stop codes and credit pairs
192 ;;END
193 ;
194EXCSTOP ;Exclusion list of stop codes
195 ;;104^105^106^107^108^109^115^116^117^120^126^127^128^144^145
196 ;;146^149^150^151^152^153^154^155^165^166^167^168^169^174^190
197 ;;202^205^206^207^208^212^213^214^290^291^292^293^294^295^296
198 ;;321^327^328^329^333^334^370^417^421^422^423^429^430^431^435
199 ;;450^451^452^453^454^455^456^458^459^460^461^462^463^464^465
200 ;;466^467^468^469^470^471^472^473^474^475^476^477^478^479^481
201 ;;482^483^484^485^505^506^510^513^516^519^521^522^523^525^535
202 ;;538^545^547^550^553^554^557^558^559^560^561^563^564^565^566
203 ;;573^574^575^577^578^590^602^603^604^606^607^608^610^650^651
204 ;;652^653^654^655^656^657^660^670^680^681^682^690^691^701^702
205 ;;703^704^705^706^707^708^709^710^711^725^730^731^900^999
206 ;;END
207 ;
Note: See TracBrowser for help on using the repository browser.