- IBOLK1 ;ALB/CPM - DISPLAY BY BILL NUMBER, ADDRESS INQUIRY ; 28-JAN-92
- ;;2.0;INTEGRATED BILLING;**80**;21-MAR-94
- ;
- ; Input: DFN -- pointer to patient in File #2
- ; IBIFN -- pointer to a bill in File #399
- ;
- D @("HDR1^"_$S(IBIFN:"IBCNQ",1:"IBOLK"))
- W !!?25,"*** ADDRESS INFORMATION ***"
- ;
- ; - display patient address
- D ADD^VADPT
- W !!,"Patient Address: ",VAPA(1)
- W:VAPA(2)]"" !?18,VAPA(2) W:VAPA(3)]"" !?18,VAPA(3)
- W:VAPA(4)]""!(VAPA(5)]"")!(VAPA(6)]"") !?18
- W VAPA(4) W:VAPA(4)]""&(VAPA(5)]"") ", " W $P(VAPA(5),"^",2)
- W:VAPA(6)]""&(VAPA(4)]""!(VAPA(5)]"")) " " W VAPA(6)
- W:VAPA(8)]"" !?18,VAPA(8)
- ;
- ; - display mailing address for a UB-82
- I IBIFN S IBM=$P($G(^DGCR(399,IBIFN,"M")),"^",4,9),IBM1=$G(^("M1")) D
- . Q:IBM=""&(IBM1="") W !!,"Mailing Address: " D ADDR
- ;
- ; - display Insurance Company or Institution addresses for UB-82's
- I IBIFN S X=$P($G(^DGCR(399.3,+$P($G(^DGCR(399,IBIFN,0)),"^",7),0)),"^",7) D:X["i"!(X["o")
- . I X["i" S Y=+$G(^DGCR(399,IBIFN,"MP")) Q:'$D(^DIC(36,Y,0)) D
- .. S IBM=$P(^DIC(36,Y,0),"^")_"^"_$G(^(.11)),IBPHONE=$P($G(^(.13)),"^")
- .. S IBM1=$P(IBM,"^",4),$P(IBM,"^",4,6)=$P(IBM,"^",5,7)
- . I X["o" S Y=+$P($G(^DGCR(399,IBIFN,"M")),"^",11) Q:'$D(^DIC(4,Y,0)) D
- .. S IBM=$P(^DIC(4,Y,0),"^",1,2)_"^"_$G(^(1)),IBPHONE="",IBM1=""
- .. S Z=$P(IBM,"^",2),$P(IBM,"^",2,4)=$P(IBM,"^",3,5),$P(IBM,"^",5)=Z
- . W !!,$S(X["i":"Ins Co.",1:"Instit.")," Address: " D ADDR
- . W:IBPHONE]"" !?18,$P(IBPHONE,"^")
- ;
- D PAUSE^IBOLK
- K IBM,IBM1,IBPHONE,VA,VAERR,VAPA,X,Y,Z Q
- ;
- ADDR ; Print mailing addresses for Insurance Companies and Institutions.
- W $P(IBM,"^") W:$P(IBM,"^",2)]"" !?18,$P(IBM,"^",2)
- W:$P(IBM,"^",3)]"" !?18,$P(IBM,"^",3) W:$P(IBM1,"^")]"" !?18,$P(IBM1,"^")
- W:$P(IBM,"^",4)]""!($P(IBM,"^",5)]"")!($P(IBM,"^",6)]"") !?18
- W $P(IBM,"^",4) W:$P(IBM,"^",4)]""&($P(IBM,"^",5)]"") ", "
- W $P($G(^DIC(5,+$P(IBM,"^",5),0)),"^")
- W:$P(IBM,"^",6)]""&($P(IBM,"^",4)]""!($P(IBM,"^",5)]"")) " "
- W $P(IBM,"^",6)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOLK1 2025 printed Feb 18, 2025@23:52:17 Page 2
- IBOLK1 ;ALB/CPM - DISPLAY BY BILL NUMBER, ADDRESS INQUIRY ; 28-JAN-92
- +1 ;;2.0;INTEGRATED BILLING;**80**;21-MAR-94
- +2 ;
- +3 ; Input: DFN -- pointer to patient in File #2
- +4 ; IBIFN -- pointer to a bill in File #399
- +5 ;
- +6 DO @("HDR1^"_$SELECT(IBIFN:"IBCNQ",1:"IBOLK"))
- +7 WRITE !!?25,"*** ADDRESS INFORMATION ***"
- +8 ;
- +9 ; - display patient address
- +10 DO ADD^VADPT
- +11 WRITE !!,"Patient Address: ",VAPA(1)
- +12 if VAPA(2)]""
- WRITE !?18,VAPA(2)
- if VAPA(3)]""
- WRITE !?18,VAPA(3)
- +13 if VAPA(4)]""!(VAPA(5)]"")!(VAPA(6)]"")
- WRITE !?18
- +14 WRITE VAPA(4)
- if VAPA(4)]""&(VAPA(5)]"")
- WRITE ", "
- WRITE $PIECE(VAPA(5),"^",2)
- +15 if VAPA(6)]""&(VAPA(4)]""!(VAPA(5)]""))
- WRITE " "
- WRITE VAPA(6)
- +16 if VAPA(8)]""
- WRITE !?18,VAPA(8)
- +17 ;
- +18 ; - display mailing address for a UB-82
- +19 IF IBIFN
- SET IBM=$PIECE($GET(^DGCR(399,IBIFN,"M")),"^",4,9)
- SET IBM1=$GET(^("M1"))
- Begin DoDot:1
- +20 if IBM=""&(IBM1="")
- QUIT
- WRITE !!,"Mailing Address: "
- DO ADDR
- End DoDot:1
- +21 ;
- +22 ; - display Insurance Company or Institution addresses for UB-82's
- +23 IF IBIFN
- SET X=$PIECE($GET(^DGCR(399.3,+$PIECE($GET(^DGCR(399,IBIFN,0)),"^",7),0)),"^",7)
- if X["i"!(X["o")
- Begin DoDot:1
- +24 IF X["i"
- SET Y=+$GET(^DGCR(399,IBIFN,"MP"))
- if '$DATA(^DIC(36,Y,0))
- QUIT
- Begin DoDot:2
- +25 SET IBM=$PIECE(^DIC(36,Y,0),"^")_"^"_$GET(^(.11))
- SET IBPHONE=$PIECE($GET(^(.13)),"^")
- +26 SET IBM1=$PIECE(IBM,"^",4)
- SET $PIECE(IBM,"^",4,6)=$PIECE(IBM,"^",5,7)
- End DoDot:2
- +27 IF X["o"
- SET Y=+$PIECE($GET(^DGCR(399,IBIFN,"M")),"^",11)
- if '$DATA(^DIC(4,Y,0))
- QUIT
- Begin DoDot:2
- +28 SET IBM=$PIECE(^DIC(4,Y,0),"^",1,2)_"^"_$GET(^(1))
- SET IBPHONE=""
- SET IBM1=""
- +29 SET Z=$PIECE(IBM,"^",2)
- SET $PIECE(IBM,"^",2,4)=$PIECE(IBM,"^",3,5)
- SET $PIECE(IBM,"^",5)=Z
- End DoDot:2
- +30 WRITE !!,$SELECT(X["i":"Ins Co.",1:"Instit.")," Address: "
- DO ADDR
- +31 if IBPHONE]""
- WRITE !?18,$PIECE(IBPHONE,"^")
- End DoDot:1
- +32 ;
- +33 DO PAUSE^IBOLK
- +34 KILL IBM,IBM1,IBPHONE,VA,VAERR,VAPA,X,Y,Z
- QUIT
- +35 ;
- ADDR ; Print mailing addresses for Insurance Companies and Institutions.
- +1 WRITE $PIECE(IBM,"^")
- if $PIECE(IBM,"^",2)]""
- WRITE !?18,$PIECE(IBM,"^",2)
- +2 if $PIECE(IBM,"^",3)]""
- WRITE !?18,$PIECE(IBM,"^",3)
- if $PIECE(IBM1,"^")]""
- WRITE !?18,$PIECE(IBM1,"^")
- +3 if $PIECE(IBM,"^",4)]""!($PIECE(IBM,"^",5)]"")!($PIECE(IBM,"^",6)]"")
- WRITE !?18
- +4 WRITE $PIECE(IBM,"^",4)
- if $PIECE(IBM,"^",4)]""&($PIECE(IBM,"^",5)]"")
- WRITE ", "
- +5 WRITE $PIECE($GET(^DIC(5,+$PIECE(IBM,"^",5),0)),"^")
- +6 if $PIECE(IBM,"^",6)]""&($PIECE(IBM,"^",4)]""!($PIECE(IBM,"^",5)]""))
- WRITE " "
- +7 WRITE $PIECE(IBM,"^",6)
- +8 QUIT
