Routine: IBCNSC1

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"

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

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))

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

IBCNSC1.m