ADGADSP5 ; IHS/ADC/PDW/ENM - A & D SHEET PRINT (SUMMARY) ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
;***> Summary format of ADMISSIONS & DISCHARGES SHEET (cont.)
;
A1 G B1:'$D(^TMP("DGZADS",$J,"TS"))
W !! I $Y>(IOSL-5) D NEWPG^ADGADSP3 G END1:DGSTOP=U
W ?6,"SERVICE TRANSFERS IN",?47,"SERVICE TRANSFERS OUT",!
W DGLIN,?42,DGLIN,!
;
;***> loop thru service transfers
S DGNM=0
A2 S DGNM=$O(^TMP("DGZADS",$J,"TS",DGNM)) G B1:DGNM="" S DFN=0
A3 S DFN=$O(^TMP("DGZADS",$J,"TS",DGNM,DFN)) G A2:DFN="" S DGTST=0
A4 S DGTST=$O(^TMP("DGZADS",$J,"TS",DGNM,DFN,DGTST)) G A3:DGTST=""
S DGSTR=^TMP("DGZADS",$J,"TS",DGNM,DFN,DGTST)
S DGX=$P(DGSTR,U) I DGX'="" S DGX=$P($G(^DIC(45.7,DGX,0)),U) ;old srv
S DGX1=$P(DGSTR,U,2) I DGX1'="" S DGX1=$P($G(^DIC(45.7,DGX1,0)),U) ;new
S DGCHT=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2) ;chart #
S DGCHT="00000"_DGCHT,DGCHT=$E(DGCHT,$L(DGCHT)-5,$L(DGCHT))
S DGCHT=$E(DGCHT,1,2)_"-"_$E(DGCHT,3,4)_"-"_$E(DGCHT,5,6)
W !,$E(DGX1,1,3),?5,DGCHT," ",$E(DGNM,1,20),?42,$E(DGX,1,3)
W ?47,DGCHT," ",$E(DGNM,1,20)
I $Y>(IOSL-5) D NEWPG^ADGADSP3 G END1:DGSTOP=U
G A4
;
B1 W !! I $Y>(IOSL-5) D NEWPG^ADGADSP3 G END1:DGSTOP=U
W:$D(^TMP("DGZADS",$J,"AB1")) ?6,"RETURN FROM LEAVE"
W:$D(^TMP("DGZADS",$J,"AB")) ?47,"ABSENT ON LEAVE"
W ! I $D(^TMP("DGZADS",$J,"AB1")) W DGLIN
I $D(^TMP("DGZADS",$J,"AB")) W ?42,DGLIN
;
;***> loop thru absences
W ! S (DGNM,DGI)=0
B2 S DGNM=$O(^TMP("DGZADS",$J,"AB1",DGNM)) G C1:DGNM="" S DFN=0
B3 S DFN=$O(^TMP("DGZADS",$J,"AB1",DGNM,DFN)) G B2:DFN="" S DGTRN=0
B4 S DGTRN=$O(^TMP("DGZADS",$J,"AB1",DGNM,DFN,DGTRN)) G B3:DGTRN=""
S DGSTR=^TMP("DGZADS",$J,"AB1",DGNM,DFN,DGTRN) D LINE1^ADGADSP4 G B4
;
C1 S (DGNM,DGI)=0
C2 S DGNM=$O(^TMP("DGZADS",$J,"AB",DGNM)) G C5:DGNM="" S DFN=0
C3 S DFN=$O(^TMP("DGZADS",$J,"AB",DGNM,DFN)) G C2:DFN="" S DGTRN=0
C4 S DGTRN=$O(^TMP("DGZADS",$J,"AB",DGNM,DFN,DGTRN)) G C3:DGTRN=""
S DGSTR=^TMP("DGZADS",$J,"AB",DGNM,DFN,DGTRN) D LINE2^ADGADSP4 G C4
;
C5 F DGI=1:1 Q:'$D(DGL(DGI)) D Q:DGSTOP=U
.W !,DGL(DGI),?42,DGL(DGI,0) I $Y>(IOSL-5) D NEWPG^ADGADSP3
G END1:DGSTOP=U
K DGL,DGI
;
D1 G NEXT:'$D(^TMP("DGZADS",$J,"DT"))
W !! I $Y>(IOSL-5) D NEWPG^ADGADSP3 G END1:DGSTOP=U
W ?52,"DEATHS",!?42,DGLIN,!
;
;***> loop thru deaths
S (DGNM,DGI)=0
D2 S DGNM=$O(^TMP("DGZADS",$J,"DT",DGNM)) G D5:DGNM="" S DGCHT=0
D3 S DGCHT=$O(^TMP("DGZADS",$J,"DT",DGNM,DGCHT)) G D2:DGCHT="" S DGM=0
D4 S DGM=$O(^TMP("DGZADS",$J,"DT",DGNM,DGCHT,DGM)) G D3:DGM=""
S DGSTR=^TMP("DGZADS",$J,"DT",DGNM,DGCHT,DGM) D LINE2^ADGADSP4 G D4
;
D5 F DGI=1:1 Q:'$D(DGL(DGI,0)) D Q:DGSTOP=U
.W !?42,DGL(DGI,0)
.I $Y>(IOSL-5) D NEWPG^ADGADSP3
G END1:DGSTOP=U
K DGL,DGI
;
NEXT D ^ADGADSP6 ;day surgery print
END I IOST["C-" K DIR S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR
END1 ;EP;***> ending point for summary A&D Sheets
W @IOF D KILL^ADGUTIL
D ^%ZISC K ^TMP("DGZADS",$J)
Q
;
ADGADSP5 ; IHS/ADC/PDW/ENM - A & D SHEET PRINT (SUMMARY) ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 ;***> Summary format of ADMISSIONS & DISCHARGES SHEET (cont.)
+4 ;
A1 IF '$DATA(^TMP("DGZADS",$JOB,"TS"))
GOTO B1
+1 WRITE !!
IF $Y>(IOSL-5)
DO NEWPG^ADGADSP3
IF DGSTOP=U
GOTO END1
+2 WRITE ?6,"SERVICE TRANSFERS IN",?47,"SERVICE TRANSFERS OUT",!
+3 WRITE DGLIN,?42,DGLIN,!
+4 ;
+5 ;***> loop thru service transfers
+6 SET DGNM=0
A2 SET DGNM=$ORDER(^TMP("DGZADS",$JOB,"TS",DGNM))
IF DGNM=""
GOTO B1
SET DFN=0
A3 SET DFN=$ORDER(^TMP("DGZADS",$JOB,"TS",DGNM,DFN))
IF DFN=""
GOTO A2
SET DGTST=0
A4 SET DGTST=$ORDER(^TMP("DGZADS",$JOB,"TS",DGNM,DFN,DGTST))
IF DGTST=""
GOTO A3
+1 SET DGSTR=^TMP("DGZADS",$JOB,"TS",DGNM,DFN,DGTST)
+2 ;old srv
SET DGX=$PIECE(DGSTR,U)
IF DGX'=""
SET DGX=$PIECE($GET(^DIC(45.7,DGX,0)),U)
+3 ;new
SET DGX1=$PIECE(DGSTR,U,2)
IF DGX1'=""
SET DGX1=$PIECE($GET(^DIC(45.7,DGX1,0)),U)
+4 ;chart #
SET DGCHT=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
+5 SET DGCHT="00000"_DGCHT
SET DGCHT=$EXTRACT(DGCHT,$LENGTH(DGCHT)-5,$LENGTH(DGCHT))
+6 SET DGCHT=$EXTRACT(DGCHT,1,2)_"-"_$EXTRACT(DGCHT,3,4)_"-"_$EXTRACT(DGCHT,5,6)
+7 WRITE !,$EXTRACT(DGX1,1,3),?5,DGCHT," ",$EXTRACT(DGNM,1,20),?42,$EXTRACT(DGX,1,3)
+8 WRITE ?47,DGCHT," ",$EXTRACT(DGNM,1,20)
+9 IF $Y>(IOSL-5)
DO NEWPG^ADGADSP3
IF DGSTOP=U
GOTO END1
+10 GOTO A4
+11 ;
B1 WRITE !!
IF $Y>(IOSL-5)
DO NEWPG^ADGADSP3
IF DGSTOP=U
GOTO END1
+1 IF $DATA(^TMP("DGZADS",$JOB,"AB1"))
WRITE ?6,"RETURN FROM LEAVE"
+2 IF $DATA(^TMP("DGZADS",$JOB,"AB"))
WRITE ?47,"ABSENT ON LEAVE"
+3 WRITE !
IF $DATA(^TMP("DGZADS",$JOB,"AB1"))
WRITE DGLIN
+4 IF $DATA(^TMP("DGZADS",$JOB,"AB"))
WRITE ?42,DGLIN
+5 ;
+6 ;***> loop thru absences
+7 WRITE !
SET (DGNM,DGI)=0
B2 SET DGNM=$ORDER(^TMP("DGZADS",$JOB,"AB1",DGNM))
IF DGNM=""
GOTO C1
SET DFN=0
B3 SET DFN=$ORDER(^TMP("DGZADS",$JOB,"AB1",DGNM,DFN))
IF DFN=""
GOTO B2
SET DGTRN=0
B4 SET DGTRN=$ORDER(^TMP("DGZADS",$JOB,"AB1",DGNM,DFN,DGTRN))
IF DGTRN=""
GOTO B3
+1 SET DGSTR=^TMP("DGZADS",$JOB,"AB1",DGNM,DFN,DGTRN)
DO LINE1^ADGADSP4
GOTO B4
+2 ;
C1 SET (DGNM,DGI)=0
C2 SET DGNM=$ORDER(^TMP("DGZADS",$JOB,"AB",DGNM))
IF DGNM=""
GOTO C5
SET DFN=0
C3 SET DFN=$ORDER(^TMP("DGZADS",$JOB,"AB",DGNM,DFN))
IF DFN=""
GOTO C2
SET DGTRN=0
C4 SET DGTRN=$ORDER(^TMP("DGZADS",$JOB,"AB",DGNM,DFN,DGTRN))
IF DGTRN=""
GOTO C3
+1 SET DGSTR=^TMP("DGZADS",$JOB,"AB",DGNM,DFN,DGTRN)
DO LINE2^ADGADSP4
GOTO C4
+2 ;
C5 FOR DGI=1:1
IF '$DATA(DGL(DGI))
QUIT
Begin DoDot:1
+1 WRITE !,DGL(DGI),?42,DGL(DGI,0)
IF $Y>(IOSL-5)
DO NEWPG^ADGADSP3
End DoDot:1
IF DGSTOP=U
QUIT
+2 IF DGSTOP=U
GOTO END1
+3 KILL DGL,DGI
+4 ;
D1 IF '$DATA(^TMP("DGZADS",$JOB,"DT"))
GOTO NEXT
+1 WRITE !!
IF $Y>(IOSL-5)
DO NEWPG^ADGADSP3
IF DGSTOP=U
GOTO END1
+2 WRITE ?52,"DEATHS",!?42,DGLIN,!
+3 ;
+4 ;***> loop thru deaths
+5 SET (DGNM,DGI)=0
D2 SET DGNM=$ORDER(^TMP("DGZADS",$JOB,"DT",DGNM))
IF DGNM=""
GOTO D5
SET DGCHT=0
D3 SET DGCHT=$ORDER(^TMP("DGZADS",$JOB,"DT",DGNM,DGCHT))
IF DGCHT=""
GOTO D2
SET DGM=0
D4 SET DGM=$ORDER(^TMP("DGZADS",$JOB,"DT",DGNM,DGCHT,DGM))
IF DGM=""
GOTO D3
+1 SET DGSTR=^TMP("DGZADS",$JOB,"DT",DGNM,DGCHT,DGM)
DO LINE2^ADGADSP4
GOTO D4
+2 ;
D5 FOR DGI=1:1
IF '$DATA(DGL(DGI,0))
QUIT
Begin DoDot:1
+1 WRITE !?42,DGL(DGI,0)
+2 IF $Y>(IOSL-5)
DO NEWPG^ADGADSP3
End DoDot:1
IF DGSTOP=U
QUIT
+3 IF DGSTOP=U
GOTO END1
+4 KILL DGL,DGI
+5 ;
NEXT ;day surgery print
DO ^ADGADSP6
END IF IOST["C-"
KILL DIR
SET DIR("A")="Press RETURN to continue"
SET DIR(0)="E"
DO ^DIR
END1 ;EP;***> ending point for summary A&D Sheets
+1 WRITE @IOF
DO KILL^ADGUTIL
+2 DO ^%ZISC
KILL ^TMP("DGZADS",$JOB)
+3 QUIT
+4 ;
