| [613] | 1 | IBARXEPE ;ALB/AAS - EDIT EXEMPTION LETTER - 28-APR-93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**34**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | % I '$D(DT) D DT^DICRW
|
|---|
| 6 | ;
|
|---|
| 7 | EDIT ; -- Edit form letter
|
|---|
| 8 | I '$D(IOF) D HOME^%ZIS
|
|---|
| 9 | W @IOF,"Edit Exemption Patient Notification Letter",!!!
|
|---|
| 10 | S IBQUIT=0
|
|---|
| 11 | S DIC(0)="AEQMNLZ",DIC="^IBE(354.6," D ^DIC K DIC G:+Y<1 EDQ S (IBLET,DA)=+Y,IBLET0=Y(0)
|
|---|
| 12 | ;
|
|---|
| 13 | S DR="" I $P($G(^IBE(354.6,DA,0)),"^",4)="" S DR=".04////15;"
|
|---|
| 14 | S DR=DR_"2;1;.04" I $P(IBLET0,"^",3)=2 S DR=DR_";.05;.07;.08"
|
|---|
| 15 | ;
|
|---|
| 16 | S DIE="^IBE(354.6," D ^DIE K DA,DIE,DR
|
|---|
| 17 | I $P(IBLET0,"^",3)=2 D SCHED
|
|---|
| 18 | ;
|
|---|
| 19 | W !!
|
|---|
| 20 | TEST S DIR(0)="Y",DIR("A")="Test Print Letter",DIR("B")="YES" D ^DIR K DIR
|
|---|
| 21 | I Y'=1 G EDQ
|
|---|
| 22 | ;
|
|---|
| 23 | S DIC="^DPT(",DIC(0)="AEQM",DIC("S")=$S($P(IBLET0,"^",3)=2:"I $G(^IBA(354,+Y,0))",1:"I $P($G(^IBA(354,+Y,0)),U,4)")
|
|---|
| 24 | S DIC("A")="Select "_$S($P(IBLET0,"^",3)=2:"",1:"Exempt ")_"BILLING PATIENT: "
|
|---|
| 25 | W ! D ^DIC K DIC I +Y<1 G EDQ
|
|---|
| 26 | S DFN=+Y,IBDATA=$$PT^IBEFUNC(DFN),IBNAM=$P(IBDATA,"^")
|
|---|
| 27 | I $P(IBLET0,"^",3)=2 S IBEXPD="December 31, "_($E(DT,1,3)+1700)
|
|---|
| 28 | S %ZIS="QM" D ^%ZIS G:POP EDQ
|
|---|
| 29 | 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
|
|---|
| 30 | U IO
|
|---|
| 31 | ;
|
|---|
| 32 | ED1 S IBALIN=$P($G(^IBE(354.6,IBLET,0)),"^",4)
|
|---|
| 33 | I IBALIN<10!(IBALIN>25) S IBALIN=15
|
|---|
| 34 | D ONE^IBARXEPL
|
|---|
| 35 | ;
|
|---|
| 36 | EDQ D END^IBARXEPL
|
|---|
| 37 | K IBLET0,IBEXPD
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | SCHED ; Select days to generate the income test reminder letters.
|
|---|
| 42 | N DIR,DIRUT,DTOUT,DUOUT,DIROUT,IBD,IBDAY,IBI,IBQ
|
|---|
| 43 | S IBD=$P(IBLET0,"^",6),IBQ=0
|
|---|
| 44 | I IBD="" W !!,"The income test reminder letters are not currently scheduled to be printed."
|
|---|
| 45 | I IBD]"" D I IBQ G SCHEDQ
|
|---|
| 46 | .W !!,"The income test reminder letters are scheduled to be printed on:",!
|
|---|
| 47 | .F IBI=1:1:$L(IBD) W !?8,$P("SUNDAY^MONDAY^TUESDAY^WEDNESDAY^THURSDAY^FRIDAY^SATURDAY","^",$E(IBD,IBI)+1)
|
|---|
| 48 | .S DIR(0)="Y",DIR("A")="Do you wish to stop this job from running"
|
|---|
| 49 | .S DIR("?")="Type 'YES' if you do not want this job to run any longer."
|
|---|
| 50 | .W ! D ^DIR I $D(DIRUT) S IBQ=1 Q
|
|---|
| 51 | .I Y S IBQ=1,$P(^IBE(354.6,IBLET,0),"^",6)="" W !,"The job has been unscheduled." Q
|
|---|
| 52 | ;
|
|---|
| 53 | S IBDAY=$$ASK I IBDAY]"" S $P(^IBE(354.6,IBLET,0),"^",6)=IBDAY
|
|---|
| 54 | SCHEDQ Q
|
|---|
| 55 | ;
|
|---|
| 56 | ASK() ; Ask what days to generate letters.
|
|---|
| 57 | N DIR,DIRUT,DUOUT,DTOUT,DIROUT,I,X,Y
|
|---|
| 58 | W !!?4,"Your printed letters may be picked up on the following mornings:"
|
|---|
| 59 | W !!?8,"0 SUNDAY"
|
|---|
| 60 | W !?8,"1 MONDAY"
|
|---|
| 61 | W !?8,"2 TUESDAY"
|
|---|
| 62 | W !?8,"3 WEDNESDAY"
|
|---|
| 63 | W !?8,"4 THURSDAY"
|
|---|
| 64 | W !?8,"5 FRIDAY"
|
|---|
| 65 | W !?8,"6 SATURDAY",!
|
|---|
| 66 | S DIR("A")=" Select, by number, those mornings to pick up letters"
|
|---|
| 67 | S DIR(0)="L^0:6" D ^DIR I Y'["," S Y="" G ASKQ
|
|---|
| 68 | F I=1:1:$L(Y,",") I $P(Y,",",I)]"" S X($P(Y,",",I))=""
|
|---|
| 69 | S (I,Y)="" F S I=$O(X(I)) Q:I="" S Y=Y_I
|
|---|
| 70 | ASKQ Q Y
|
|---|
