ADGDEM ; IHS/ADC/PDW/ENM - DAY SURGERY PATIENT INQUIRY ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
;***> IHS additions to DGDEM (Patient Inquiry)
;***> last day surgery
G B1:'$D(^ADGDS(DFN)) ;skip if no day surgery for patient
S (DGZDT,DGZZ)=0 ;find last day surgery
A1 S DGZDT=$O(^ADGDS(DFN,"DS","AA",DGZDT)) G A2:DGZDT=""
S DGZZ=DGZDT G A1
;
A2 G B1:DGZZ=0 ;skip if none found
S DGA=$O(^ADGDS(DFN,"DS","AA",DGZZ,0)) G B1:DGA=""
G B1:'$D(^ADGDS(DFN,"DS",DGA,0))#2 S DGSTR=^(0),DGX=$P(DGSTR,U)
;print data on last day surgery
W !!,"DAY SURGERY Date/Time: "
W $E(DGX,4,5)_"/"_$E(DGX,6,7)_"/"_$E(DGX,2,3)
W:DGX["." " at ",$E($P(DGX,".",2)_"000",1,4)
S DGX=$P(DGSTR,U,3) W:DGX'="" ?47,"Ward: ",$P(^DIC(42,DGX,0),U)
W:$P($G(^ADGDS(DFN,"DS",DGA,2)),U,3)="Y" ?47,"(SURGERY CANCELLED)"
W:$P($G(^ADGDS(DFN,"DS",DGA,2)),U,4)="Y" ?47,"(NO-SHOW)"
W:$P(DGSTR,U,4)'="" ?58,"Room-Bed: ",$P(DGSTR,U,4)
S DGSRV=$P(DGSTR,U,5),DGPRV=$P(DGSTR,U,6)
S:DGSRV'="" DGSRV=$P($G(^DIC(45.7,DGSRV,0)),U)
S:DGPRV'="" DGPRV=$P($G(^VA(200,DGPRV,0)),U)
W !?35,"Srvc: ",$E(DGSRV,1,3),?47,"Prov: ",$E(DGPRV,1,15)
G B1:'$D(^ADGDS(DFN,"DS",DGA,2)),B1:$P(^(2),U)="" S DGX=$P(^(2),U)
W:DGX'="" !?13,"Released: ",$E(DGX,4,5)_"/"_$E(DGX,6,7)_"/"_$E(DGX,2,3)
W:DGX["." " at ",$E($P(DGX,".",2)_"000",1,4)
W ?47,"LOS: ",$$VAL^XBDIQ1(9009012.01,"DFN,DGA",8)," hrs"
;
;***> any scheduled visits on file?
B1 G END:'$D(^ADGAUTH(DFN,0)),END:'$D(^ADGAUTH(DFN,1,0)) S DG1=0
B10 S DG1=$O(^ADGAUTH(DFN,1,DG1)) G END:DG1=""
S DGSTR=^ADGAUTH(DFN,1,DG1,0),DGX=$P(DGSTR,U)
S DGX1=$P(DGSTR,U,5) G B3:DGX1="D" ;go to B3 if scheduled for day sur
G B5:DGX1="Q" ;go to B5 if scheduled for outpatient visit w/quarters
G B10:DGX1'="I" ;otherwise if not a scheduled admit, go to end
;
W !!?10,"Scheduled Admit for "
W $E(DGX,4,5)_"/"_$E(DGX,6,7)_"/"_$E(DGX,2,3)
W:$P(DGSTR,U,7)'="" ?43,"Ward: ",$E($P(^DIC(42,$P(DGSTR,U,7),0),U),1,3)
W:$P(DGSTR,U,3)'="" ?55,"Service: ",$P(^DIC(45.7,$P(DGSTR,U,3),0),U,3)
G B10
;
B3 W !!?10,"Scheduled for Day Surgery on "
W $E(DGX,4,5)_"/"_$E(DGX,6,7)_"/"_$E(DGX,2,3)
W:$P(DGSTR,U,3)'="" " Service: ",$P(^DIC(45.7,$P(DGSTR,U,3),0),U,3)
G B10
;
B5 W !!?10,"Scheduled for Quarters on "
W $E(DGX,4,5)_"/"_$E(DGX,6,7)_"/"_$E(DGX,2,3)
W ?50,"Provider: "
W:$P(DGSTR,U,2)'="" $E($P(^VA(200,$P(DGSTR,U,2),0),U),1,20)
G B10
;
END K DGZZ,DGZDT,DGSTR,DIC,DA,DR,DGPRV,DGSRV,LKPRINT Q
ADGDEM ; IHS/ADC/PDW/ENM - DAY SURGERY PATIENT INQUIRY ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 ;***> IHS additions to DGDEM (Patient Inquiry)
+4 ;***> last day surgery
+5 ;skip if no day surgery for patient
IF '$DATA(^ADGDS(DFN))
GOTO B1
+6 ;find last day surgery
SET (DGZDT,DGZZ)=0
A1 SET DGZDT=$ORDER(^ADGDS(DFN,"DS","AA",DGZDT))
IF DGZDT=""
GOTO A2
+1 SET DGZZ=DGZDT
GOTO A1
+2 ;
A2 ;skip if none found
IF DGZZ=0
GOTO B1
+1 SET DGA=$ORDER(^ADGDS(DFN,"DS","AA",DGZZ,0))
IF DGA=""
GOTO B1
+2 IF '$DATA(^ADGDS(DFN,"DS",DGA,0))#2
GOTO B1
SET DGSTR=^(0)
SET DGX=$PIECE(DGSTR,U)
+3 ;print data on last day surgery
+4 WRITE !!,"DAY SURGERY Date/Time: "
+5 WRITE $EXTRACT(DGX,4,5)_"/"_$EXTRACT(DGX,6,7)_"/"_$EXTRACT(DGX,2,3)
+6 IF DGX["."
WRITE " at ",$EXTRACT($PIECE(DGX,".",2)_"000",1,4)
+7 SET DGX=$PIECE(DGSTR,U,3)
IF DGX'=""
WRITE ?47,"Ward: ",$PIECE(^DIC(42,DGX,0),U)
+8 IF $PIECE($GET(^ADGDS(DFN,"DS",DGA,2)),U,3)="Y"
WRITE ?47,"(SURGERY CANCELLED)"
+9 IF $PIECE($GET(^ADGDS(DFN,"DS",DGA,2)),U,4)="Y"
WRITE ?47,"(NO-SHOW)"
+10 IF $PIECE(DGSTR,U,4)'=""
WRITE ?58,"Room-Bed: ",$PIECE(DGSTR,U,4)
+11 SET DGSRV=$PIECE(DGSTR,U,5)
SET DGPRV=$PIECE(DGSTR,U,6)
+12 IF DGSRV'=""
SET DGSRV=$PIECE($GET(^DIC(45.7,DGSRV,0)),U)
+13 IF DGPRV'=""
SET DGPRV=$PIECE($GET(^VA(200,DGPRV,0)),U)
+14 WRITE !?35,"Srvc: ",$EXTRACT(DGSRV,1,3),?47,"Prov: ",$EXTRACT(DGPRV,1,15)
+15 IF '$DATA(^ADGDS(DFN,"DS",DGA,2))
GOTO B1
IF $PIECE(^(2),U)=""
GOTO B1
SET DGX=$PIECE(^(2),U)
+16 IF DGX'=""
WRITE !?13,"Released: ",$EXTRACT(DGX,4,5)_"/"_$EXTRACT(DGX,6,7)_"/"_$EXTRACT(DGX,2,3)
+17 IF DGX["."
WRITE " at ",$EXTRACT($PIECE(DGX,".",2)_"000",1,4)
+18 WRITE ?47,"LOS: ",$$VAL^XBDIQ1(9009012.01,"DFN,DGA",8)," hrs"
+19 ;
+20 ;***> any scheduled visits on file?
B1 IF '$DATA(^ADGAUTH(DFN,0))
GOTO END
IF '$DATA(^ADGAUTH(DFN,1,0))
GOTO END
SET DG1=0
B10 SET DG1=$ORDER(^ADGAUTH(DFN,1,DG1))
IF DG1=""
GOTO END
+1 SET DGSTR=^ADGAUTH(DFN,1,DG1,0)
SET DGX=$PIECE(DGSTR,U)
+2 ;go to B3 if scheduled for day sur
SET DGX1=$PIECE(DGSTR,U,5)
IF DGX1="D"
GOTO B3
+3 ;go to B5 if scheduled for outpatient visit w/quarters
IF DGX1="Q"
GOTO B5
+4 ;otherwise if not a scheduled admit, go to end
IF DGX1'="I"
GOTO B10
+5 ;
+6 WRITE !!?10,"Scheduled Admit for "
+7 WRITE $EXTRACT(DGX,4,5)_"/"_$EXTRACT(DGX,6,7)_"/"_$EXTRACT(DGX,2,3)
+8 IF $PIECE(DGSTR,U,7)'=""
WRITE ?43,"Ward: ",$EXTRACT($PIECE(^DIC(42,$PIECE(DGSTR,U,7),0),U),1,3)
+9 IF $PIECE(DGSTR,U,3)'=""
WRITE ?55,"Service: ",$PIECE(^DIC(45.7,$PIECE(DGSTR,U,3),0),U,3)
+10 GOTO B10
+11 ;
B3 WRITE !!?10,"Scheduled for Day Surgery on "
+1 WRITE $EXTRACT(DGX,4,5)_"/"_$EXTRACT(DGX,6,7)_"/"_$EXTRACT(DGX,2,3)
+2 IF $PIECE(DGSTR,U,3)'=""
WRITE " Service: ",$PIECE(^DIC(45.7,$PIECE(DGSTR,U,3),0),U,3)
+3 GOTO B10
+4 ;
B5 WRITE !!?10,"Scheduled for Quarters on "
+1 WRITE $EXTRACT(DGX,4,5)_"/"_$EXTRACT(DGX,6,7)_"/"_$EXTRACT(DGX,2,3)
+2 WRITE ?50,"Provider: "
+3 IF $PIECE(DGSTR,U,2)'=""
WRITE $EXTRACT($PIECE(^VA(200,$PIECE(DGSTR,U,2),0),U),1,20)
+4 GOTO B10
+5 ;
END KILL DGZZ,DGZDT,DGSTR,DIC,DA,DR,DGPRV,DGSRV,LKPRINT
QUIT
