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
