source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW304.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: 4.8 KB
Line 
1SCRPW304 ; BPFO/JRC - Performance Monitors National Summary Report; 30 Jul 2003 ; 2/5/04 7:13am
2 ;;5.3;SCHEDULING;**292,335,337**;AUG 13, 1993
3 ;
4EN ;Main Entry Point
5 ;Declare variable(s) and arrays
6 N SCRNARR,SORTARR
7 S SCRNARR="^TMP(""SCRPW"",$J,""SCRNARR"")"
8 S SORTARR="^TMP(""SCRPW"",$J,""SORTARR"")"
9 K @SCRNARR,@SORTARR
10 ;Set national screen/sort
11 D ROLLUP^SCRPW303(SCRNARR,SORTARR)
12 ;Get date frame
13 I $$DATE^SCRPW302("","",SCRNARR)=0 D EX1 Q
14 ;Queue report
15 W !!
16 N ZTDESC,ZTIO,ZTSAVE,TMP
17 S ZTIO=""
18 S ZTDESC="Performance Monitor National Summary Report"
19 S ZTSAVE("SCRNARR")=""
20 S TMP=$$OREF^DILF(SCRNARR)
21 S ZTSAVE(TMP)=""
22 I $D(@SCRNARR)#2 S ZTSAVE(SCRNARR)=""
23 S ZTSAVE("SORTARR")=""
24 S TMP=$$OREF^DILF(SORTARR)
25 S ZTSAVE(TMP)=""
26 I $D(@SORTARR)#2 S ZTSAVE(SORTARR)=""
27 D EN^XUTMDEVQ("EN1^SCRPW304",ZTDESC,.ZTSAVE)
28 D EX1
29 Q
30 ;
31EN1 ;Tasked entry point
32 ;Input : SCRNARR - Screen array
33 ; SORTARR - Sort array
34 ;Output : None
35 ;
36 N OUTARR,STOP,PAGENUM,STOP,SUMNODE,PINODE,DIV
37 S OUTARR="^TMP(""SCRPW"",$J,""OUTARR"")"
38 S STOP=0
39 K @OUTARR
40 S PAGENUM=1
41 ;Get data
42 D GETDATA^SDPMUT1(SCRNARR,SORTARR,OUTARR)
43 ;Print summary for facility
44 S DIV=""
45 D PRTHEAD
46 S SUMNODE=$G(@OUTARR@("SUMMARY"))
47 S PINODE=$G(@OUTARR@("SUMMARY","PI"))
48 I '$$S^%ZTLOAD() D PRTSUMS
49 D WAIT^SCRPW301 I STOP D EXIT Q
50 ;Print divisional summaries
51 S DIV="" F S DIV=$O(@OUTARR@("SUBTOTAL",DIV)) Q:DIV="" D Q:STOP
52 .D PRTHEAD
53 .S SUMNODE=$G(@OUTARR@("SUBTOTAL",DIV))
54 .S PINODE=$G(@OUTARR@("SUBTOTAL",DIV,"PI"))
55 .D PRTSUMS
56 .D WAIT^SCRPW301 I STOP Q
57 ;Cleanup and quit
58 D EXIT
59 Q
60 ;
61PRTHEAD ;Page Header
62 ;Input : OUTARR - Data array
63 ; SCRNARR - Screen array
64 ; PAGENUM - Page number
65 ; DIV - Division Name ^ Division Number
66 ; - NULL if facility name/number should be used
67 ;Output : None
68 ; PAGENUM is incremented by 1
69 ;
70 N TMP,LINE,VISN
71 W @IOF
72 W !,"Performance Monitor National Summary Report",?70,"Page: ",PAGENUM
73 S LINE="Division: "_$P(DIV,U,1)_" ("_$P(DIV,U,2)_")"
74 I DIV="" D
75 .S TMP=$$SITE^VASITE()
76 .D PARENT^XUAF4("VISN","`"_$P(TMP,U,1)) ; SD*5.3*337
77 .S VISN="",VISN=$O(VISN("P",VISN)) Q:VISN="" ; SD*5.3*337
78 .S LINE="Facility: "_$P(TMP,U,2)_" ("_$P(TMP,U,3)_")"_" "_$P($G(VISN("P",VISN)),U,1)
79 W !!,LINE
80 W !,"Run Date: ",$$HTE^XLFDT($H)
81 W !,"Encounter Date Range: ",$$FMTE^XLFDT($P(@SCRNARR@("RANGE"),U,1))
82 W " to ",$$FMTE^XLFDT($P(@SCRNARR@("RANGE"),U,2))
83 I DIV="" S LINE=+$G(@OUTARR@("SUMMARY"))
84 I DIV'="" S LINE=+$G(@OUTARR@("SUBTOTAL",DIV))
85 W !,"Total number of encounters (denominator): ",LINE
86 W !!,"Total number of encounters in the denominator are those included in the"
87 W !,"Performance Monitor cohort"
88 S PAGENUM=PAGENUM+1
89 Q
90 ;
91PRTSUMS ;Print summaries
92 ;Input : SUMNODE - Summary node from OUTARR
93 ; PINODE - PI node from OUTARR
94 ;Output : None
95 ;
96 I (SUMNODE="")&(PINODE="") D Q
97 .W !
98 .W !,"***********************************************"
99 .W !,"* NOTHING TO REPORT FOR SELECTED DATE FRAME *"
100 .W !,"***********************************************"
101 N VAL,DASH6,TOTENC,CMPENC,PRCNT,TMP,SCANNED,NPN
102 S $P(DASH6,"-",6)="-"
103 S $P(PRCNT,U,11)=""
104 ;Get general totals
105 S TOTENC=+$P(SUMNODE,U,1)
106 S CMPENC=+$P(SUMNODE,U,2)
107 S SCANNED=+$P(SUMNODE,U,7)
108 S NPN=+$P(SUMNODE,U,9)
109 ;Calculate compliance percentages
110 I TOTENC S VAL=0 F TMP=1:1:11 D
111 .I (TOTENC-SCANNED)>0 S VAL=100*($P(PINODE,U,TMP)/(TOTENC-SCANNED))
112 .S $P(PRCNT,U,TMP)=$TR($J(VAL,3,0)," ")_"%"
113 ;Part 1
114 W !!,"Signed",?21,"Elapsed Time (Days)"
115 W !,"within",?14,"0-1",?22,">1-2",?31,">2-3",?39,">3-4",?47,">4-5"
116 W ?55,">5-6",?63,">6-7",?71,">7-8"
117 W !,?13,DASH6,?21,DASH6,?30,DASH6,?38,DASH6,?46,DASH6,?54,DASH6
118 W ?62,DASH6,?70,DASH6
119 W !,"Encounters",?13,+$P(PINODE,U,1),?21,+$P(PINODE,U,2)
120 W ?30,+$P(PINODE,U,3),?38,+$P(PINODE,U,4),?46,+$P(PINODE,U,5)
121 W ?54,+$P(PINODE,U,6),?62,+$P(PINODE,U,7),?70,+$P(PINODE,U,8)
122 W !,"Percentage",?13,$P(PRCNT,U,1),?21,$P(PRCNT,U,2)
123 W ?30,$P(PRCNT,U,3),?38,$P(PRCNT,U,4),?46,$P(PRCNT,U,5)
124 W ?54,$P(PRCNT,U,6),?62,$P(PRCNT,U,7),?70,$P(PRCNT,U,8)
125 ;Part 2
126 W !!,"Signed",?21,"Elapsed Time (Days)",?45,"Pending",?60,"Scanned"
127 W !,"within",?14,">8-9",?22,">9-10",?32,">10",?38,"Signatures"
128 W ?50,"Notes",?59,"Note Only"
129 W !,?13,DASH6,?21,DASH6,?30,DASH6,?38,DASH6_"----"
130 W ?50,DASH6,?59,DASH6_"---"
131 W !,"Encounters",?13,+$P(PINODE,U,9),?21,+$P(PINODE,U,10)
132 W ?30,+$P(PINODE,U,11),?38,TOTENC-CMPENC-NPN-SCANNED-(+$P(PINODE,U,11))
133 W ?50,NPN,?59,SCANNED
134 W !,"Percentage",?13,$P(PRCNT,U,9),?21,$P(PRCNT,U,10)
135 W ?30,$P(PRCNT,U,11)
136 S (VAL,NPNVAL)=0
137 I (TOTENC-SCANNED)>0 S NPNVAL=100*(NPN/(TOTENC-SCANNED))
138 S NPNVAL=$TR($J(NPNVAL,3,0)," ")_"%"
139 I (TOTENC-SCANNED)>0 S VAL=100*((TOTENC-SCANNED-CMPENC-NPN-(+$P(PINODE,U,11)))/TOTENC)
140 S VAL=$TR($J(VAL,3,0)," ")_"%"
141 W ?38,VAL,?50,NPNVAL,?59,"N/A"
142 Q
143 ;
144EXIT ;Kill temporary arrays
145 K @OUTARR
146EX1 K @SORTARR,@SCRNARR
147 Q
Note: See TracBrowser for help on using the repository browser.