- IBCNSC1 ;ALB/NLR - IBCNS INSURANCE COMPANY ; 23-MAR-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % G EN^IBCNSC
- ;
- AI ; -- (In)Activate Company
- D FULL^VALM1 W !!
- I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D SORRY G EXIT
- D ^IBCNSC2
- G EXIT
- CC ; -- Change Insurance Company
- D FULL^VALM1 W !!
- S IBCNS1=IBCNS K IBCNS D INSCO^IBCNSC
- I $D(VALMQUIT) S IBCNS=IBCNS1 K VALMQUIT
- D:IBCNS'=IBCNS1
- K IBCNS1,VALMQUIT
- G EXIT
- EA ; -- Billing,Claims,Appeals,Inquiry,Telephone,Main,Remarks,Synonyms
- D FULL^VALM1 W !!
- D MAIN
- ;
- ; -- was company deleted
- I '$D(^DIC(36,IBCNS)) W !!,"<DELETED>",!! S VALMQUIT="" Q
- ;
- EXIT ;
- D HDR^IBCNSC,BLD^IBCNSC
- S VALMBCK="R"
- Q
- MAIN ; -- Call edit template
- L +^DIC(36,+IBCNS):5 I '$T D LOCKED^IBTRCD1 G MAINQ
- N DIE S DIE="^DIC(36,",(DA,Y)=IBCNS,DR="[IBEDIT INS CO1]" D ^DIE K DIE I $D(Y) S IB("^")=1
- L -^DIC(36,+IBCNS)
- MAINQ Q
- ;
- SORRY ; -- can't inactivate, don't have key
- W !!,"You do not have access to Inactivate entries. See your application coordinator.",! D PAUSE^VALM1
- Q
- PRESCR ;
- N OFFSET,START,IBCNS18,IBADD
- S IBCNS18=$$ADDRESS^IBCNSC0(IBCNS,.18,11)
- S START=34,OFFSET=2
- D SET^IBCNSP(START,OFFSET+19," Prescription Claims Office Information ",IORVON,IORVOFF)
- D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS18,"^",7),0)),"^",1))
- D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS18,"^",1))
- D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS18,"^",2))
- N OFFSET S OFFSET=45
- D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS18,"^",3)) S IBADD=1
- D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS18,"^",4),1,15)_$S($P(IBCNS18,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS18,"^",5),0)),"^",2)_" "_$E($P(IBCNS18,"^",6),1,5))
- D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS18,"^",8))
- D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS18,"^",9))
- Q
- IBCNSC1 ;ALB/NLR - IBCNS INSURANCE COMPANY ; 23-MAR-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- % GOTO EN^IBCNSC
- +1 ;
- AI ; -- (In)Activate Company
- +1 DO FULL^VALM1
- WRITE !!
- +2 IF '$DATA(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))
- DO SORRY
- GOTO EXIT
- +3 DO ^IBCNSC2
- +4 GOTO EXIT
- CC ; -- Change Insurance Company
- +1 DO FULL^VALM1
- WRITE !!
- +2 SET IBCNS1=IBCNS
- KILL IBCNS
- DO INSCO^IBCNSC
- +3 IF $DATA(VALMQUIT)
- SET IBCNS=IBCNS1
- KILL VALMQUIT
- +4 IF IBCNS'=IBCNS1
- Begin DoDot:1
- End DoDot:1
- +5 KILL IBCNS1,VALMQUIT
- +6 GOTO EXIT
- EA ; -- Billing,Claims,Appeals,Inquiry,Telephone,Main,Remarks,Synonyms
- +1 DO FULL^VALM1
- WRITE !!
- +2 DO MAIN
- +3 ;
- +4 ; -- was company deleted
- +5 IF '$DATA(^DIC(36,IBCNS))
- WRITE !!,"<DELETED>",!!
- SET VALMQUIT=""
- QUIT
- +6 ;
- EXIT ;
- +1 DO HDR^IBCNSC
- DO BLD^IBCNSC
- +2 SET VALMBCK="R"
- +3 QUIT
- MAIN ; -- Call edit template
- +1 LOCK +^DIC(36,+IBCNS):5
- IF '$TEST
- DO LOCKED^IBTRCD1
- GOTO MAINQ
- +2 NEW DIE
- SET DIE="^DIC(36,"
- SET (DA,Y)=IBCNS
- SET DR="[IBEDIT INS CO1]"
- DO ^DIE
- KILL DIE
- IF $DATA(Y)
- SET IB("^")=1
- +3 LOCK -^DIC(36,+IBCNS)
- MAINQ QUIT
- +1 ;
- SORRY ; -- can't inactivate, don't have key
- +1 WRITE !!,"You do not have access to Inactivate entries. See your application coordinator.",!
- DO PAUSE^VALM1
- +2 QUIT
- PRESCR ;
- +1 NEW OFFSET,START,IBCNS18,IBADD
- +2 SET IBCNS18=$$ADDRESS^IBCNSC0(IBCNS,.18,11)
- +3 SET START=34
- SET OFFSET=2
- +4 DO SET^IBCNSP(START,OFFSET+19," Prescription Claims Office Information ",IORVON,IORVOFF)
- +5 DO SET^IBCNSP(START+1,OFFSET," Company Name: "_$PIECE($GET(^DIC(36,+$PIECE(IBCNS18,"^",7),0)),"^",1))
- +6 DO SET^IBCNSP(START+2,OFFSET," Street: "_$PIECE(IBCNS18,"^",1))
- +7 DO SET^IBCNSP(START+3,OFFSET," Street 2: "_$PIECE(IBCNS18,"^",2))
- +8 NEW OFFSET
- SET OFFSET=45
- +9 DO SET^IBCNSP(START+1,OFFSET," Street 3: "_$PIECE(IBCNS18,"^",3))
- SET IBADD=1
- +10 DO SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$EXTRACT($PIECE(IBCNS18,"^",4),1,15)_$SELECT($PIECE(IBCNS18,"^",4)="":"",1:", ")_$PIECE($GET(^DIC(5,+$PIECE(IBCNS18,"^",5),0)),"^",2)_" "_$EXTRACT($PIECE(IBCNS18,"^",6),1,5))
- +11 DO SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$PIECE(IBCNS18,"^",8))
- +12 DO SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$PIECE(IBCNS18,"^",9))
- +13 QUIT
