ADGCRBL2 ; IHS/ADC/PDW/ENM - PRINT CODED A SHEET LIST ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
;***> initialize variables
S (DGZTOT,DGZETOT)=0 ;patient and a sheet counts
S DGPAGE=0,DGSTOP="" ;page # & U flag
S DGDUZ=$P(^VA(200,DUZ,0),U,2) ;user's initials
S DGFAC=$P(^DIC(4,DUZ(2),0),U) ;facility name
S DGLIN="",$P(DGLIN,"=",80)="" ;line variable
;
DSCH ;***> sort by discharge dates and print info
S DGZDDT=0 D HEAD
DS1 S DGZDDT=$O(^TMP("DGZCRBL",$J,DGZDDT)) G TOTAL:DGZDDT=""
S DGZNAME=0
I $Y>(IOSL-5) D NEWPG I DGSTOP=U G END
W !?25,"DISCHARGED ON: ",$$FMTE^XLFDT(DGZDDT,"2D"),! ;print dsch date
;
DS2 S DGZNAME=$O(^TMP("DGZCRBL",$J,DGZDDT,DGZNAME))
I DGZNAME="" W ! G DS1
S DFN=0
DS3 S DFN=$O(^TMP("DGZCRBL",$J,DGZDDT,DGZNAME,DFN)) G DS2:DFN=""
S DGZIDFN=0
DS4 S DGZIDFN=$O(^TMP("DGZCRBL",$J,DGZDDT,DGZNAME,DFN,DGZIDFN))
G DS3:DGZIDFN=""
;
S DGSTR=^TMP("DGZCRBL",$J,DGZDDT,DGZNAME,DFN,DGZIDFN)
S DGZVDFN=+DGSTR,DGZVDT=$P(DGSTR,U,2),DGZTOT=DGZTOT+1
S DGCHT=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
W !,$E(DGZNAME,1,20),?25,$J(DGCHT,6) ;print name & chart #
W ?35,$$FMTE^XLFDT(DGZVDT,"2D") ;admit date
S Y=$P(^AUPNVSIT(DGZVDFN,0),U,13) W ?49,$$FMTE^XLFDT(Y,"2D") ;dt mod
S Y=$P(^AUPNVSIT(DGZVDFN,0),U,14) I Y]"" S DGZETOT=DGZETOT+1
W ?62,$$FMTE^XLFDT(Y,"2D") ;dt exp
I $Y>(IOSL-5) D NEWPG I DGSTOP=U G END1
G DS4
;
TOTAL ;***> print totals
W !!?10,"Total Coded A Sheets: ",DGZTOT
W !?16,"Total Exported: ",DGZETOT,!
;
END ;***> eoj
K DIR
I IOST["C-" S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
END1 W @IOF D KILL^ADGUTIL
K ^TMP("DGZCRBL",$J) D ^%ZISC Q
;
NEWPG ;***> subrtn for end of page control
I IOST'?1"C-".E D HEAD S DGSTOP="" Q
I DGPAGE>0 K DIR S DIR(0)="E" D ^DIR S DGSTOP=X
I DGSTOP'=U D HEAD
Q
;
HEAD ;***> print heading
I (IOST["C-")!(DGPAGE>0) W @IOF
S DGPAGE=DGPAGE+1
W ?11,"*****Confidential Patient Data Covered by Privacy Act*****"
W !,DGDUZ,?(80-$L(DGFAC)/2),DGFAC,?70,"Page ",DGPAGE
W ! D TIME^ADGUTIL W ?33,"CODED A SHEETS" S Y=DT X ^DD("DD") W !,Y
W ?28,"for ",$E(DGZBDT,4,5)_"/"_$E(DGZBDT,6,7)_"/"_$E(DGZBDT,2,3)
W " to ",$E(DGZEDT,4,5)_"/"_$E(DGZEDT,6,7)_"/"_$E(DGZEDT,2,3)
W !!,"PATIENT NAME",?25,"CHART #",?35,"ADMIT DATE"
W ?49,"LAST MOD",?62,"EXPORTED ON",!,DGLIN,!
Q
ADGCRBL2 ; IHS/ADC/PDW/ENM - PRINT CODED A SHEET LIST ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 ;***> initialize variables
+4 ;patient and a sheet counts
SET (DGZTOT,DGZETOT)=0
+5 ;page # & U flag
SET DGPAGE=0
SET DGSTOP=""
+6 ;user's initials
SET DGDUZ=$PIECE(^VA(200,DUZ,0),U,2)
+7 ;facility name
SET DGFAC=$PIECE(^DIC(4,DUZ(2),0),U)
+8 ;line variable
SET DGLIN=""
SET $PIECE(DGLIN,"=",80)=""
+9 ;
DSCH ;***> sort by discharge dates and print info
+1 SET DGZDDT=0
DO HEAD
DS1 SET DGZDDT=$ORDER(^TMP("DGZCRBL",$JOB,DGZDDT))
IF DGZDDT=""
GOTO TOTAL
+1 SET DGZNAME=0
+2 IF $Y>(IOSL-5)
DO NEWPG
IF DGSTOP=U
GOTO END
+3 ;print dsch date
WRITE !?25,"DISCHARGED ON: ",$$FMTE^XLFDT(DGZDDT,"2D"),!
+4 ;
DS2 SET DGZNAME=$ORDER(^TMP("DGZCRBL",$JOB,DGZDDT,DGZNAME))
+1 IF DGZNAME=""
WRITE !
GOTO DS1
+2 SET DFN=0
DS3 SET DFN=$ORDER(^TMP("DGZCRBL",$JOB,DGZDDT,DGZNAME,DFN))
IF DFN=""
GOTO DS2
+1 SET DGZIDFN=0
DS4 SET DGZIDFN=$ORDER(^TMP("DGZCRBL",$JOB,DGZDDT,DGZNAME,DFN,DGZIDFN))
+1 IF DGZIDFN=""
GOTO DS3
+2 ;
+3 SET DGSTR=^TMP("DGZCRBL",$JOB,DGZDDT,DGZNAME,DFN,DGZIDFN)
+4 SET DGZVDFN=+DGSTR
SET DGZVDT=$PIECE(DGSTR,U,2)
SET DGZTOT=DGZTOT+1
+5 SET DGCHT=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+6 ;print name & chart #
WRITE !,$EXTRACT(DGZNAME,1,20),?25,$JUSTIFY(DGCHT,6)
+7 ;admit date
WRITE ?35,$$FMTE^XLFDT(DGZVDT,"2D")
+8 ;dt mod
SET Y=$PIECE(^AUPNVSIT(DGZVDFN,0),U,13)
WRITE ?49,$$FMTE^XLFDT(Y,"2D")
+9 SET Y=$PIECE(^AUPNVSIT(DGZVDFN,0),U,14)
IF Y]""
SET DGZETOT=DGZETOT+1
+10 ;dt exp
WRITE ?62,$$FMTE^XLFDT(Y,"2D")
+11 IF $Y>(IOSL-5)
DO NEWPG
IF DGSTOP=U
GOTO END1
+12 GOTO DS4
+13 ;
TOTAL ;***> print totals
+1 WRITE !!?10,"Total Coded A Sheets: ",DGZTOT
+2 WRITE !?16,"Total Exported: ",DGZETOT,!
+3 ;
END ;***> eoj
+1 KILL DIR
+2 IF IOST["C-"
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
END1 WRITE @IOF
DO KILL^ADGUTIL
+1 KILL ^TMP("DGZCRBL",$JOB)
DO ^%ZISC
QUIT
+2 ;
NEWPG ;***> subrtn for end of page control
+1 IF IOST'?1"C-".E
DO HEAD
SET DGSTOP=""
QUIT
+2 IF DGPAGE>0
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET DGSTOP=X
+3 IF DGSTOP'=U
DO HEAD
+4 QUIT
+5 ;
HEAD ;***> print heading
+1 IF (IOST["C-")!(DGPAGE>0)
WRITE @IOF
+2 SET DGPAGE=DGPAGE+1
+3 WRITE ?11,"*****Confidential Patient Data Covered by Privacy Act*****"
+4 WRITE !,DGDUZ,?(80-$LENGTH(DGFAC)/2),DGFAC,?70,"Page ",DGPAGE
+5 WRITE !
DO TIME^ADGUTIL
WRITE ?33,"CODED A SHEETS"
SET Y=DT
XECUTE ^DD("DD")
WRITE !,Y
+6 WRITE ?28,"for ",$EXTRACT(DGZBDT,4,5)_"/"_$EXTRACT(DGZBDT,6,7)_"/"_$EXTRACT(DGZBDT,2,3)
+7 WRITE " to ",$EXTRACT(DGZEDT,4,5)_"/"_$EXTRACT(DGZEDT,6,7)_"/"_$EXTRACT(DGZEDT,2,3)
+8 WRITE !!,"PATIENT NAME",?25,"CHART #",?35,"ADMIT DATE"
+9 WRITE ?49,"LAST MOD",?62,"EXPORTED ON",!,DGLIN,!
+10 QUIT
