ADGOASP ; IHS/ADC/PDW/ENM - PRINT OUTSTANDING A SHEETS LIST ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
;***> initialize variables
S DGPAGE=0,DGSTOP="",DGSUB="CT"
S DGFAC=$P(^DIC(4,DUZ(2),0),U),DGDUZ=$P(^VA(200,DUZ,0),U,2)
S (DGLIN,DGLIN1)="",$P(DGLIN,"-",80)="",$P(DGLIN1,"=",80)=""
D HEAD
S (DGCT,DGCCT,DGCOT,DGERR,DGCTT,DGCCTT,DGCOTT,DGERRT,DGCTEX)=0
I '$D(^TMP("DGZOAS",$J,"CT")) W !!?30,"NO DISCHARGES RECORDED",!! G END
;
;***> loop thru ^utility by discharge date and print counts
S DGDT=0
A1 S DGDT=$O(^TMP("DGZOAS",$J,"CT",DGDT)) G TOTALS:DGDT=""
W !,$P($T(MON),";;",+$E(DGDT,4,5)+1)_" "_($E(DGDT,1,3)+1700)
W ?16,$J(^TMP("DGZOAS",$J,"CT",DGDT),4) S DGCTT=DGCTT+^(DGDT)
I $D(^TMP("DGZOAS",$J,"CT1",DGDT)) W ?29,$J(^(DGDT),4) S DGCCTT=DGCCTT+^(DGDT) ;coded count
I $D(^TMP("DGZOAS",$J,"CT2",DGDT)) W ?42,$J(^(DGDT),4) S DGCOTT=DGCOTT+^(DGDT) ;uncoded count
I $D(^TMP("DGZOAS",$J,"CT4",DGDT)) W ?55,$J(^(DGDT),4) S DGCTEX=DGCTEX+^(DGDT) ;exported count
I $D(^TMP("DGZOAS",$J,"CT3",DGDT)) W ?68,$J(^(DGDT),4) S DGERRT=DGERRT+^(DGDT) ;error count
I $Y>(IOSL-5) D NEWPG G END1:DGSTOP=U
G A1
;
TOTALS ;***> print totals
G LIST:$E(DGMON,4,5)=$E(DGMON2,4,5) ;no totals for one month
W !,DGLIN
W !?16,$J(DGCTT,4),?29,$J(DGCCTT,4),?42,$J(DGCOTT,4)
W ?55,$J(DGCTEX,4),?68,$J(DGERRT,4)
W !,DGLIN1,!
;
LIST ;***> list outstanding A Sheets
G ERR:'$D(^TMP("DGZOAS",$J,"ZOUT"))
S DGSUB="LST",DGDT=0 I $Y>(IOSL-6) D NEWPG G END1:DGSTOP=U G L1
W !!?20,"*** UNCODED CLINICAL RECORD BRIEFS ***",! D HEAD1
L1 S DGDT=$O(^TMP("DGZOAS",$J,"ZOUT",DGDT)) G ERR:DGDT="" S DFN=0
L2 S DFN=$O(^TMP("DGZOAS",$J,"ZOUT",DGDT,DFN)) G L1:DFN=""
;
S DGSRV=^TMP("DGZOAS",$J,"ZOUT",DGDT,DFN)
S DGCHT=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
W !,$E(DGDT,4,5)_"/"_$E(DGDT,6,7)_"/"_$E(DGDT,2,3)
W ?12,$E($P(^DPT(DFN,0),U),1,20)
W ?35,$J(DGCHT,6),?48,$E($P(^DIC(45.7,DGSRV,0),U),1,3)
W ?57,$$INS^ADGMREC(DFN)
I $Y>(IOSL-5) D NEWPG G END1:DGSTOP=U
G L2
;
ERR ;***> list any errors found
G END:'$D(^TMP("DGZOAS",$J,"ZERR"))
S DGDT=0,DGSUB="ERR"
W !!?33,"*** ERRORS ***",! D HEAD1
ERR1 S DGDT=$O(^TMP("DGZOAS",$J,"ZERR",DGDT)) G END:DGDT="" S DFN=0
ERR2 S DFN=$O(^TMP("DGZOAS",$J,"ZERR",DGDT,DFN)) G ERR1:DFN=""
W !,$E(DGDT,4,5)_"/"_$E(DGDT,6,7)_"/"_$E(DGDT,2,3)
W ?20,$E($P(^DPT(DFN,0),U),1,20)
W ?45,$J($P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),6)
I $Y>(IOSL-5) D NEWPG G END1:DGSTOP=U
G ERR2
;
;
END ;***> eoj
I IOST?1"C-".E D PRTOPT^ADGVAR
END1 W @IOF D ^%ZISC D KILL^ADGUTIL
K ^TMP("DGZOAS",$J) Q
;
;
MON ;;JAN;;FEB;;MAR;;APR;;MAY;;JUN;;JUL;;AUG;;SEP;;OCT;;NOV;;DEC
;
NEWPG ;***> subrtn for end of page control
I IOST'?1"C-".E D HEAD S DGSTOP="" Q
K DIR S DIR(0)="E" D ^DIR S DGSTOP=X
I DGSTOP'=U D HEAD
Q
;
HEAD ;***> subrtn to print heading
I (IOST["C-")!(DGPAGE>0) W @IOF
W !,DGLIN1 S DGPAGE=DGPAGE+1
W !?11,"*****Confidential Patient Data Covered by Privacy Act*****"
W !,DGDUZ,?80-$L(DGFAC)/2,DGFAC
S DGTY="CLINICAL RECORD BRIEF STATUS REPORT"
W ! D TIME^ADGUTIL W ?80-$L(DGTY)/2,DGTY,?70,"Page: ",DGPAGE
S Y=DT X ^DD("DD") W !,Y
W ?80-$L(DGRANGE)/2,DGRANGE
W !,DGLIN1
HEAD1 W:DGSUB="CT" !,"Month/Year",?15,"# Disch",?28,"# Coded",?38,"# Not-Coded",?52,"# Exported",?66,"# Errors"
W:DGSUB="LST" !,"Discharge",?45,"Discharge",?57,"Insurance",!?2,"Date",?17,"Patient",?35,"Chart #",?46,"Service",?59,"Type"
W:DGSUB="ERR" !,"Discharge",?20,"Patient",?45,"Chart #",?57,"Insurance",!?2,"Date",?59,"Type"
W !,DGLIN,!
Q
ADGOASP ; IHS/ADC/PDW/ENM - PRINT OUTSTANDING A SHEETS LIST ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 ;***> initialize variables
+4 SET DGPAGE=0
SET DGSTOP=""
SET DGSUB="CT"
+5 SET DGFAC=$PIECE(^DIC(4,DUZ(2),0),U)
SET DGDUZ=$PIECE(^VA(200,DUZ,0),U,2)
+6 SET (DGLIN,DGLIN1)=""
SET $PIECE(DGLIN,"-",80)=""
SET $PIECE(DGLIN1,"=",80)=""
+7 DO HEAD
+8 SET (DGCT,DGCCT,DGCOT,DGERR,DGCTT,DGCCTT,DGCOTT,DGERRT,DGCTEX)=0
+9 IF '$DATA(^TMP("DGZOAS",$JOB,"CT"))
WRITE !!?30,"NO DISCHARGES RECORDED",!!
GOTO END
+10 ;
+11 ;***> loop thru ^utility by discharge date and print counts
+12 SET DGDT=0
A1 SET DGDT=$ORDER(^TMP("DGZOAS",$JOB,"CT",DGDT))
IF DGDT=""
GOTO TOTALS
+1 WRITE !,$PIECE($TEXT(MON),";;",+$EXTRACT(DGDT,4,5)+1)_" "_($EXTRACT(DGDT,1,3)+1700)
+2 WRITE ?16,$JUSTIFY(^TMP("DGZOAS",$JOB,"CT",DGDT),4)
SET DGCTT=DGCTT+^(DGDT)
+3 ;coded count
IF $DATA(^TMP("DGZOAS",$JOB,"CT1",DGDT))
WRITE ?29,$JUSTIFY(^(DGDT),4)
SET DGCCTT=DGCCTT+^(DGDT)
+4 ;uncoded count
IF $DATA(^TMP("DGZOAS",$JOB,"CT2",DGDT))
WRITE ?42,$JUSTIFY(^(DGDT),4)
SET DGCOTT=DGCOTT+^(DGDT)
+5 ;exported count
IF $DATA(^TMP("DGZOAS",$JOB,"CT4",DGDT))
WRITE ?55,$JUSTIFY(^(DGDT),4)
SET DGCTEX=DGCTEX+^(DGDT)
+6 ;error count
IF $DATA(^TMP("DGZOAS",$JOB,"CT3",DGDT))
WRITE ?68,$JUSTIFY(^(DGDT),4)
SET DGERRT=DGERRT+^(DGDT)
+7 IF $Y>(IOSL-5)
DO NEWPG
IF DGSTOP=U
GOTO END1
+8 GOTO A1
+9 ;
TOTALS ;***> print totals
+1 ;no totals for one month
IF $EXTRACT(DGMON,4,5)=$EXTRACT(DGMON2,4,5)
GOTO LIST
+2 WRITE !,DGLIN
+3 WRITE !?16,$JUSTIFY(DGCTT,4),?29,$JUSTIFY(DGCCTT,4),?42,$JUSTIFY(DGCOTT,4)
+4 WRITE ?55,$JUSTIFY(DGCTEX,4),?68,$JUSTIFY(DGERRT,4)
+5 WRITE !,DGLIN1,!
+6 ;
LIST ;***> list outstanding A Sheets
+1 IF '$DATA(^TMP("DGZOAS",$JOB,"ZOUT"))
GOTO ERR
+2 SET DGSUB="LST"
SET DGDT=0
IF $Y>(IOSL-6)
DO NEWPG
IF DGSTOP=U
GOTO END1
GOTO L1
+3 WRITE !!?20,"*** UNCODED CLINICAL RECORD BRIEFS ***",!
DO HEAD1
L1 SET DGDT=$ORDER(^TMP("DGZOAS",$JOB,"ZOUT",DGDT))
IF DGDT=""
GOTO ERR
SET DFN=0
L2 SET DFN=$ORDER(^TMP("DGZOAS",$JOB,"ZOUT",DGDT,DFN))
IF DFN=""
GOTO L1
+1 ;
+2 SET DGSRV=^TMP("DGZOAS",$JOB,"ZOUT",DGDT,DFN)
+3 SET DGCHT=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
+4 WRITE !,$EXTRACT(DGDT,4,5)_"/"_$EXTRACT(DGDT,6,7)_"/"_$EXTRACT(DGDT,2,3)
+5 WRITE ?12,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20)
+6 WRITE ?35,$JUSTIFY(DGCHT,6),?48,$EXTRACT($PIECE(^DIC(45.7,DGSRV,0),U),1,3)
+7 WRITE ?57,$$INS^ADGMREC(DFN)
+8 IF $Y>(IOSL-5)
DO NEWPG
IF DGSTOP=U
GOTO END1
+9 GOTO L2
+10 ;
ERR ;***> list any errors found
+1 IF '$DATA(^TMP("DGZOAS",$JOB,"ZERR"))
GOTO END
+2 SET DGDT=0
SET DGSUB="ERR"
+3 WRITE !!?33,"*** ERRORS ***",!
DO HEAD1
ERR1 SET DGDT=$ORDER(^TMP("DGZOAS",$JOB,"ZERR",DGDT))
IF DGDT=""
GOTO END
SET DFN=0
ERR2 SET DFN=$ORDER(^TMP("DGZOAS",$JOB,"ZERR",DGDT,DFN))
IF DFN=""
GOTO ERR1
+1 WRITE !,$EXTRACT(DGDT,4,5)_"/"_$EXTRACT(DGDT,6,7)_"/"_$EXTRACT(DGDT,2,3)
+2 WRITE ?20,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20)
+3 WRITE ?45,$JUSTIFY($PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2),6)
+4 IF $Y>(IOSL-5)
DO NEWPG
IF DGSTOP=U
GOTO END1
+5 GOTO ERR2
+6 ;
+7 ;
END ;***> eoj
+1 IF IOST?1"C-".E
DO PRTOPT^ADGVAR
END1 WRITE @IOF
DO ^%ZISC
DO KILL^ADGUTIL
+1 KILL ^TMP("DGZOAS",$JOB)
QUIT
+2 ;
+3 ;
MON ;;JAN;;FEB;;MAR;;APR;;MAY;;JUN;;JUL;;AUG;;SEP;;OCT;;NOV;;DEC
+1 ;
NEWPG ;***> subrtn for end of page control
+1 IF IOST'?1"C-".E
DO HEAD
SET DGSTOP=""
QUIT
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
SET DGSTOP=X
+3 IF DGSTOP'=U
DO HEAD
+4 QUIT
+5 ;
HEAD ;***> subrtn to print heading
+1 IF (IOST["C-")!(DGPAGE>0)
WRITE @IOF
+2 WRITE !,DGLIN1
SET DGPAGE=DGPAGE+1
+3 WRITE !?11,"*****Confidential Patient Data Covered by Privacy Act*****"
+4 WRITE !,DGDUZ,?80-$LENGTH(DGFAC)/2,DGFAC
+5 SET DGTY="CLINICAL RECORD BRIEF STATUS REPORT"
+6 WRITE !
DO TIME^ADGUTIL
WRITE ?80-$LENGTH(DGTY)/2,DGTY,?70,"Page: ",DGPAGE
+7 SET Y=DT
XECUTE ^DD("DD")
WRITE !,Y
+8 WRITE ?80-$LENGTH(DGRANGE)/2,DGRANGE
+9 WRITE !,DGLIN1
HEAD1 IF DGSUB="CT"
WRITE !,"Month/Year",?15,"# Disch",?28,"# Coded",?38,"# Not-Coded",?52,"# Exported",?66,"# Errors"
+1 IF DGSUB="LST"
WRITE !,"Discharge",?45,"Discharge",?57,"Insurance",!?2,"Date",?17,"Patient",?35,"Chart #",?46,"Service",?59,"Type"
+2 IF DGSUB="ERR"
WRITE !,"Discharge",?20,"Patient",?45,"Chart #",?57,"Insurance",!?2,"Date",?59,"Type"
+3 WRITE !,DGLIN,!
+4 QUIT
