- 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
