- 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
