SCRPW304 ; BPFO/JRC - Performance Monitors National Summary Report; 30 Jul 2003 ; 2/5/04 7:13am
;;5.3;SCHEDULING;**292,335,337**;AUG 13, 1993
;
EN ;Main Entry Point
;Declare variable(s) and arrays
N SCRNARR,SORTARR
S SCRNARR="^TMP(""SCRPW"",$J,""SCRNARR"")"
S SORTARR="^TMP(""SCRPW"",$J,""SORTARR"")"
K @SCRNARR,@SORTARR
;Set national screen/sort
D ROLLUP^SCRPW303(SCRNARR,SORTARR)
;Get date frame
I $$DATE^SCRPW302("","",SCRNARR)=0 D EX1 Q
;Queue report
W !!
N ZTDESC,ZTIO,ZTSAVE,TMP
S ZTIO=""
S ZTDESC="Performance Monitor National Summary Report"
S ZTSAVE("SCRNARR")=""
S TMP=$$OREF^DILF(SCRNARR)
S ZTSAVE(TMP)=""
I $D(@SCRNARR)#2 S ZTSAVE(SCRNARR)=""
S ZTSAVE("SORTARR")=""
S TMP=$$OREF^DILF(SORTARR)
S ZTSAVE(TMP)=""
I $D(@SORTARR)#2 S ZTSAVE(SORTARR)=""
D EN^XUTMDEVQ("EN1^SCRPW304",ZTDESC,.ZTSAVE)
D EX1
Q
;
EN1 ;Tasked entry point
;Input : SCRNARR - Screen array
; SORTARR - Sort array
;Output : None
;
N OUTARR,STOP,PAGENUM,STOP,SUMNODE,PINODE,DIV
S OUTARR="^TMP(""SCRPW"",$J,""OUTARR"")"
S STOP=0
K @OUTARR
S PAGENUM=1
;Get data
D GETDATA^SDPMUT1(SCRNARR,SORTARR,OUTARR)
;Print summary for facility
S DIV=""
D PRTHEAD
S SUMNODE=$G(@OUTARR@("SUMMARY"))
S PINODE=$G(@OUTARR@("SUMMARY","PI"))
I '$$S^%ZTLOAD() D PRTSUMS
D WAIT^SCRPW301 I STOP D EXIT Q
;Print divisional summaries
S DIV="" F S DIV=$O(@OUTARR@("SUBTOTAL",DIV)) Q:DIV="" D Q:STOP
.D PRTHEAD
.S SUMNODE=$G(@OUTARR@("SUBTOTAL",DIV))
.S PINODE=$G(@OUTARR@("SUBTOTAL",DIV,"PI"))
.D PRTSUMS
.D WAIT^SCRPW301 I STOP Q
;Cleanup and quit
D EXIT
Q
;
PRTHEAD ;Page Header
;Input : OUTARR - Data array
; SCRNARR - Screen array
; PAGENUM - Page number
; DIV - Division Name ^ Division Number
; - NULL if facility name/number should be used
;Output : None
; PAGENUM is incremented by 1
;
N TMP,LINE,VISN
W @IOF
W !,"Performance Monitor National Summary Report",?70,"Page: ",PAGENUM
S LINE="Division: "_$P(DIV,U,1)_" ("_$P(DIV,U,2)_")"
I DIV="" D
.S TMP=$$SITE^VASITE()
.D PARENT^XUAF4("VISN","`"_$P(TMP,U,1)) ; SD*5.3*337
.S VISN="",VISN=$O(VISN("P",VISN)) Q:VISN="" ; SD*5.3*337
.S LINE="Facility: "_$P(TMP,U,2)_" ("_$P(TMP,U,3)_")"_" "_$P($G(VISN("P",VISN)),U,1)
W !!,LINE
W !,"Run Date: ",$$HTE^XLFDT($H)
W !,"Encounter Date Range: ",$$FMTE^XLFDT($P(@SCRNARR@("RANGE"),U,1))
W " to ",$$FMTE^XLFDT($P(@SCRNARR@("RANGE"),U,2))
I DIV="" S LINE=+$G(@OUTARR@("SUMMARY"))
I DIV'="" S LINE=+$G(@OUTARR@("SUBTOTAL",DIV))
W !,"Total number of encounters (denominator): ",LINE
W !!,"Total number of encounters in the denominator are those included in the"
W !,"Performance Monitor cohort"
S PAGENUM=PAGENUM+1
Q
;
PRTSUMS ;Print summaries
;Input : SUMNODE - Summary node from OUTARR
; PINODE - PI node from OUTARR
;Output : None
;
I (SUMNODE="")&(PINODE="") D Q
.W !
.W !,"***********************************************"
.W !,"* NOTHING TO REPORT FOR SELECTED DATE FRAME *"
.W !,"***********************************************"
N VAL,DASH6,TOTENC,CMPENC,PRCNT,TMP,SCANNED,NPN
S $P(DASH6,"-",6)="-"
S $P(PRCNT,U,11)=""
;Get general totals
S TOTENC=+$P(SUMNODE,U,1)
S CMPENC=+$P(SUMNODE,U,2)
S SCANNED=+$P(SUMNODE,U,7)
S NPN=+$P(SUMNODE,U,9)
;Calculate compliance percentages
I TOTENC S VAL=0 F TMP=1:1:11 D
.I (TOTENC-SCANNED)>0 S VAL=100*($P(PINODE,U,TMP)/(TOTENC-SCANNED))
.S $P(PRCNT,U,TMP)=$TR($J(VAL,3,0)," ")_"%"
;Part 1
W !!,"Signed",?21,"Elapsed Time (Days)"
W !,"within",?14,"0-1",?22,">1-2",?31,">2-3",?39,">3-4",?47,">4-5"
W ?55,">5-6",?63,">6-7",?71,">7-8"
W !,?13,DASH6,?21,DASH6,?30,DASH6,?38,DASH6,?46,DASH6,?54,DASH6
W ?62,DASH6,?70,DASH6
W !,"Encounters",?13,+$P(PINODE,U,1),?21,+$P(PINODE,U,2)
W ?30,+$P(PINODE,U,3),?38,+$P(PINODE,U,4),?46,+$P(PINODE,U,5)
W ?54,+$P(PINODE,U,6),?62,+$P(PINODE,U,7),?70,+$P(PINODE,U,8)
W !,"Percentage",?13,$P(PRCNT,U,1),?21,$P(PRCNT,U,2)
W ?30,$P(PRCNT,U,3),?38,$P(PRCNT,U,4),?46,$P(PRCNT,U,5)
W ?54,$P(PRCNT,U,6),?62,$P(PRCNT,U,7),?70,$P(PRCNT,U,8)
;Part 2
W !!,"Signed",?21,"Elapsed Time (Days)",?45,"Pending",?60,"Scanned"
W !,"within",?14,">8-9",?22,">9-10",?32,">10",?38,"Signatures"
W ?50,"Notes",?59,"Note Only"
W !,?13,DASH6,?21,DASH6,?30,DASH6,?38,DASH6_"----"
W ?50,DASH6,?59,DASH6_"---"
W !,"Encounters",?13,+$P(PINODE,U,9),?21,+$P(PINODE,U,10)
W ?30,+$P(PINODE,U,11),?38,TOTENC-CMPENC-NPN-SCANNED-(+$P(PINODE,U,11))
W ?50,NPN,?59,SCANNED
W !,"Percentage",?13,$P(PRCNT,U,9),?21,$P(PRCNT,U,10)
W ?30,$P(PRCNT,U,11)
S (VAL,NPNVAL)=0
I (TOTENC-SCANNED)>0 S NPNVAL=100*(NPN/(TOTENC-SCANNED))
S NPNVAL=$TR($J(NPNVAL,3,0)," ")_"%"
I (TOTENC-SCANNED)>0 S VAL=100*((TOTENC-SCANNED-CMPENC-NPN-(+$P(PINODE,U,11)))/TOTENC)
S VAL=$TR($J(VAL,3,0)," ")_"%"
W ?38,VAL,?50,NPNVAL,?59,"N/A"
Q
;
EXIT ;Kill temporary arrays
K @OUTARR
EX1 K @SORTARR,@SCRNARR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW304 5013 printed Apr 09, 2024@22:01:22 Page 2
SCRPW304 ; BPFO/JRC - Performance Monitors National Summary Report; 30 Jul 2003 ; 2/5/04 7:13am
+1 ;;5.3;SCHEDULING;**292,335,337**;AUG 13, 1993
+2 ;
EN ;Main Entry Point
+1 ;Declare variable(s) and arrays
+2 NEW SCRNARR,SORTARR
+3 SET SCRNARR="^TMP(""SCRPW"",$J,""SCRNARR"")"
+4 SET SORTARR="^TMP(""SCRPW"",$J,""SORTARR"")"
+5 KILL @SCRNARR,@SORTARR
+6 ;Set national screen/sort
+7 DO ROLLUP^SCRPW303(SCRNARR,SORTARR)
+8 ;Get date frame
+9 IF $$DATE^SCRPW302("","",SCRNARR)=0
DO EX1
QUIT
+10 ;Queue report
+11 WRITE !!
+12 NEW ZTDESC,ZTIO,ZTSAVE,TMP
+13 SET ZTIO=""
+14 SET ZTDESC="Performance Monitor National Summary Report"
+15 SET ZTSAVE("SCRNARR")=""
+16 SET TMP=$$OREF^DILF(SCRNARR)
+17 SET ZTSAVE(TMP)=""
+18 IF $DATA(@SCRNARR)#2
SET ZTSAVE(SCRNARR)=""
+19 SET ZTSAVE("SORTARR")=""
+20 SET TMP=$$OREF^DILF(SORTARR)
+21 SET ZTSAVE(TMP)=""
+22 IF $DATA(@SORTARR)#2
SET ZTSAVE(SORTARR)=""
+23 DO EN^XUTMDEVQ("EN1^SCRPW304",ZTDESC,.ZTSAVE)
+24 DO EX1
+25 QUIT
+26 ;
EN1 ;Tasked entry point
+1 ;Input : SCRNARR - Screen array
+2 ; SORTARR - Sort array
+3 ;Output : None
+4 ;
+5 NEW OUTARR,STOP,PAGENUM,STOP,SUMNODE,PINODE,DIV
+6 SET OUTARR="^TMP(""SCRPW"",$J,""OUTARR"")"
+7 SET STOP=0
+8 KILL @OUTARR
+9 SET PAGENUM=1
+10 ;Get data
+11 DO GETDATA^SDPMUT1(SCRNARR,SORTARR,OUTARR)
+12 ;Print summary for facility
+13 SET DIV=""
+14 DO PRTHEAD
+15 SET SUMNODE=$GET(@OUTARR@("SUMMARY"))
+16 SET PINODE=$GET(@OUTARR@("SUMMARY","PI"))
+17 IF '$$S^%ZTLOAD()
DO PRTSUMS
+18 DO WAIT^SCRPW301
IF STOP
DO EXIT
QUIT
+19 ;Print divisional summaries
+20 SET DIV=""
FOR
SET DIV=$ORDER(@OUTARR@("SUBTOTAL",DIV))
if DIV=""
QUIT
Begin DoDot:1
+21 DO PRTHEAD
+22 SET SUMNODE=$GET(@OUTARR@("SUBTOTAL",DIV))
+23 SET PINODE=$GET(@OUTARR@("SUBTOTAL",DIV,"PI"))
+24 DO PRTSUMS
+25 DO WAIT^SCRPW301
IF STOP
QUIT
End DoDot:1
if STOP
QUIT
+26 ;Cleanup and quit
+27 DO EXIT
+28 QUIT
+29 ;
PRTHEAD ;Page Header
+1 ;Input : OUTARR - Data array
+2 ; SCRNARR - Screen array
+3 ; PAGENUM - Page number
+4 ; DIV - Division Name ^ Division Number
+5 ; - NULL if facility name/number should be used
+6 ;Output : None
+7 ; PAGENUM is incremented by 1
+8 ;
+9 NEW TMP,LINE,VISN
+10 WRITE @IOF
+11 WRITE !,"Performance Monitor National Summary Report",?70,"Page: ",PAGENUM
+12 SET LINE="Division: "_$PIECE(DIV,U,1)_" ("_$PIECE(DIV,U,2)_")"
+13 IF DIV=""
Begin DoDot:1
+14 SET TMP=$$SITE^VASITE()
+15 ; SD*5.3*337
DO PARENT^XUAF4("VISN","`"_$PIECE(TMP,U,1))
+16 ; SD*5.3*337
SET VISN=""
SET VISN=$ORDER(VISN("P",VISN))
if VISN=""
QUIT
+17 SET LINE="Facility: "_$PIECE(TMP,U,2)_" ("_$PIECE(TMP,U,3)_")"_" "_$PIECE($GET(VISN("P",VISN)),U,1)
End DoDot:1
+18 WRITE !!,LINE
+19 WRITE !,"Run Date: ",$$HTE^XLFDT($HOROLOG)
+20 WRITE !,"Encounter Date Range: ",$$FMTE^XLFDT($PIECE(@SCRNARR@("RANGE"),U,1))
+21 WRITE " to ",$$FMTE^XLFDT($PIECE(@SCRNARR@("RANGE"),U,2))
+22 IF DIV=""
SET LINE=+$GET(@OUTARR@("SUMMARY"))
+23 IF DIV'=""
SET LINE=+$GET(@OUTARR@("SUBTOTAL",DIV))
+24 WRITE !,"Total number of encounters (denominator): ",LINE
+25 WRITE !!,"Total number of encounters in the denominator are those included in the"
+26 WRITE !,"Performance Monitor cohort"
+27 SET PAGENUM=PAGENUM+1
+28 QUIT
+29 ;
PRTSUMS ;Print summaries
+1 ;Input : SUMNODE - Summary node from OUTARR
+2 ; PINODE - PI node from OUTARR
+3 ;Output : None
+4 ;
+5 IF (SUMNODE="")&(PINODE="")
Begin DoDot:1
+6 WRITE !
+7 WRITE !,"***********************************************"
+8 WRITE !,"* NOTHING TO REPORT FOR SELECTED DATE FRAME *"
+9 WRITE !,"***********************************************"
End DoDot:1
QUIT
+10 NEW VAL,DASH6,TOTENC,CMPENC,PRCNT,TMP,SCANNED,NPN
+11 SET $PIECE(DASH6,"-",6)="-"
+12 SET $PIECE(PRCNT,U,11)=""
+13 ;Get general totals
+14 SET TOTENC=+$PIECE(SUMNODE,U,1)
+15 SET CMPENC=+$PIECE(SUMNODE,U,2)
+16 SET SCANNED=+$PIECE(SUMNODE,U,7)
+17 SET NPN=+$PIECE(SUMNODE,U,9)
+18 ;Calculate compliance percentages
+19 IF TOTENC
SET VAL=0
FOR TMP=1:1:11
Begin DoDot:1
+20 IF (TOTENC-SCANNED)>0
SET VAL=100*($PIECE(PINODE,U,TMP)/(TOTENC-SCANNED))
+21 SET $PIECE(PRCNT,U,TMP)=$TRANSLATE($JUSTIFY(VAL,3,0)," ")_"%"
End DoDot:1
+22 ;Part 1
+23 WRITE !!,"Signed",?21,"Elapsed Time (Days)"
+24 WRITE !,"within",?14,"0-1",?22,">1-2",?31,">2-3",?39,">3-4",?47,">4-5"
+25 WRITE ?55,">5-6",?63,">6-7",?71,">7-8"
+26 WRITE !,?13,DASH6,?21,DASH6,?30,DASH6,?38,DASH6,?46,DASH6,?54,DASH6
+27 WRITE ?62,DASH6,?70,DASH6
+28 WRITE !,"Encounters",?13,+$PIECE(PINODE,U,1),?21,+$PIECE(PINODE,U,2)
+29 WRITE ?30,+$PIECE(PINODE,U,3),?38,+$PIECE(PINODE,U,4),?46,+$PIECE(PINODE,U,5)
+30 WRITE ?54,+$PIECE(PINODE,U,6),?62,+$PIECE(PINODE,U,7),?70,+$PIECE(PINODE,U,8)
+31 WRITE !,"Percentage",?13,$PIECE(PRCNT,U,1),?21,$PIECE(PRCNT,U,2)
+32 WRITE ?30,$PIECE(PRCNT,U,3),?38,$PIECE(PRCNT,U,4),?46,$PIECE(PRCNT,U,5)
+33 WRITE ?54,$PIECE(PRCNT,U,6),?62,$PIECE(PRCNT,U,7),?70,$PIECE(PRCNT,U,8)
+34 ;Part 2
+35 WRITE !!,"Signed",?21,"Elapsed Time (Days)",?45,"Pending",?60,"Scanned"
+36 WRITE !,"within",?14,">8-9",?22,">9-10",?32,">10",?38,"Signatures"
+37 WRITE ?50,"Notes",?59,"Note Only"
+38 WRITE !,?13,DASH6,?21,DASH6,?30,DASH6,?38,DASH6_"----"
+39 WRITE ?50,DASH6,?59,DASH6_"---"
+40 WRITE !,"Encounters",?13,+$PIECE(PINODE,U,9),?21,+$PIECE(PINODE,U,10)
+41 WRITE ?30,+$PIECE(PINODE,U,11),?38,TOTENC-CMPENC-NPN-SCANNED-(+$PIECE(PINODE,U,11))
+42 WRITE ?50,NPN,?59,SCANNED
+43 WRITE !,"Percentage",?13,$PIECE(PRCNT,U,9),?21,$PIECE(PRCNT,U,10)
+44 WRITE ?30,$PIECE(PRCNT,U,11)
+45 SET (VAL,NPNVAL)=0
+46 IF (TOTENC-SCANNED)>0
SET NPNVAL=100*(NPN/(TOTENC-SCANNED))
+47 SET NPNVAL=$TRANSLATE($JUSTIFY(NPNVAL,3,0)," ")_"%"
+48 IF (TOTENC-SCANNED)>0
SET VAL=100*((TOTENC-SCANNED-CMPENC-NPN-(+$PIECE(PINODE,U,11)))/TOTENC)
+49 SET VAL=$TRANSLATE($JUSTIFY(VAL,3,0)," ")_"%"
+50 WRITE ?38,VAL,?50,NPNVAL,?59,"N/A"
+51 QUIT
+52 ;
EXIT ;Kill temporary arrays
+1 KILL @OUTARR
EX1 KILL @SORTARR,@SCRNARR
+1 QUIT
