- 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
