IB20PT8C.m

IB20PT8C	;ALB/CPM - EXPORT ROUTINE 'FBUINS' ; 04-MAR-94

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;

FBUINS	;AISC/DMK-ADD INSURANCE INFORMATION ;07JULY92

	;;3.0;FEE BASIS;**5**;NOV 26, 1993

	Q:$E(IOST,1,2)'="C-"

	Q:'$G(DFN)

	N FBOUT

INS	S DIR("A")="Want to add NEW insurance data",DIR("B")="No",DIR("?")="Answer 'Yes' if you want to add a new insurance company for this patient."

	S DIR("?",1)="You are not allowed to edit current insurance information.",DIR("?",2)="However, you will be given the opportunity to send a bulletin to MCCR",DIR("?",3)="if insurance information is incorrect."

	S DIR(0)="Y" D ^DIR K DIR Q:$D(DIRUT)

	D:Y FEE^IBCNSP2

	S DIR("A")="Are there any discrepancies with insurance data on file",DIR("?")="A 'Yes' answer will send a bulletin to MCCR",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR Q:$D(DIRUT)!('Y)  D

	.N VADM D DEM^VADPT S XMB(1)=VADM(1),XMB(2)=VA("PID")

	.S DIR("A")="Enter description of change",DIR(0)="F^3:70" D ^DIR K DIR Q:$D(DIRUT)  S XMB(3)=Y

	.S XMB="FB INSURANCE CHANGE",XMDUZ=$S($G(DUZ):DUZ,1:.5) D ^XMB

	K DIC,DIE,FBX,VA,XMB,XMDUZ,Y

	Q

IB20PT8C  ;ALB/CPM - EXPORT ROUTINE 'FBUINS' ; 04-MAR-94

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;

FBUINS    ;AISC/DMK-ADD INSURANCE INFORMATION ;07JULY92

 +1       ;;3.0;FEE BASIS;**5**;NOV 26, 1993

 +2        IF $EXTRACT(IOST,1,2)'="C-"

               QUIT 

 +3        IF '$GET(DFN)

               QUIT 

 +4        NEW FBOUT

INS        SET DIR("A")="Want to add NEW insurance data"

           SET DIR("B")="No"

           SET DIR("?")="Answer 'Yes' if you want to add a new insurance company for this patient."

 +1        SET DIR("?",1)="You are not allowed to edit current insurance information."

           SET DIR("?",2)="However, you will be given the opportunity to send a bulletin to MCCR"

           SET DIR("?",3)="if insurance information is incorrect."

 +2        SET DIR(0)="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               QUIT 

 +3        IF Y

               DO FEE^IBCNSP2

 +4        SET DIR("A")="Are there any discrepancies with insurance data on file"

           SET DIR("?")="A 'Yes' answer will send a bulletin to MCCR"

           SET DIR(0)="Y"

           SET DIR("B")="No"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!('Y)

               QUIT 

           Begin DoDot:1

 +5            NEW VADM

               DO DEM^VADPT

               SET XMB(1)=VADM(1)

               SET XMB(2)=VA("PID")

 +6            SET DIR("A")="Enter description of change"

               SET DIR(0)="F^3:70"

               DO ^DIR

               KILL DIR

               IF $DATA(DIRUT)

                   QUIT 

               SET XMB(3)=Y

 +7            SET XMB="FB INSURANCE CHANGE"

               SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)

               DO ^XMB

           End DoDot:1

 +8        KILL DIC,DIE,FBX,VA,XMB,XMDUZ,Y

 +9        QUIT