SCRPI02A ; ALB/SCK - Print IEMM Statistical Summary Report ; 6/26/97
;;5.3;Scheduling;**66,143**;AUG 13, 1993
;
PRINT ; print Summary Report
; Variables
;
N DASH,DBLDASH,PAGE,SDIV,SDNAME,SDT,SCABORT,TOTALS,SDMSG,LINE
;
K ^TMP("SCRPI ERRORS",$J)
I $G(SDBLT) D
. S IOM=80
S $P(DASH,"-",IOM-1)="",$P(DBLDASH,"=",IOM-1)=""
S PAGE=0
;
I '$D(^TMP("SCRPI SUM",$J)) D G PRNQ
. D HDR1
. S X="No Incomplete Encounters found."
. D WRT(DBLDASH)
. D WRT(" "),WRT(X)
;
I SDRTYP["S" D PRNTSUM
I SDRTYP["D" D PRNTDTL
;
I $D(TOTALS) D
. D WRT(" "),WRT(" ")
. S X=" Total Encounters: "_(+$G(TOTALS("TOT"))++$G(TOTALS("DTOT"))) D WRT(X)
. S X=" Total Incomplete Encounters: "_(+$G(TOTALS("INC"))++$G(TOTALS("DINC"))) D WRT(X)
;
PRNQ ;
D:$G(SDBLT) SENDMSG
K ^TMP("SCRPI ERRS",$J)
Q
;
PRNTSUM ; Print encounter summary for each clinic
; Variables
;
N SDDCLN,SDIVN
;
S SDIVN="" F S SDIVN=$O(^TMP("SCRPI SUM",$J,SDIVN)) Q:SDIVN']"" D Q:$G(SCABORT)
. D HDR1 Q:$G(SCABORT) D HDR2
. S SDDCLN="" F S SDDCLN=$O(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN)) Q:SDDCLN']"" D Q:$G(SCABORT)
.. D PRNTCLN(SDIVN,SDDCLN)
.. I '$G(SDBLT),$Y>(IOSL-5) D HDR1 Q:$G(SCABORT) D HDR2
Q
;
PRNTCLN(SDIVN,SDDCLN) ;
N INC,TOT,DINC,DTOT,XN,SDPER
;
S INC=+$P($G(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,0)),U,1)
S TOT=+$P($G(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,0)),U,3)
S DINC=+$P($G(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,0)),U,2)
S DTOT=+$P($G(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,0)),U,4)
Q:'INC
S X=SDDCLN
S X=X_$$SPACE^SCRPIUT1(33-$L(X))_$J(TOT+DTOT,6)
S XN=" ("_$S(DTOT]"":DTOT,1:0)_")"
S X=X_XN
S X=X_$$SPACE^SCRPIUT1(48-$L(X))_$J(INC+DINC,6)
S XN=" ("_$S(DINC]"":DINC,1:0)_")"
S X=X_XN
S SDPER=((INC+DINC)/(TOT+DTOT))*100
S X=X_$$SPACE^SCRPIUT1(65-$L(X))_$J(SDPER,6,1)_"%"
D WRT(X)
S TOTALS("INC")=+$G(TOTALS("INC"))+INC
S TOTALS("TOT")=+$G(TOTALS("TOT"))+TOT
S TOTALS("DINC")=+$G(TOTALS("DINC"))+DINC
S TOTALS("DTOT")=+$G(TOTALS("DTOT"))+DTOT
Q
;
PRNTDTL ; Print error details for each clinic
; Variables
;
N SDDCLN,SDIVN
;
S SDIVN="" F S SDIVN=$O(^TMP("SCRPI SUM",$J,SDIVN)) Q:SDIVN']"" D Q:$G(SCABORT)
. S SDDCLN="" F S SDDCLN=$O(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN)) Q:SDDCLN']"" D Q:$G(SCABORT)
.. Q:'$P(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,0),U)
.. D HDR1 Q:$G(SCABORT) D HDR3
.. D PRNERRS(SDIVN,SDDCLN)
Q
;
PRNERRS(SDIVN,SDDCLN) ;
N SDER,SDEC,SDERC,SDPER,SDETOT
;
K ^TMP("SCRPI ERRS",$J)
;
S SDER=0 F S SDER=$O(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,SDER)) Q:'SDER D
. S SDETOT=+$G(SDETOT)++$G(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,SDER,0))
;
S SDER=0 F S SDER=$O(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,SDER)) Q:'SDER D Q:$G(SCABORT)
. S SDERC=+$G(^TMP("SCRPI SUM",$J,SDIVN,SDDCLN,SDER,0))
. I +SDETOT>0 S SDPER=(SDERC/SDETOT)*100
. S ^TMP("SCRPI ERRS",$J,SDERC,SDER)=+SDPER
. I '$G(SDBLT),$Y>(IOSL-5) D HDR1 Q:$G(SCABORT) D HDR3
;
S SDERC=999999 F S SDERC=$O(^TMP("SCRPI ERRS",$J,SDERC),-1) Q:'SDERC D Q:$G(SCABORT)
. S SDER="" F S SDER=$O(^TMP("SCRPI ERRS",$J,SDERC,SDER)) Q:'SDER D Q:$G(SCABORT)
.. S SDEC=$E($G(^SD(409.76,SDER,1)),1,52)
.. I $L($G(^SD(409.76,SDER,1)))>52 S SDEC=SDEC_"..."
.. W !,SDEC,?57,$J(SDERC,6),?70,$J(^TMP("SCRPI ERRS",$J,SDERC,SDER),6,1)_"%"
.. I '$G(SDBLT),$Y>(IOSL-5) D HDR1 Q:$G(SCABORT) D HDR3
D PRNTOT(SDIVN,SDDCLN)
Q
;
PRNTOT(SDIV,SDDCL) ;
I '$G(SDBLT),$Y>(IOSL-5) D HDR1 Q:$G(SCABORT) D HDR3
S INC=+$P($G(^TMP("SCRPI SUM",$J,SDIV,SDDCL,0)),U,1)
S TOT=+$P($G(^TMP("SCRPI SUM",$J,SDIV,SDDCL,0)),U,3)
S DINC=+$P($G(^TMP("SCRPI SUM",$J,SDIV,SDDCL,0)),U,2)
S DTOT=+$P($G(^TMP("SCRPI SUM",$J,SDIV,SDDCL,0)),U,4)
W !!!," Incomplete Encounters: ",$J(INC,6,0)
W !," Total Encounters: ",$J(TOT,6,0)
W !,"(Deleted) Incomplete Encounters: ",$J(DINC,6,0)
W !," (Deleted) Total Encounters: ",$J(DTOT,6,0)
;
;
Q
;
HDR1 ; Print report header
N SDL,X
;
I $$S^%ZTLOAD S SCABORT=1 Q
I 'PAGE,IOST?1"C-".E W @IOF
I PAGE,IOST?1"C-".E D Q:$G(SCABORT)
. S DIR(0)="E" D ^DIR K DIR S SCABORT='+$G(Y)
. W @IOF
E D
. I '$G(SDBLT),PAGE W @IOF
;
S PAGE=PAGE+1
I $G(SDBLT) D WRT(""),WRT("")
S X="Date: "_$$FDATE^VALM1($$DT^XLFDT)
S X=X_$$SPACE^SCRPIUT1(17-$L(X))_"Incomplete Encounter Mgmt Summary Error Report"
S X=X_$$SPACE^SCRPIUT1((79-$L(X))-$L("PAGE: "_PAGE))_"PAGE: "_PAGE
D WRT(X)
S X="Date Range: "_$$FMTE^XLFDT($P(SDDT,U))_" to "_$$FMTE^XLFDT($P(SDDT,U,2))
D CTR^SCRPIUT1(.X),WRT(X)
Q
;
HDR2 ;
N X
S X="Division: "_$S($G(SDIVN)]"":SDIVN,1:" ---")
D CTR^SCRPIUT1(.X),WRT(X)
S X="Clinic Summary - Incomplete Encounters"
D CTR^SCRPIUT1(.X),WRT(X)
D WRT(""),WRT("")
;
S X="Clinic"_$$SPACE^SCRPIUT1(30)_"Encounters"_$$SPACE^SCRPIUT1(5)_"Incomplete"_$$SPACE^SCRPIUT1(5)_"Percentage"
D WRT(X),WRT(DBLDASH)
S X="Note: (nn) = Number of total encounters which are deleted encounters"
D CTR^SCRPIUT1(.X),WRT(X),WRT("")
Q
;
HDR3 ;
S X="Division: "_$S($G(SDIVN)]"":SDIVN,1:" ---")
D CTR^SCRPIUT1(.X),WRT(X)
S X="Clinic: "_$S($G(SDDCLN)]"":SDDCLN,1:" ---")
D CTR^SCRPIUT1(.X),WRT(X),WRT("")
S X=$$SPACE^SCRPIUT1(55)_"Number of"_$$SPACE^SCRPIUT1(8)_"Percent" D WRT(X)
S X="Error"_$$SPACE^SCRPIUT1(50)_"Occurrences"_$$SPACE^SCRPIUT1(5)_"of Total" D WRT(X)
D WRT(DBLDASH)
S X="< Errors in descending order of occurrence >" D CTR^SCRPIUT1(.X),WRT(X),WRT("")
Q
;
WRT(X) ; Write string to either output device or bulletin array
I $G(SDBLT) D
. S LINE=+$G(LINE)+1
. S SDMSG(LINE)=X
E D
. I $Y>(IOSL-5) D HDR1 Q:$G(SCABORT)
. W !,X
Q
;
SENDMSG ; Sends bulletin message
N XMB,XMDUZ,XMTEXT
;
S XMB="SCDX INCOMPLETE ENCOUNTER MGMT"
S XMB(1)="IEMM Summary Report"
S XMDUZ="INCOMPLETE ENCOUNTER MANAGEMENT"
;
S XMTEXT="SDMSG("
D ^XMB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPI02A 5879 printed Dec 13, 2024@02:42:32 Page 2
SCRPI02A ; ALB/SCK - Print IEMM Statistical Summary Report ; 6/26/97
+1 ;;5.3;Scheduling;**66,143**;AUG 13, 1993
+2 ;
PRINT ; print Summary Report
+1 ; Variables
+2 ;
+3 NEW DASH,DBLDASH,PAGE,SDIV,SDNAME,SDT,SCABORT,TOTALS,SDMSG,LINE
+4 ;
+5 KILL ^TMP("SCRPI ERRORS",$JOB)
+6 IF $GET(SDBLT)
Begin DoDot:1
+7 SET IOM=80
End DoDot:1
+8 SET $PIECE(DASH,"-",IOM-1)=""
SET $PIECE(DBLDASH,"=",IOM-1)=""
+9 SET PAGE=0
+10 ;
+11 IF '$DATA(^TMP("SCRPI SUM",$JOB))
Begin DoDot:1
+12 DO HDR1
+13 SET X="No Incomplete Encounters found."
+14 DO WRT(DBLDASH)
+15 DO WRT(" ")
DO WRT(X)
End DoDot:1
GOTO PRNQ
+16 ;
+17 IF SDRTYP["S"
DO PRNTSUM
+18 IF SDRTYP["D"
DO PRNTDTL
+19 ;
+20 IF $DATA(TOTALS)
Begin DoDot:1
+21 DO WRT(" ")
DO WRT(" ")
+22 SET X=" Total Encounters: "_(+$GET(TOTALS("TOT"))++$GET(TOTALS("DTOT")))
DO WRT(X)
+23 SET X=" Total Incomplete Encounters: "_(+$GET(TOTALS("INC"))++$GET(TOTALS("DINC")))
DO WRT(X)
End DoDot:1
+24 ;
PRNQ ;
+1 if $GET(SDBLT)
DO SENDMSG
+2 KILL ^TMP("SCRPI ERRS",$JOB)
+3 QUIT
+4 ;
PRNTSUM ; Print encounter summary for each clinic
+1 ; Variables
+2 ;
+3 NEW SDDCLN,SDIVN
+4 ;
+5 SET SDIVN=""
FOR
SET SDIVN=$ORDER(^TMP("SCRPI SUM",$JOB,SDIVN))
if SDIVN']""
QUIT
Begin DoDot:1
+6 DO HDR1
if $GET(SCABORT)
QUIT
DO HDR2
+7 SET SDDCLN=""
FOR
SET SDDCLN=$ORDER(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN))
if SDDCLN']""
QUIT
Begin DoDot:2
+8 DO PRNTCLN(SDIVN,SDDCLN)
+9 IF '$GET(SDBLT)
IF $Y>(IOSL-5)
DO HDR1
if $GET(SCABORT)
QUIT
DO HDR2
End DoDot:2
if $GET(SCABORT)
QUIT
End DoDot:1
if $GET(SCABORT)
QUIT
+10 QUIT
+11 ;
PRNTCLN(SDIVN,SDDCLN) ;
+1 NEW INC,TOT,DINC,DTOT,XN,SDPER
+2 ;
+3 SET INC=+$PIECE($GET(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,0)),U,1)
+4 SET TOT=+$PIECE($GET(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,0)),U,3)
+5 SET DINC=+$PIECE($GET(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,0)),U,2)
+6 SET DTOT=+$PIECE($GET(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,0)),U,4)
+7 if 'INC
QUIT
+8 SET X=SDDCLN
+9 SET X=X_$$SPACE^SCRPIUT1(33-$LENGTH(X))_$JUSTIFY(TOT+DTOT,6)
+10 SET XN=" ("_$SELECT(DTOT]"":DTOT,1:0)_")"
+11 SET X=X_XN
+12 SET X=X_$$SPACE^SCRPIUT1(48-$LENGTH(X))_$JUSTIFY(INC+DINC,6)
+13 SET XN=" ("_$SELECT(DINC]"":DINC,1:0)_")"
+14 SET X=X_XN
+15 SET SDPER=((INC+DINC)/(TOT+DTOT))*100
+16 SET X=X_$$SPACE^SCRPIUT1(65-$LENGTH(X))_$JUSTIFY(SDPER,6,1)_"%"
+17 DO WRT(X)
+18 SET TOTALS("INC")=+$GET(TOTALS("INC"))+INC
+19 SET TOTALS("TOT")=+$GET(TOTALS("TOT"))+TOT
+20 SET TOTALS("DINC")=+$GET(TOTALS("DINC"))+DINC
+21 SET TOTALS("DTOT")=+$GET(TOTALS("DTOT"))+DTOT
+22 QUIT
+23 ;
PRNTDTL ; Print error details for each clinic
+1 ; Variables
+2 ;
+3 NEW SDDCLN,SDIVN
+4 ;
+5 SET SDIVN=""
FOR
SET SDIVN=$ORDER(^TMP("SCRPI SUM",$JOB,SDIVN))
if SDIVN']""
QUIT
Begin DoDot:1
+6 SET SDDCLN=""
FOR
SET SDDCLN=$ORDER(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN))
if SDDCLN']""
QUIT
Begin DoDot:2
+7 if '$PIECE(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,0),U)
QUIT
+8 DO HDR1
if $GET(SCABORT)
QUIT
DO HDR3
+9 DO PRNERRS(SDIVN,SDDCLN)
End DoDot:2
if $GET(SCABORT)
QUIT
End DoDot:1
if $GET(SCABORT)
QUIT
+10 QUIT
+11 ;
PRNERRS(SDIVN,SDDCLN) ;
+1 NEW SDER,SDEC,SDERC,SDPER,SDETOT
+2 ;
+3 KILL ^TMP("SCRPI ERRS",$JOB)
+4 ;
+5 SET SDER=0
FOR
SET SDER=$ORDER(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,SDER))
if 'SDER
QUIT
Begin DoDot:1
+6 SET SDETOT=+$GET(SDETOT)++$GET(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,SDER,0))
End DoDot:1
+7 ;
+8 SET SDER=0
FOR
SET SDER=$ORDER(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,SDER))
if 'SDER
QUIT
Begin DoDot:1
+9 SET SDERC=+$GET(^TMP("SCRPI SUM",$JOB,SDIVN,SDDCLN,SDER,0))
+10 IF +SDETOT>0
SET SDPER=(SDERC/SDETOT)*100
+11 SET ^TMP("SCRPI ERRS",$JOB,SDERC,SDER)=+SDPER
+12 IF '$GET(SDBLT)
IF $Y>(IOSL-5)
DO HDR1
if $GET(SCABORT)
QUIT
DO HDR3
End DoDot:1
if $GET(SCABORT)
QUIT
+13 ;
+14 SET SDERC=999999
FOR
SET SDERC=$ORDER(^TMP("SCRPI ERRS",$JOB,SDERC),-1)
if 'SDERC
QUIT
Begin DoDot:1
+15 SET SDER=""
FOR
SET SDER=$ORDER(^TMP("SCRPI ERRS",$JOB,SDERC,SDER))
if 'SDER
QUIT
Begin DoDot:2
+16 SET SDEC=$EXTRACT($GET(^SD(409.76,SDER,1)),1,52)
+17 IF $LENGTH($GET(^SD(409.76,SDER,1)))>52
SET SDEC=SDEC_"..."
+18 WRITE !,SDEC,?57,$JUSTIFY(SDERC,6),?70,$JUSTIFY(^TMP("SCRPI ERRS",$JOB,SDERC,SDER),6,1)_"%"
+19 IF '$GET(SDBLT)
IF $Y>(IOSL-5)
DO HDR1
if $GET(SCABORT)
QUIT
DO HDR3
End DoDot:2
if $GET(SCABORT)
QUIT
End DoDot:1
if $GET(SCABORT)
QUIT
+20 DO PRNTOT(SDIVN,SDDCLN)
+21 QUIT
+22 ;
PRNTOT(SDIV,SDDCL) ;
+1 IF '$GET(SDBLT)
IF $Y>(IOSL-5)
DO HDR1
if $GET(SCABORT)
QUIT
DO HDR3
+2 SET INC=+$PIECE($GET(^TMP("SCRPI SUM",$JOB,SDIV,SDDCL,0)),U,1)
+3 SET TOT=+$PIECE($GET(^TMP("SCRPI SUM",$JOB,SDIV,SDDCL,0)),U,3)
+4 SET DINC=+$PIECE($GET(^TMP("SCRPI SUM",$JOB,SDIV,SDDCL,0)),U,2)
+5 SET DTOT=+$PIECE($GET(^TMP("SCRPI SUM",$JOB,SDIV,SDDCL,0)),U,4)
+6 WRITE !!!," Incomplete Encounters: ",$JUSTIFY(INC,6,0)
+7 WRITE !," Total Encounters: ",$JUSTIFY(TOT,6,0)
+8 WRITE !,"(Deleted) Incomplete Encounters: ",$JUSTIFY(DINC,6,0)
+9 WRITE !," (Deleted) Total Encounters: ",$JUSTIFY(DTOT,6,0)
+10 ;
+11 ;
+12 QUIT
+13 ;
HDR1 ; Print report header
+1 NEW SDL,X
+2 ;
+3 IF $$S^%ZTLOAD
SET SCABORT=1
QUIT
+4 IF 'PAGE
IF IOST?1"C-".E
WRITE @IOF
+5 IF PAGE
IF IOST?1"C-".E
Begin DoDot:1
+6 SET DIR(0)="E"
DO ^DIR
KILL DIR
SET SCABORT='+$GET(Y)
+7 WRITE @IOF
End DoDot:1
if $GET(SCABORT)
QUIT
+8 IF '$TEST
Begin DoDot:1
+9 IF '$GET(SDBLT)
IF PAGE
WRITE @IOF
End DoDot:1
+10 ;
+11 SET PAGE=PAGE+1
+12 IF $GET(SDBLT)
DO WRT("")
DO WRT("")
+13 SET X="Date: "_$$FDATE^VALM1($$DT^XLFDT)
+14 SET X=X_$$SPACE^SCRPIUT1(17-$LENGTH(X))_"Incomplete Encounter Mgmt Summary Error Report"
+15 SET X=X_$$SPACE^SCRPIUT1((79-$LENGTH(X))-$LENGTH("PAGE: "_PAGE))_"PAGE: "_PAGE
+16 DO WRT(X)
+17 SET X="Date Range: "_$$FMTE^XLFDT($PIECE(SDDT,U))_" to "_$$FMTE^XLFDT($PIECE(SDDT,U,2))
+18 DO CTR^SCRPIUT1(.X)
DO WRT(X)
+19 QUIT
+20 ;
HDR2 ;
+1 NEW X
+2 SET X="Division: "_$SELECT($GET(SDIVN)]"":SDIVN,1:" ---")
+3 DO CTR^SCRPIUT1(.X)
DO WRT(X)
+4 SET X="Clinic Summary - Incomplete Encounters"
+5 DO CTR^SCRPIUT1(.X)
DO WRT(X)
+6 DO WRT("")
DO WRT("")
+7 ;
+8 SET X="Clinic"_$$SPACE^SCRPIUT1(30)_"Encounters"_$$SPACE^SCRPIUT1(5)_"Incomplete"_$$SPACE^SCRPIUT1(5)_"Percentage"
+9 DO WRT(X)
DO WRT(DBLDASH)
+10 SET X="Note: (nn) = Number of total encounters which are deleted encounters"
+11 DO CTR^SCRPIUT1(.X)
DO WRT(X)
DO WRT("")
+12 QUIT
+13 ;
HDR3 ;
+1 SET X="Division: "_$SELECT($GET(SDIVN)]"":SDIVN,1:" ---")
+2 DO CTR^SCRPIUT1(.X)
DO WRT(X)
+3 SET X="Clinic: "_$SELECT($GET(SDDCLN)]"":SDDCLN,1:" ---")
+4 DO CTR^SCRPIUT1(.X)
DO WRT(X)
DO WRT("")
+5 SET X=$$SPACE^SCRPIUT1(55)_"Number of"_$$SPACE^SCRPIUT1(8)_"Percent"
DO WRT(X)
+6 SET X="Error"_$$SPACE^SCRPIUT1(50)_"Occurrences"_$$SPACE^SCRPIUT1(5)_"of Total"
DO WRT(X)
+7 DO WRT(DBLDASH)
+8 SET X="< Errors in descending order of occurrence >"
DO CTR^SCRPIUT1(.X)
DO WRT(X)
DO WRT("")
+9 QUIT
+10 ;
WRT(X) ; Write string to either output device or bulletin array
+1 IF $GET(SDBLT)
Begin DoDot:1
+2 SET LINE=+$GET(LINE)+1
+3 SET SDMSG(LINE)=X
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 IF $Y>(IOSL-5)
DO HDR1
if $GET(SCABORT)
QUIT
+6 WRITE !,X
End DoDot:1
+7 QUIT
+8 ;
SENDMSG ; Sends bulletin message
+1 NEW XMB,XMDUZ,XMTEXT
+2 ;
+3 SET XMB="SCDX INCOMPLETE ENCOUNTER MGMT"
+4 SET XMB(1)="IEMM Summary Report"
+5 SET XMDUZ="INCOMPLETE ENCOUNTER MANAGEMENT"
+6 ;
+7 SET XMTEXT="SDMSG("
+8 DO ^XMB
+9 QUIT
