- ADGDODP ; IHS/ADC/PDW/ENM - INPATIENT DEATHS LISTING (PRINT) ; [ 09/22/2000 11:14 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;**5**;MAR 25, 1999
- ;
- ;***> initialize variables
- S DGPAGE=0,DGSTOP="",DGDUZ=$P(^VA(200,DUZ,0),U,2)
- S DGSITE=$P(^DIC(4,DUZ(2),0),U) ;set site
- S DGLIN="",$P(DGLIN,"=",80)=""
- S DGLIN2="",$P(DGLIN2,"-",80)=""
- ;
- G DATE:DGTYP=1,SERV:DGTYP=2,NAME:DGTYP=3 ;what sort order?
- ;
- DATE ;***> discharge date order
- S DGDT=0 D HEAD
- DT1 S DGDT=$O(^TMP("DGZDOD",$J,DGDT)) G END:DGDT="" S DGNM=0
- DT2 S DGNM=$O(^TMP("DGZDOD",$J,DGDT,DGNM)) G DT1:DGNM="" S DFN=0
- DT3 S DFN=$O(^TMP("DGZDOD",$J,DGDT,DGNM,DFN)) G DT2:DFN=""
- S DGS=^TMP("DGZDOD",$J,DGDT,DGNM,DFN),DGT=$P(DGS,U),DGSV=$P(DGS,U,2)
- D LIN G END1:DGSTOP=U G DT3
- ;
- SERV ;***> discharge service order
- S DGSV=0 D HEAD
- SV1 S DGSV=$O(^TMP("DGZDOD",$J,DGSV)) G END:DGSV="" S DGDT=0
- SV2 S DGDT=$O(^TMP("DGZDOD",$J,DGSV,DGDT)) G SV1:DGDT="" S DGNM=0
- SV3 S DGNM=$O(^TMP("DGZDOD",$J,DGSV,DGDT,DGNM)) G SV2:DGNM="" S DFN=0
- SV4 S DFN=$O(^TMP("DGZDOD",$J,DGSV,DGDT,DGNM,DFN)) G SV3:DFN=""
- ;IHS/ASDST/ENM 09/22/00 NEXT LINE COPIED/MOD
- ;S DGT=^TMP("DGZDOD",$J,DGSV,DGDT,DGNM,DFN) D LIN G END1:DGSTOP=U G SV4
- S DGT=+^TMP("DGZDOD",$J,DGSV,DGDT,DGNM,DFN) D LIN G END1:DGSTOP=U G SV4
- ;
- NAME ;***> alpha order by patient name
- S DGNM=0 D HEAD
- NM1 S DGNM=$O(^TMP("DGZDOD",$J,DGNM)) G END:DGNM="" S DFN=0
- NM2 S DFN=$O(^TMP("DGZDOD",$J,DGNM,DFN)) G NM1:DFN="" S DGDT=0
- NM3 S DGDT=$O(^TMP("DGZDOD",$J,DGNM,DFN,DGDT)) G NM2:DGDT=""
- S DGS=^TMP("DGZDOD",$J,DGNM,DFN,DGDT),DGT=$P(DGS,U),DGSV=$P(DGS,U,2)
- D LIN G END1:DGSTOP=U G NM3
- ;
- ;
- END ;***> eoj
- I IOST["C-" K DIR S DIR(0)="E" D ^DIR
- END1 W @IOF D KILL^ADGUTIL
- D ^%ZISC K ^TMP("DGZDOD") Q
- ;
- ;
- LIN ;***> subrtn to print patient data
- W !,$E(DGNM,1,20) S DGX=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2) ;name
- W ?23,$J(DGX,6),?33,$E(DGSV,1,3) ;chart # and service
- W ?40,$E(DGDT,4,5)_"/"_$E(DGDT,6,7)_"/"_$E(DGDT,2,3) ;date of death
- W ?52,$E($P(^DIC(42.2,DGT,0),U),1,25) ;discharge type
- I $Y>(IOSL-6) D NEWPG
- Q
- ;
- 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 !,DGLIN S DGPAGE=DGPAGE+1
- W !?11,"*****Confidential Patient Data Covered by Privacy Act*****"
- W !,DGDUZ,?80-$L(DGSITE)/2,DGSITE S DGTY="INPATIENT DEATHS"
- W ! D TIME^ADGUTIL W ?80-$L(DGTY)/2,DGTY,?70,"Page: ",DGPAGE
- S Y=DT X ^DD("DD") W !,Y
- S DGX="SORTED BY "_$S(DGTYP=1:"DATE",DGTYP=2:"SERVICE",1:"PATIENT NAME") W ?80-$L(DGX)/2,DGX
- W !,DGLIN,!,"Patient Name",?24,"Chart #",?33,"SRV"
- W ?38,"Date of Death",?55,"Discharge Type"
- W !,DGLIN2,!
- Q
- ADGDODP ; IHS/ADC/PDW/ENM - INPATIENT DEATHS LISTING (PRINT) ; [ 09/22/2000 11:14 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;**5**;MAR 25, 1999
- +2 ;
- +3 ;***> initialize variables
- +4 SET DGPAGE=0
- SET DGSTOP=""
- SET DGDUZ=$PIECE(^VA(200,DUZ,0),U,2)
- +5 ;set site
- SET DGSITE=$PIECE(^DIC(4,DUZ(2),0),U)
- +6 SET DGLIN=""
- SET $PIECE(DGLIN,"=",80)=""
- +7 SET DGLIN2=""
- SET $PIECE(DGLIN2,"-",80)=""
- +8 ;
- +9 ;what sort order?
- IF DGTYP=1
- GOTO DATE
- IF DGTYP=2
- GOTO SERV
- IF DGTYP=3
- GOTO NAME
- +10 ;
- DATE ;***> discharge date order
- +1 SET DGDT=0
- DO HEAD
- DT1 SET DGDT=$ORDER(^TMP("DGZDOD",$JOB,DGDT))
- IF DGDT=""
- GOTO END
- SET DGNM=0
- DT2 SET DGNM=$ORDER(^TMP("DGZDOD",$JOB,DGDT,DGNM))
- IF DGNM=""
- GOTO DT1
- SET DFN=0
- DT3 SET DFN=$ORDER(^TMP("DGZDOD",$JOB,DGDT,DGNM,DFN))
- IF DFN=""
- GOTO DT2
- +1 SET DGS=^TMP("DGZDOD",$JOB,DGDT,DGNM,DFN)
- SET DGT=$PIECE(DGS,U)
- SET DGSV=$PIECE(DGS,U,2)
- +2 DO LIN
- IF DGSTOP=U
- GOTO END1
- GOTO DT3
- +3 ;
- SERV ;***> discharge service order
- +1 SET DGSV=0
- DO HEAD
- SV1 SET DGSV=$ORDER(^TMP("DGZDOD",$JOB,DGSV))
- IF DGSV=""
- GOTO END
- SET DGDT=0
- SV2 SET DGDT=$ORDER(^TMP("DGZDOD",$JOB,DGSV,DGDT))
- IF DGDT=""
- GOTO SV1
- SET DGNM=0
- SV3 SET DGNM=$ORDER(^TMP("DGZDOD",$JOB,DGSV,DGDT,DGNM))
- IF DGNM=""
- GOTO SV2
- SET DFN=0
- SV4 SET DFN=$ORDER(^TMP("DGZDOD",$JOB,DGSV,DGDT,DGNM,DFN))
- IF DFN=""
- GOTO SV3
- +1 ;IHS/ASDST/ENM 09/22/00 NEXT LINE COPIED/MOD
- +2 ;S DGT=^TMP("DGZDOD",$J,DGSV,DGDT,DGNM,DFN) D LIN G END1:DGSTOP=U G SV4
- +3 SET DGT=+^TMP("DGZDOD",$JOB,DGSV,DGDT,DGNM,DFN)
- DO LIN
- IF DGSTOP=U
- GOTO END1
- GOTO SV4
- +4 ;
- NAME ;***> alpha order by patient name
- +1 SET DGNM=0
- DO HEAD
- NM1 SET DGNM=$ORDER(^TMP("DGZDOD",$JOB,DGNM))
- IF DGNM=""
- GOTO END
- SET DFN=0
- NM2 SET DFN=$ORDER(^TMP("DGZDOD",$JOB,DGNM,DFN))
- IF DFN=""
- GOTO NM1
- SET DGDT=0
- NM3 SET DGDT=$ORDER(^TMP("DGZDOD",$JOB,DGNM,DFN,DGDT))
- IF DGDT=""
- GOTO NM2
- +1 SET DGS=^TMP("DGZDOD",$JOB,DGNM,DFN,DGDT)
- SET DGT=$PIECE(DGS,U)
- SET DGSV=$PIECE(DGS,U,2)
- +2 DO LIN
- IF DGSTOP=U
- GOTO END1
- GOTO NM3
- +3 ;
- +4 ;
- END ;***> eoj
- +1 IF IOST["C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- END1 WRITE @IOF
- DO KILL^ADGUTIL
- +1 DO ^%ZISC
- KILL ^TMP("DGZDOD")
- QUIT
- +2 ;
- +3 ;
- LIN ;***> subrtn to print patient data
- +1 ;name
- WRITE !,$EXTRACT(DGNM,1,20)
- SET DGX=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
- +2 ;chart # and service
- WRITE ?23,$JUSTIFY(DGX,6),?33,$EXTRACT(DGSV,1,3)
- +3 ;date of death
- WRITE ?40,$EXTRACT(DGDT,4,5)_"/"_$EXTRACT(DGDT,6,7)_"/"_$EXTRACT(DGDT,2,3)
- +4 ;discharge type
- WRITE ?52,$EXTRACT($PIECE(^DIC(42.2,DGT,0),U),1,25)
- +5 IF $Y>(IOSL-6)
- DO NEWPG
- +6 QUIT
- +7 ;
- 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 !,DGLIN
- SET DGPAGE=DGPAGE+1
- +3 WRITE !?11,"*****Confidential Patient Data Covered by Privacy Act*****"
- +4 WRITE !,DGDUZ,?80-$LENGTH(DGSITE)/2,DGSITE
- SET DGTY="INPATIENT DEATHS"
- +5 WRITE !
- DO TIME^ADGUTIL
- WRITE ?80-$LENGTH(DGTY)/2,DGTY,?70,"Page: ",DGPAGE
- +6 SET Y=DT
- XECUTE ^DD("DD")
- WRITE !,Y
- +7 SET DGX="SORTED BY "_$SELECT(DGTYP=1:"DATE",DGTYP=2:"SERVICE",1:"PATIENT NAME")
- WRITE ?80-$LENGTH(DGX)/2,DGX
- +8 WRITE !,DGLIN,!,"Patient Name",?24,"Chart #",?33,"SRV"
- +9 WRITE ?38,"Date of Death",?55,"Discharge Type"
- +10 WRITE !,DGLIN2,!
- +11 QUIT
