- IBCNSC0 ;ALB/NLR - INSURANCE COMPANY EDIT - ; 12-MAR-1993
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- CLAIMS1 ; display Inpatient Claims information
- N OFFSET,START,IBCNS12,IBADD
- S START=21,OFFSET=2
- D SET^IBCNSP(START,OFFSET+20," Inpatient Claims Office Information ",IORVON,IORVOFF)
- S IBCNS12=$$ADDRESS(IBCNS,.12,5)
- D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS12,"^",7),0)),"^",1))
- D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS12,"^",1))
- D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS12,"^",2))
- N OFFSET S OFFSET=45
- D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS12,"^",3)) S IBADD=1
- D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS12,"^",4),1,15)_$S($P(IBCNS12,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS12,"^",5),0)),"^",2)_" "_$E($P(IBCNS12,"^",6),1,5))
- D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS12,"^",8))
- D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS12,"^",9))
- Q
- ;
- R1Q Q
- CLAIMS2 ; display Outpatient Claims information
- ;
- N OFFSET,START,IBCNS16,IBADD
- S START=27,OFFSET=2
- D SET^IBCNSP(START,OFFSET+20," Outpatient Claims Office Information ",IORVON,IORVOFF)
- S IBCNS16=$$ADDRESS(IBCNS,.16,6)
- D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS16,"^",7),0)),"^",1))
- D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS16,"^",1))
- D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS16,"^",2))
- N OFFSET S OFFSET=45
- D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS16,"^",3)) S IBADD=1
- D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS16,"^",4),1,15)_$S($P(IBCNS16,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS16,"^",5),0)),"^",2)_" "_$E($P(IBCNS16,"^",6),1,5))
- D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS16,"^",8))
- D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS16,"^",9))
- Q
- ;
- ADDRESS(INS,NODE,PH) ; -- generic find address
- ;
- N IBX,INSSAVE,IBPH,IBFX,IBCNT,IBA
- S IBX="" ;S IBPH="",IBFX="",IBA=""
- ;
- REDO ; gather insurance carrier's main address information
- S IBX=$G(^DIC(36,+INS,.11)),IBPH=$P($G(^DIC(36,+INS,.13)),"^",1),IBFX=$P(IBX,"^",9)
- ;S IBCNT=$G(IBCNT)+1
- ;
- ; -- if process the same co. more than once you are in an infinite loop
- ;I $D(IBCNT(IBCNS)) G ADDREQ
- ;S IBCNT(IBCNS)=""
- ;
- ; -- gather address information from specific office (Claims, Appeals, Inquiry)
- ;
- I $P($G(^DIC(36,+INS,+NODE)),"^",5) S IBX=$G(^DIC(36,+INS,+NODE)),IBPH=$P($G(^DIC(36,+INS,.13)),"^",PH),IBFX=$P($G(IBX),"^",9)
- I $P($G(^DIC(36,+INS,+NODE)),"^",7) S INSSAVE=INS,INS=$P($G(^DIC(36,+INS,+NODE)),"^",7) I INSSAVE'=INS G REDO
- ;
- ADDRESQ ; concatenate company name, address, phone and fax
- S $P(IBA,"^",1,6)=$P($G(IBX),"^",1,6)
- S $P(IBA,"^",7)=INS
- S $P(IBA,"^",8)=IBPH
- S $P(IBA,"^",9)=IBFX
- ADDREQ Q IBA
- IBCNSC0 ;ALB/NLR - INSURANCE COMPANY EDIT - ; 12-MAR-1993
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- CLAIMS1 ; display Inpatient Claims information
- +1 NEW OFFSET,START,IBCNS12,IBADD
- +2 SET START=21
- SET OFFSET=2
- +3 DO SET^IBCNSP(START,OFFSET+20," Inpatient Claims Office Information ",IORVON,IORVOFF)
- +4 SET IBCNS12=$$ADDRESS(IBCNS,.12,5)
- +5 DO SET^IBCNSP(START+1,OFFSET," Company Name: "_$PIECE($GET(^DIC(36,+$PIECE(IBCNS12,"^",7),0)),"^",1))
- +6 DO SET^IBCNSP(START+2,OFFSET," Street: "_$PIECE(IBCNS12,"^",1))
- +7 DO SET^IBCNSP(START+3,OFFSET," Street 2: "_$PIECE(IBCNS12,"^",2))
- +8 NEW OFFSET
- SET OFFSET=45
- +9 DO SET^IBCNSP(START+1,OFFSET," Street 3: "_$PIECE(IBCNS12,"^",3))
- SET IBADD=1
- +10 DO SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$EXTRACT($PIECE(IBCNS12,"^",4),1,15)_$SELECT($PIECE(IBCNS12,"^",4)="":"",1:", ")_$PIECE($GET(^DIC(5,+$PIECE(IBCNS12,"^",5),0)),"^",2)_" "_$EXTRACT($PIECE(IBCNS12,"^",6),1,5))
- +11 DO SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$PIECE(IBCNS12,"^",8))
- +12 DO SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$PIECE(IBCNS12,"^",9))
- +13 QUIT
- +14 ;
- R1Q QUIT
- CLAIMS2 ; display Outpatient Claims information
- +1 ;
- +2 NEW OFFSET,START,IBCNS16,IBADD
- +3 SET START=27
- SET OFFSET=2
- +4 DO SET^IBCNSP(START,OFFSET+20," Outpatient Claims Office Information ",IORVON,IORVOFF)
- +5 SET IBCNS16=$$ADDRESS(IBCNS,.16,6)
- +6 DO SET^IBCNSP(START+1,OFFSET," Company Name: "_$PIECE($GET(^DIC(36,+$PIECE(IBCNS16,"^",7),0)),"^",1))
- +7 DO SET^IBCNSP(START+2,OFFSET," Street: "_$PIECE(IBCNS16,"^",1))
- +8 DO SET^IBCNSP(START+3,OFFSET," Street 2: "_$PIECE(IBCNS16,"^",2))
- +9 NEW OFFSET
- SET OFFSET=45
- +10 DO SET^IBCNSP(START+1,OFFSET," Street 3: "_$PIECE(IBCNS16,"^",3))
- SET IBADD=1
- +11 DO SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$EXTRACT($PIECE(IBCNS16,"^",4),1,15)_$SELECT($PIECE(IBCNS16,"^",4)="":"",1:", ")_$PIECE($GET(^DIC(5,+$PIECE(IBCNS16,"^",5),0)),"^",2)_" "_$EXTRACT($PIECE(IBCNS16,"^",6),1,5))
- +12 DO SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$PIECE(IBCNS16,"^",8))
- +13 DO SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$PIECE(IBCNS16,"^",9))
- +14 QUIT
- +15 ;
- ADDRESS(INS,NODE,PH) ; -- generic find address
- +1 ;
- +2 NEW IBX,INSSAVE,IBPH,IBFX,IBCNT,IBA
- +3 ;S IBPH="",IBFX="",IBA=""
- SET IBX=""
- +4 ;
- REDO ; gather insurance carrier's main address information
- +1 SET IBX=$GET(^DIC(36,+INS,.11))
- SET IBPH=$PIECE($GET(^DIC(36,+INS,.13)),"^",1)
- SET IBFX=$PIECE(IBX,"^",9)
- +2 ;S IBCNT=$G(IBCNT)+1
- +3 ;
- +4 ; -- if process the same co. more than once you are in an infinite loop
- +5 ;I $D(IBCNT(IBCNS)) G ADDREQ
- +6 ;S IBCNT(IBCNS)=""
- +7 ;
- +8 ; -- gather address information from specific office (Claims, Appeals, Inquiry)
- +9 ;
- +10 IF $PIECE($GET(^DIC(36,+INS,+NODE)),"^",5)
- SET IBX=$GET(^DIC(36,+INS,+NODE))
- SET IBPH=$PIECE($GET(^DIC(36,+INS,.13)),"^",PH)
- SET IBFX=$PIECE($GET(IBX),"^",9)
- +11 IF $PIECE($GET(^DIC(36,+INS,+NODE)),"^",7)
- SET INSSAVE=INS
- SET INS=$PIECE($GET(^DIC(36,+INS,+NODE)),"^",7)
- IF INSSAVE'=INS
- GOTO REDO
- +12 ;
- ADDRESQ ; concatenate company name, address, phone and fax
- +1 SET $PIECE(IBA,"^",1,6)=$PIECE($GET(IBX),"^",1,6)
- +2 SET $PIECE(IBA,"^",7)=INS
- +3 SET $PIECE(IBA,"^",8)=IBPH
- +4 SET $PIECE(IBA,"^",9)=IBFX
- ADDREQ QUIT IBA
