ADGDSIP1 ; IHS/ADC/PDW/ENM - DS CHART DEFICIENCY LIST ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
A ;--main
U IO D INI F DGII=1:1:DGNUM D LPRV Q:DGSTOP=U
I DGSTOP=U D END1 Q
I DGSUMPG=2!(DGSUMPG=3) D
. I DGPAGE>0,(IOST["C-") K DIR S DIR(0)="E" D ^DIR Q:X=U
. D ^ADGDSIP2 ;summary page
I DGSTOP=U D END1 Q
D END Q
;
INI ;--initialize variables
S DGSTOP="",DGFLG=0,DGPAGE=0,$P(DGLIN,"=",80)=""
S DGDUZ=$P(^VA(200,DUZ,0),U,2) S DGFAC=$P(^DIC(4,DUZ(2),0),U)
K ^TMP("DGZICPL1",$J) ;summary page counts
Q
;
END ;--cleanup
I IOST?1"C-".E D PRTOPT^ADGVAR
END1 D KILL^ADGUTIL,^%ZISC
K ^TMP("DGZICPL",$J),^TMP("DGZICPL1",$J)
Q
;
LPRV ;--loop provider
N PR
S PR="" F S PR=$O(^TMP("DGZICPL",$J,PR)) Q:PR=""!(DGSTOP=U) D
. D PINI,NEWPG,LUTL Q:DGSTOP=U
. D:DGSUMPG=1!(DGSUMPG=3) TOTALS D SUM
Q
;
PINI ;--provider name and zero counts
S DGPRVN=PR,DGTCNT=0
F DGI="SIG","ISG","SUM","ASH","OPR","DEL" S DGCNT(DGI)=0
Q
;
LUTL ;--loop disch date, patient name, dfn
N SD,NM,DFN
S SD=0 F S SD=$O(^TMP("DGZICPL",$J,PR,SD)) Q:'SD!(DGSTOP=U) D
. S NM=""
. F S NM=$O(^TMP("DGZICPL",$J,PR,SD,NM)) Q:NM=""!(DGSTOP=U) D
.. S DFN=0
.. F S DFN=$O(^TMP("DGZICPL",$J,PR,SD,NM,DFN)) Q:'DFN!(DGSTOP=U) D 1
Q
;
1 ;--incomplete chart file data
N N,CHT,SUM,OPD,OPR,J
S N=^TMP("DGZICPL",$J,PR,SD,NM,DFN)
S CHT=$P(N,U),OPD=$P(N,U,2),OPR=$P(N,U,3)
;--total incomplete charts for provider
S DGTCNT=DGTCNT+1,^TMP("DGZICPL1",$J,"Z",DFN)=""
;--write patient line
I DGSUMPG'=2 D Q:DGSTOP=U
. I $Y>(IOSL-6) D NEWPG Q:DGSTOP=U
. W !!,$E(NM,1,20),?22,$J(CHT,6)
. W ?30,$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)
. W:OPD'="" ?40,$E(OPD,4,5)_"/"_$E(OPD,6,7)_"/"_$E(OPD,2,3)
. W:OPR'="" ?50,$E(OPR,4,5)_"/"_$E(OPR,6,7)_"/"_$E(OPR,2,3)
;--loop deficiencies
F J=4:1 Q:'$P(N,U,J) D CHDEF
;--loop delinquencies ("isg" 'del sig)
S J="" F S J=$O(DGA(J)) Q:J="" S DGCNT(J)=DGCNT(J)+1
K DGA S DGFLG=0
Q
;
CHDEF ;--chart deficiencies
N CD,GRP
S DGX=^ADGCD($P(N,U,J),0),CD=$P(DGX,U),GRP=$P(DGX,U,3)
I GRP="" W:DGSUMPG'=2 ?59,CD,! Q
;--deficient for signature
I GRP="SIG",(SD>DGDEL) S DGA("ISG")=1,GRP="" W:DGSUMPG'=2 ?59,CD,! Q
;--not delinquent (a sheet excluded)
;I SD>DGDEL,(GRP'="ASH") S GRP="" W:DGSUMPG'=2 ?59,CD,! Q
I SD>DGDEL S GRP="" W:DGSUMPG'=2 ?59,CD,! Q
;--delinquent charts
S DGA(GRP)=1
I DGFLG'=DFN D
. S DGCNT("DEL")=DGCNT("DEL")+1,DGFLG=DFN
. S ^TMP("DGZICPL1",$J,"ZZ",DFN)=""
W:DGSUMPG'=2 ?59,$S(GRP="":" ",1:"*"),CD,$S(GRP="":" ",1:"*"),!
Q
;
TOTALS ;--print totals for each provider
;--incomplete
I $Y>(IOSL-9) D NEWPG Q:DGSTOP=U
W !!?20,"TOTAL INCOMPLETE CHARTS: ",$J(DGTCNT,3)
I DGCNT("ISG") D
. W !?17,"# Incomplete for SIGNATURE: ",$J(DGCNT("ISG"),3)
;--delinquent
W !!?20,"TOTAL DELINQUENT CHARTS: ",$J(DGCNT("DEL"),3)
I DGCNT("OPR") D
. W !?17,"# Delinquent for OP REPORT: ",$J(DGCNT("OPR"),3)
I DGCNT("SIG") D
. W !?17,"# Delinquent for SIGNATURE: ",$J(DGCNT("SIG"),3)
Q
;
SUM ;--set ^TMP for summary page
S ^TMP("DGZICPL1",$J,DGPRVN)=DGTCNT_U_DGCNT("ISG")_U_DGCNT("DEL")_U_DGCNT("OPR")_U_DGCNT("SIG")
Q
;
HEAD ;--heading
Q:DGSUMPG=2
I DGPAGE>0!(IOST["C-") W @IOF
W ?12,"*****Confidential Patient Data Covered by Privacy Act*****"
W !?80-$L(DGFAC)/2,DGFAC,!,DGDUZ
W ?22,"DAY SURGERY INCOMPLETE CHART LIST FOR"
W !,$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
W ?80-$L(DGPRVN)/2,DGPRVN
S DGPAGE=DGPAGE+1 W ?65,"Page ",DGPAGE
W !!,"Patient Name",?22,"HRCN",?30,"Surg Date",?40,"Op Dict"
W ?50,"Op Rcvd",?60,"Chart Deficiency",!,DGLIN
Q
;
NEWPG ;--page control
Q:DGSUMPG=2
;--printer
I DGPAGE=0!(IOST'?1"C-".E) D HEAD Q
;--terminal
K DIR S DIR(0)="E" D ^DIR S DGSTOP=X
Q:X=U D HEAD Q
ADGDSIP1 ; IHS/ADC/PDW/ENM - DS CHART DEFICIENCY LIST ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
A ;--main
+1 USE IO
DO INI
FOR DGII=1:1:DGNUM
DO LPRV
IF DGSTOP=U
QUIT
+2 IF DGSTOP=U
DO END1
QUIT
+3 IF DGSUMPG=2!(DGSUMPG=3)
Begin DoDot:1
+4 IF DGPAGE>0
IF (IOST["C-")
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF X=U
QUIT
+5 ;summary page
DO ^ADGDSIP2
End DoDot:1
+6 IF DGSTOP=U
DO END1
QUIT
+7 DO END
QUIT
+8 ;
INI ;--initialize variables
+1 SET DGSTOP=""
SET DGFLG=0
SET DGPAGE=0
SET $PIECE(DGLIN,"=",80)=""
+2 SET DGDUZ=$PIECE(^VA(200,DUZ,0),U,2)
SET DGFAC=$PIECE(^DIC(4,DUZ(2),0),U)
+3 ;summary page counts
KILL ^TMP("DGZICPL1",$JOB)
+4 QUIT
+5 ;
END ;--cleanup
+1 IF IOST?1"C-".E
DO PRTOPT^ADGVAR
END1 DO KILL^ADGUTIL
DO ^%ZISC
+1 KILL ^TMP("DGZICPL",$JOB),^TMP("DGZICPL1",$JOB)
+2 QUIT
+3 ;
LPRV ;--loop provider
+1 NEW PR
+2 SET PR=""
FOR
SET PR=$ORDER(^TMP("DGZICPL",$JOB,PR))
IF PR=""!(DGSTOP=U)
QUIT
Begin DoDot:1
+3 DO PINI
DO NEWPG
DO LUTL
IF DGSTOP=U
QUIT
+4 IF DGSUMPG=1!(DGSUMPG=3)
DO TOTALS
DO SUM
End DoDot:1
+5 QUIT
+6 ;
PINI ;--provider name and zero counts
+1 SET DGPRVN=PR
SET DGTCNT=0
+2 FOR DGI="SIG","ISG","SUM","ASH","OPR","DEL"
SET DGCNT(DGI)=0
+3 QUIT
+4 ;
LUTL ;--loop disch date, patient name, dfn
+1 NEW SD,NM,DFN
+2 SET SD=0
FOR
SET SD=$ORDER(^TMP("DGZICPL",$JOB,PR,SD))
IF 'SD!(DGSTOP=U)
QUIT
Begin DoDot:1
+3 SET NM=""
+4 FOR
SET NM=$ORDER(^TMP("DGZICPL",$JOB,PR,SD,NM))
IF NM=""!(DGSTOP=U)
QUIT
Begin DoDot:2
+5 SET DFN=0
+6 FOR
SET DFN=$ORDER(^TMP("DGZICPL",$JOB,PR,SD,NM,DFN))
IF 'DFN!(DGSTOP=U)
QUIT
DO 1
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
1 ;--incomplete chart file data
+1 NEW N,CHT,SUM,OPD,OPR,J
+2 SET N=^TMP("DGZICPL",$JOB,PR,SD,NM,DFN)
+3 SET CHT=$PIECE(N,U)
SET OPD=$PIECE(N,U,2)
SET OPR=$PIECE(N,U,3)
+4 ;--total incomplete charts for provider
+5 SET DGTCNT=DGTCNT+1
SET ^TMP("DGZICPL1",$JOB,"Z",DFN)=""
+6 ;--write patient line
+7 IF DGSUMPG'=2
Begin DoDot:1
+8 IF $Y>(IOSL-6)
DO NEWPG
IF DGSTOP=U
QUIT
+9 WRITE !!,$EXTRACT(NM,1,20),?22,$JUSTIFY(CHT,6)
+10 WRITE ?30,$EXTRACT(SD,4,5)_"/"_$EXTRACT(SD,6,7)_"/"_$EXTRACT(SD,2,3)
+11 IF OPD'=""
WRITE ?40,$EXTRACT(OPD,4,5)_"/"_$EXTRACT(OPD,6,7)_"/"_$EXTRACT(OPD,2,3)
+12 IF OPR'=""
WRITE ?50,$EXTRACT(OPR,4,5)_"/"_$EXTRACT(OPR,6,7)_"/"_$EXTRACT(OPR,2,3)
End DoDot:1
IF DGSTOP=U
QUIT
+13 ;--loop deficiencies
+14 FOR J=4:1
IF '$PIECE(N,U,J)
QUIT
DO CHDEF
+15 ;--loop delinquencies ("isg" 'del sig)
+16 SET J=""
FOR
SET J=$ORDER(DGA(J))
IF J=""
QUIT
SET DGCNT(J)=DGCNT(J)+1
+17 KILL DGA
SET DGFLG=0
+18 QUIT
+19 ;
CHDEF ;--chart deficiencies
+1 NEW CD,GRP
+2 SET DGX=^ADGCD($PIECE(N,U,J),0)
SET CD=$PIECE(DGX,U)
SET GRP=$PIECE(DGX,U,3)
+3 IF GRP=""
IF DGSUMPG'=2
WRITE ?59,CD,!
QUIT
+4 ;--deficient for signature
+5 IF GRP="SIG"
IF (SD>DGDEL)
SET DGA("ISG")=1
SET GRP=""
IF DGSUMPG'=2
WRITE ?59,CD,!
QUIT
+6 ;--not delinquent (a sheet excluded)
+7 ;I SD>DGDEL,(GRP'="ASH") S GRP="" W:DGSUMPG'=2 ?59,CD,! Q
+8 IF SD>DGDEL
SET GRP=""
IF DGSUMPG'=2
WRITE ?59,CD,!
QUIT
+9 ;--delinquent charts
+10 SET DGA(GRP)=1
+11 IF DGFLG'=DFN
Begin DoDot:1
+12 SET DGCNT("DEL")=DGCNT("DEL")+1
SET DGFLG=DFN
+13 SET ^TMP("DGZICPL1",$JOB,"ZZ",DFN)=""
End DoDot:1
+14 IF DGSUMPG'=2
WRITE ?59,$SELECT(GRP="":" ",1:"*"),CD,$SELECT(GRP="":" ",1:"*"),!
+15 QUIT
+16 ;
TOTALS ;--print totals for each provider
+1 ;--incomplete
+2 IF $Y>(IOSL-9)
DO NEWPG
IF DGSTOP=U
QUIT
+3 WRITE !!?20,"TOTAL INCOMPLETE CHARTS: ",$JUSTIFY(DGTCNT,3)
+4 IF DGCNT("ISG")
Begin DoDot:1
+5 WRITE !?17,"# Incomplete for SIGNATURE: ",$JUSTIFY(DGCNT("ISG"),3)
End DoDot:1
+6 ;--delinquent
+7 WRITE !!?20,"TOTAL DELINQUENT CHARTS: ",$JUSTIFY(DGCNT("DEL"),3)
+8 IF DGCNT("OPR")
Begin DoDot:1
+9 WRITE !?17,"# Delinquent for OP REPORT: ",$JUSTIFY(DGCNT("OPR"),3)
End DoDot:1
+10 IF DGCNT("SIG")
Begin DoDot:1
+11 WRITE !?17,"# Delinquent for SIGNATURE: ",$JUSTIFY(DGCNT("SIG"),3)
End DoDot:1
+12 QUIT
+13 ;
SUM ;--set ^TMP for summary page
+1 SET ^TMP("DGZICPL1",$JOB,DGPRVN)=DGTCNT_U_DGCNT("ISG")_U_DGCNT("DEL")_U_DGCNT("OPR")_U_DGCNT("SIG")
+2 QUIT
+3 ;
HEAD ;--heading
+1 IF DGSUMPG=2
QUIT
+2 IF DGPAGE>0!(IOST["C-")
WRITE @IOF
+3 WRITE ?12,"*****Confidential Patient Data Covered by Privacy Act*****"
+4 WRITE !?80-$LENGTH(DGFAC)/2,DGFAC,!,DGDUZ
+5 WRITE ?22,"DAY SURGERY INCOMPLETE CHART LIST FOR"
+6 WRITE !,$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+7 WRITE ?80-$LENGTH(DGPRVN)/2,DGPRVN
+8 SET DGPAGE=DGPAGE+1
WRITE ?65,"Page ",DGPAGE
+9 WRITE !!,"Patient Name",?22,"HRCN",?30,"Surg Date",?40,"Op Dict"
+10 WRITE ?50,"Op Rcvd",?60,"Chart Deficiency",!,DGLIN
+11 QUIT
+12 ;
NEWPG ;--page control
+1 IF DGSUMPG=2
QUIT
+2 ;--printer
+3 IF DGPAGE=0!(IOST'?1"C-".E)
DO HEAD
QUIT
+4 ;--terminal
+5 KILL DIR
SET DIR(0)="E"
DO ^DIR
SET DGSTOP=X
+6 IF X=U
QUIT
DO HEAD
QUIT
