source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDPMUT1.m@ 1147

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

initial load of WorldVistAEHR
File size: 8.2 KB
Line 
1SDPMUT1 ; BPFO/JRC - Performance Monitors Utilities; 6-19-2003 ; 12/22/03 11:32am [6/21/04 3:26pm]
2 ;;5.3;SCHEDULING;**292,335,371**;AUGUST 13, 1993
3 ;
4GETDATA(SCRNARR,SORTARR,OUTARR) ;Get progress note compliance information
5 ;Input : SCRNARR - Screening array full global reference
6 ; SORTARR - Sort array full global reference
7 ; OUTARR - Output array full global reference
8 ;Output : None
9 ; @OUTARR@("SUMMARY") = Enc^Comply^ ^Prov^Stop^ET^Scan^Signed
10 ; Enc - Number of encounters checked for compliance
11 ; Comply - Compliant encounters (note signed w/in time limit)
12 ; Prov - Unique primary encounter providers
13 ; Stop - Unique primary stop codes
14 ; ET - Total elapsed time (days) to sign PN
15 ; Scan - Encounters with scanned notes
16 ; Signed - Encounters with signed notes
17 ; @OUTARR@("SUBTOTAL",SUB1) = SUMMARY node for sort level 1
18 ; @OUTARR@("SUMMARY","PI") = F0^F1^F2^F3^F4^F5^F6^F7^F8^F9^F10^F11
19 ; Fx - Notes signed in x to X+1 days
20 ; F11 - Notes signed in 10 or more days
21 ; @OUTARR@("SUBTOTAL",SUB1,"PI") = PI node for sort level 1
22 ; @OUTARR@("DETAIL",SUB1,SUB2,DFN,PtrEnc) = Prov^DT^ET
23 ; Prov - TIU Provider
24 ; DT - Date Provider signed progress note
25 ; ET - Number of days that elpased before signing PN
26 ;Note : OUTARR is initialized (i.e. KILLed) on input
27 ; : When division is used as a sorting subscript,
28 ; DivisionName^DivisionNumber is used as the subscript
29 ; : Time is stripped from the encounter date when used as a
30 ; sorting subscript
31 ;
32 ;Declare variables
33 N PTRENC,DATE,ENDDATE,UNQARR,STOP,LOOP
34 ;Get begin and end dates for scan
35 S DATE=$G(@SCRNARR@("RANGE"))
36 S ENDDATE=$P(DATE,U,2)
37 S DATE=$P(DATE,U,1)
38 Q:('DATE)!('ENDDATE)
39 S DATE=$P(DATE,".",1)-.000001
40 S $P(ENDDATE,".",2)=999999
41 ;Initialize output and array used to track uniques
42 S UNQARR=$NA(^TMP("SDPMUT1-UNIQUE",$J))
43 K @UNQARR,@OUTARR
44 ;Scan
45 S STOP=0
46 F LOOP=1:1 S DATE=+$O(^SCE("B",DATE)) Q:('DATE)!(DATE>ENDDATE) D Q:STOP
47 .S PTRENC=0
48 .F S PTRENC=+$O(^SCE("B",DATE,PTRENC)) Q:'PTRENC D Q:STOP
49 ..;Task asked to stop
50 ..I '(LOOP#100) S STOP=$$S^%ZTLOAD() Q:STOP
51 ..;Screen out encounter
52 ..Q:$$SCREEN^SDPMUT2(PTRENC,SCRNARR)
53 ..;Set output array
54 ..D GET
55 ;Cleanup and quit
56 K @UNQARR
57 Q
58GET ;Get info & establish output array for GETDATA
59 ;Input : PTRENC - Pointer to Outpatient Encounter file
60 ; UNQARR - Array to use for unique calculations
61 ; Input parameters for GETDATA (SCRNARR, SORTARR, and OUTARR)
62 ;Ouput : See GETDATA for format of nodes set into OUTARR
63 ; Unique Stop Codes
64 ; @UNQARR@("SUMMARY","STOP",SUB1,PtrStopCode)
65 ; @UNQARR@("SUBTOTAL","STOP",SUB1,PtrStopCode)
66 ; Unique Primary Encounter Providers
67 ; @UNQARR@("SUMMARY","PROV",SUB1,PtrProvider)
68 ; @UNQARR@("SUBTOTAL","PROV",SUB1,PtrProvider)
69 ;Declare variables
70 N DFN,DIV,CLINIC,NODE,NOTEINFO,PROV,ENCDT,SUB1,SUB2,TIUPROV
71 N TIUDT,TIUET,SUMNODE,SUBNODE,ESUB1,ESUB2,SCODE,X
72 S NODE=^SCE(PTRENC,0)
73 S DFN=+$P(NODE,U,2),DIV=+$P(NODE,U,11),CLINIC=+$P(NODE,U,4)
74 S SCODE=+$P(NODE,U,3),ENCDT=+NODE
75 ;Get primary encounter provider
76 S PROV=$$ENCPROV^SDPMUT2(PTRENC)
77 ;Set sorting subscripts (ESUB1 & ESUB2)
78 ; If SUBx = 1 Set sorting criteria to division
79 ; If SUBx = 2 Set soring criteria to clinic
80 ; If SUBx = 3 Set sorting criteria to Provider
81 ; If SUBx = 4 Set sorting criteria to Stop Code
82 ; If SUBx = 5 Set sorting criteria to Encounter Date
83 ; If SUBx = 6 Set sorting criteria to Patient
84 S NODE=@SORTARR
85 S SUB1=$P(NODE,"^",1)
86 S SUB2=$P(NODE,"^",2)
87 F NODE="SUB1","SUB2" D I @("E"_NODE)="" S @("E"_NODE)="UNKNOWN"
88 .I @NODE=1 D Q
89 ..S X=$G(^DG(40.8,DIV,0))
90 ..S @("E"_NODE)=$P(X,U,1)_"^"_$P(X,U,2)
91 .I @NODE=2 D Q
92 ..S @("E"_NODE)=$P($G(^SC(CLINIC,0)),U,1)
93 .I @NODE=3 D Q
94 ..S @("E"_NODE)=$P($G(^VA(200,PROV,0)),U,1)
95 .I @NODE=4 D Q
96 ..S @("E"_NODE)=$P($G(^DIC(40.7,SCODE,0)),U,1)
97 .I @NODE=5 D Q
98 ..S @("E"_NODE)=$P(ENCDT,".",1)
99 .I @NODE=6 D Q
100 ..S @("E"_NODE)=$P($G(^DPT(DFN,0)),U,1)
101 .S @("E"_NODE)="UNKNOWN"
102 ;Increment Encounters for hospital and sort level 1
103 S $P(@OUTARR@("SUMMARY"),U,1)=$P($G(@OUTARR@("SUMMARY")),U,1)+1
104 S $P(@OUTARR@("SUBTOTAL",ESUB1),U,1)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,1)+1
105 ;Get TIU information
106 S NOTEINFO=$$NOTEINF^SDPMUT2(PTRENC)
107 S (TIUPROV,TIUDT,TIUET)=""
108 ;Only update performance indicators for note status of B
109 I $P((NOTEINFO),U,2)="B" D
110 .S TIUPROV=$P((NOTEINFO),U,5)
111 .S TIUDT=$P((NOTEINFO),U,6)
112 .I 'TIUPROV D
113 ..S TIUPROV=$P((NOTEINFO),U,3)
114 ..S TIUDT=$P((NOTEINFO),U,4)
115 .S TIUET=$$FMDIFF^XLFDT(TIUDT,ENCDT)
116 .I TIUET<0 Q
117 .;Increment Compliant Notes for hospital and sort level 1
118 .I TIUET'>@SCRNARR@("TLMT") D
119 ..S $P(@OUTARR@("SUMMARY"),U,2)=$P($G(@OUTARR@("SUMMARY")),U,2)+1
120 ..S $P(@OUTARR@("SUBTOTAL",ESUB1),U,2)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,2)+1
121 .;Increment Total Elapsed Time for hospital and sort level 1
122 .S $P(@OUTARR@("SUMMARY"),U,6)=$P($G(@OUTARR@("SUMMARY")),U,6)+TIUET
123 .S $P(@OUTARR@("SUBTOTAL",ESUB1),U,6)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,6)+TIUET
124 .;Increment Total Signed Notes for hospital and sort level 1
125 .S $P(@OUTARR@("SUMMARY"),U,8)=$P($G(@OUTARR@("SUMMARY")),U,8)+1
126 .S $P(@OUTARR@("SUBTOTAL",ESUB1),U,8)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,8)+1
127 .;Update performance indicator node for hospital and sort level 1
128 .S SUMNODE=$G(@OUTARR@("SUMMARY","PI"))
129 .S SUBNODE=$G(@OUTARR@("SUBTOTAL",ESUB1,"PI"))
130 .I TIUET'<0&(TIUET'>1) D
131 ..S $P(SUMNODE,U,1)=$P($G(SUMNODE),U,1)+1
132 ..S $P(SUBNODE,U,1)=$P($G(SUBNODE),U,1)+1
133 .I TIUET>1&(TIUET'>2) D
134 ..S $P(SUMNODE,U,2)=$P($G(SUMNODE),U,2)+1
135 ..S $P(SUBNODE,U,2)=$P($G(SUBNODE),U,2)+1
136 .I TIUET>2&(TIUET'>3) D
137 ..S $P(SUMNODE,U,3)=$P($G(SUMNODE),U,3)+1
138 ..S $P(SUBNODE,U,3)=$P($G(SUBNODE),U,3)+1
139 .I TIUET>3&(TIUET'>4) D
140 ..S $P(SUMNODE,U,4)=$P($G(SUMNODE),U,4)+1
141 ..S $P(SUBNODE,U,4)=$P($G(SUBNODE),U,4)+1
142 .I TIUET>4&(TIUET'>5) D
143 ..S $P(SUMNODE,U,5)=$P($G(SUMNODE),U,5)+1
144 ..S $P(SUBNODE,U,5)=$P($G(SUBNODE),U,5)+1
145 .I TIUET>5&(TIUET'>6) D
146 ..S $P(SUMNODE,U,6)=$P($G(SUMNODE),U,6)+1
147 ..S $P(SUBNODE,U,6)=$P($G(SUBNODE),U,6)+1
148 .I TIUET>6&(TIUET'>7) D
149 ..S $P(SUMNODE,U,7)=$P($G(SUMNODE),U,7)+1
150 ..S $P(SUBNODE,U,7)=$P($G(SUBNODE),U,7)+1
151 .I TIUET>7&(TIUET'>8) D
152 ..S $P(SUMNODE,U,8)=$P($G(SUMNODE),U,8)+1
153 ..S $P(SUBNODE,U,8)=$P($G(SUBNODE),U,8)+1
154 .I TIUET>8&(TIUET'>9) D
155 ..S $P(SUMNODE,U,9)=$P($G(SUMNODE),U,9)+1
156 ..S $P(SUBNODE,U,9)=$P($G(SUBNODE),U,9)+1
157 .I TIUET>9&(TIUET'>10) D
158 ..S $P(SUMNODE,U,10)=$P($G(SUMNODE),U,10)+1
159 ..S $P(SUBNODE,U,10)=$P($G(SUBNODE),U,10)+1
160 .I TIUET>10 D
161 ..S $P(SUMNODE,U,11)=$P($G(SUMNODE),U,11)+1
162 ..S $P(SUBNODE,U,11)=$P($G(SUBNODE),U,11)+1
163 .S @OUTARR@("SUMMARY","PI")=SUMNODE
164 .S @OUTARR@("SUBTOTAL",ESUB1,"PI")=SUBNODE
165 .Q
166 ;Increment Scanned Notes for hospital and sort level 1 (if required)
167 I @SCRNARR@("SCANNED")&($P(NOTEINFO,U,2)["D") D
168 .S $P(@OUTARR@("SUMMARY"),U,7)=$P($G(@OUTARR@("SUMMARY")),U,7)+1
169 .S $P(@OUTARR@("SUBTOTAL",ESUB1),U,7)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,7)+1
170 .Q
171 ;Only update performance indicators for note status of A
172 I $P((NOTEINFO),U,2)="A" D
173 .S $P(@OUTARR@("SUMMARY"),U,9)=$P($G(@OUTARR@("SUMMARY")),U,9)+1
174 .S $P(@OUTARR@("SUBTOTAL",ESUB1),U,9)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,9)+1
175 .Q
176 ;Increment unique Stop Codes for hospital and sort level 1
177 I SCODE D
178 .I '($D(@UNQARR@("SUMMARY","STOP",ESUB1,SCODE))#2) D
179 ..S $P(@OUTARR@("SUMMARY"),U,5)=$P($G(@OUTARR@("SUMMARY")),U,5)+1
180 ..S @UNQARR@("SUMMARY","STOP",ESUB1,SCODE)=""
181 ..Q
182 .I '($D(@UNQARR@("SUBTOTAL","STOP",ESUB1,SCODE))#2) D
183 ..S $P(@OUTARR@("SUBTOTAL",ESUB1),U,5)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,5)+1
184 ..S @UNQARR@("SUBTOTAL","STOP",ESUB1,SCODE)=""
185 ..Q
186 .Q
187 ;Increment unique Providers for hospital and sort level 1
188 I PROV D
189 .I '($D(@UNQARR@("SUMMARY","PROV",ESUB1,PROV))#2) D
190 ..S $P(@OUTARR@("SUMMARY"),U,4)=$P($G(@OUTARR@("SUMMARY")),U,4)+1
191 ..S @UNQARR@("SUMMARY","PROV",ESUB1,PROV)=""
192 ..Q
193 .I '($D(@UNQARR@("SUBTOTAL","PROV",ESUB1,PROV))#2) D
194 ..S $P(@OUTARR@("SUBTOTAL",ESUB1),U,4)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,4)+1
195 ..S @UNQARR@("SUBTOTAL","PROV",ESUB1,PROV)=""
196 ..Q
197 .Q
198 ;Set detailed node
199 S @OUTARR@("DETAIL",ESUB1,ESUB2,DFN,PTRENC)=TIUPROV_"^"_TIUDT_"^"_TIUET
200 Q
Note: See TracBrowser for help on using the repository browser.