IBARXEPE.m

IBARXEPE	;ALB/AAS - EDIT EXEMPTION LETTER - 28-APR-93

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

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

%	I '$D(DT) D DT^DICRW

	;

EDIT	; -- Edit form letter

	I '$D(IOF) D HOME^%ZIS

	W @IOF,"Edit Exemption Patient Notification Letter",!!!

	S IBQUIT=0

	S DIC("B")="IB NOW EXEMPT",DIC(0)="AEQMNL",DIC="^IBE(354.6," D ^DIC K DIC S (IBLET,DA)=+Y G:DA<1 EDQ

	S DR=""

	I $P($G(^IBE(354.6,DA,0)),"^",4)="" S DR=".04////15;"

	S DIE="^IBE(354.6,",DR=DR_"2;1;.04" D ^DIE

	;

	W !!

TEST	S DIR(0)="Y",DIR("A")="Test Print Letter",DIR("B")="YES" D ^DIR K DIR

	I Y'=1 G EDQ

	W !

	S DIC="^DPT(",DIC(0)="AEQM",DIC("S")="I $P($G(^IBA(354,+Y,0)),U,4)",DIC("A")="Select Exempt BILLING PATIENT: "

	D ^DIC K DIC I +Y<1 G EDQ

	S DFN=+Y,IBDATA=$$PT^IBEFUNC(DFN),IBNAM=$P(IBDATA,"^")

	S %ZIS="QM" D ^%ZIS G:POP EDQ

	I $D(IO("Q")) K IO("Q") S ZTRTN="ED1^IBARXEPE",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="Test Print Exemption Letter" D ^%ZTLOAD K ZTSK D HOME^%ZIS G EDQ

	U IO

	; 

ED1	S IBALIN=$P($G(^IBE(354.6,IBLET,0)),"^",4)

	I IBALIN<10!(IBALIN>25) S IBALIN=15

	D ONE^IBARXEPL

	;

EDQ	D END^IBARXEPL

	Q

IBARXEPE  ;ALB/AAS - EDIT EXEMPTION LETTER - 28-APR-93

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

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

%          IF '$DATA(DT)

               DO DT^DICRW

 +1       ;

EDIT      ; -- Edit form letter

 +1        IF '$DATA(IOF)

               DO HOME^%ZIS

 +2        WRITE @IOF,"Edit Exemption Patient Notification Letter",!!!

 +3        SET IBQUIT=0

 +4        SET DIC("B")="IB NOW EXEMPT"

           SET DIC(0)="AEQMNL"

           SET DIC="^IBE(354.6,"

           DO ^DIC

           KILL DIC

           SET (IBLET,DA)=+Y

           IF DA<1

               GOTO EDQ

 +5        SET DR=""

 +6        IF $PIECE($GET(^IBE(354.6,DA,0)),"^",4)=""

               SET DR=".04////15;"

 +7        SET DIE="^IBE(354.6,"

           SET DR=DR_"2;1;.04"

           DO ^DIE

 +8       ;

 +9        WRITE !!

TEST       SET DIR(0)="Y"

           SET DIR("A")="Test Print Letter"

           SET DIR("B")="YES"

           DO ^DIR

           KILL DIR

 +1        IF Y'=1

               GOTO EDQ

 +2        WRITE !

 +3        SET DIC="^DPT("

           SET DIC(0)="AEQM"

           SET DIC("S")="I $P($G(^IBA(354,+Y,0)),U,4)"

           SET DIC("A")="Select Exempt BILLING PATIENT: "

 +4        DO ^DIC

           KILL DIC

           IF +Y<1

               GOTO EDQ

 +5        SET DFN=+Y

           SET IBDATA=$$PT^IBEFUNC(DFN)

           SET IBNAM=$PIECE(IBDATA,"^")

 +6        SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               GOTO EDQ

 +7        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="ED1^IBARXEPE"

               SET ZTSAVE("IB*")=""

               SET ZTSAVE("DFN")=""

               SET ZTDESC="Test Print Exemption Letter"

               DO ^%ZTLOAD

               KILL ZTSK

               DO HOME^%ZIS

               GOTO EDQ

 +8        USE IO

 +9       ; 

ED1        SET IBALIN=$PIECE($GET(^IBE(354.6,IBLET,0)),"^",4)

 +1        IF IBALIN<10!(IBALIN>25)

               SET IBALIN=15

 +2        DO ONE^IBARXEPL

 +3       ;

EDQ        DO END^IBARXEPL

 +1        QUIT