- IBARXEPE ;ALB/AAS - EDIT EXEMPTION LETTER - 28-APR-93
- ;;Version 2.0 ; INTEGRATED BILLING ;**34**; 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(0)="AEQMNLZ",DIC="^IBE(354.6," D ^DIC K DIC G:+Y<1 EDQ S (IBLET,DA)=+Y,IBLET0=Y(0)
- ;
- S DR="" I $P($G(^IBE(354.6,DA,0)),"^",4)="" S DR=".04////15;"
- S DR=DR_"2;1;.04" I $P(IBLET0,"^",3)=2 S DR=DR_";.05;.07;.08"
- ;
- S DIE="^IBE(354.6," D ^DIE K DA,DIE,DR
- I $P(IBLET0,"^",3)=2 D SCHED
- ;
- W !!
- TEST S DIR(0)="Y",DIR("A")="Test Print Letter",DIR("B")="YES" D ^DIR K DIR
- I Y'=1 G EDQ
- ;
- 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)")
- S DIC("A")="Select "_$S($P(IBLET0,"^",3)=2:"",1:"Exempt ")_"BILLING PATIENT: "
- W ! D ^DIC K DIC I +Y<1 G EDQ
- S DFN=+Y,IBDATA=$$PT^IBEFUNC(DFN),IBNAM=$P(IBDATA,"^")
- I $P(IBLET0,"^",3)=2 S IBEXPD="December 31, "_($E(DT,1,3)+1700)
- 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
- K IBLET0,IBEXPD
- Q
- ;
- ;
- SCHED ; Select days to generate the income test reminder letters.
- N DIR,DIRUT,DTOUT,DUOUT,DIROUT,IBD,IBDAY,IBI,IBQ
- S IBD=$P(IBLET0,"^",6),IBQ=0
- I IBD="" W !!,"The income test reminder letters are not currently scheduled to be printed."
- I IBD]"" D I IBQ G SCHEDQ
- .W !!,"The income test reminder letters are scheduled to be printed on:",!
- .F IBI=1:1:$L(IBD) W !?8,$P("SUNDAY^MONDAY^TUESDAY^WEDNESDAY^THURSDAY^FRIDAY^SATURDAY","^",$E(IBD,IBI)+1)
- .S DIR(0)="Y",DIR("A")="Do you wish to stop this job from running"
- .S DIR("?")="Type 'YES' if you do not want this job to run any longer."
- .W ! D ^DIR I $D(DIRUT) S IBQ=1 Q
- .I Y S IBQ=1,$P(^IBE(354.6,IBLET,0),"^",6)="" W !,"The job has been unscheduled." Q
- ;
- S IBDAY=$$ASK I IBDAY]"" S $P(^IBE(354.6,IBLET,0),"^",6)=IBDAY
- SCHEDQ Q
- ;
- ASK() ; Ask what days to generate letters.
- N DIR,DIRUT,DUOUT,DTOUT,DIROUT,I,X,Y
- W !!?4,"Your printed letters may be picked up on the following mornings:"
- W !!?8,"0 SUNDAY"
- W !?8,"1 MONDAY"
- W !?8,"2 TUESDAY"
- W !?8,"3 WEDNESDAY"
- W !?8,"4 THURSDAY"
- W !?8,"5 FRIDAY"
- W !?8,"6 SATURDAY",!
- S DIR("A")=" Select, by number, those mornings to pick up letters"
- S DIR(0)="L^0:6" D ^DIR I Y'["," S Y="" G ASKQ
- F I=1:1:$L(Y,",") I $P(Y,",",I)]"" S X($P(Y,",",I))=""
- S (I,Y)="" F S I=$O(X(I)) Q:I="" S Y=Y_I
- ASKQ Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXEPE 2808 printed Feb 18, 2025@23:33:42 Page 2
- IBARXEPE ;ALB/AAS - EDIT EXEMPTION LETTER - 28-APR-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**34**; 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(0)="AEQMNLZ"
- SET DIC="^IBE(354.6,"
- DO ^DIC
- KILL DIC
- if +Y<1
- GOTO EDQ
- SET (IBLET,DA)=+Y
- SET IBLET0=Y(0)
- +5 ;
- +6 SET DR=""
- IF $PIECE($GET(^IBE(354.6,DA,0)),"^",4)=""
- SET DR=".04////15;"
- +7 SET DR=DR_"2;1;.04"
- IF $PIECE(IBLET0,"^",3)=2
- SET DR=DR_";.05;.07;.08"
- +8 ;
- +9 SET DIE="^IBE(354.6,"
- DO ^DIE
- KILL DA,DIE,DR
- +10 IF $PIECE(IBLET0,"^",3)=2
- DO SCHED
- +11 ;
- +12 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 ;
- +3 SET DIC="^DPT("
- SET DIC(0)="AEQM"
- SET DIC("S")=$SELECT($PIECE(IBLET0,"^",3)=2:"I $G(^IBA(354,+Y,0))",1:"I $P($G(^IBA(354,+Y,0)),U,4)")
- +4 SET DIC("A")="Select "_$SELECT($PIECE(IBLET0,"^",3)=2:"",1:"Exempt ")_"BILLING PATIENT: "
- +5 WRITE !
- DO ^DIC
- KILL DIC
- IF +Y<1
- GOTO EDQ
- +6 SET DFN=+Y
- SET IBDATA=$$PT^IBEFUNC(DFN)
- SET IBNAM=$PIECE(IBDATA,"^")
- +7 IF $PIECE(IBLET0,"^",3)=2
- SET IBEXPD="December 31, "_($EXTRACT(DT,1,3)+1700)
- +8 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO EDQ
- +9 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
- +10 USE IO
- +11 ;
- 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 KILL IBLET0,IBEXPD
- +2 QUIT
- +3 ;
- +4 ;
- SCHED ; Select days to generate the income test reminder letters.
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,DIROUT,IBD,IBDAY,IBI,IBQ
- +2 SET IBD=$PIECE(IBLET0,"^",6)
- SET IBQ=0
- +3 IF IBD=""
- WRITE !!,"The income test reminder letters are not currently scheduled to be printed."
- +4 IF IBD]""
- Begin DoDot:1
- +5 WRITE !!,"The income test reminder letters are scheduled to be printed on:",!
- +6 FOR IBI=1:1:$LENGTH(IBD)
- WRITE !?8,$PIECE("SUNDAY^MONDAY^TUESDAY^WEDNESDAY^THURSDAY^FRIDAY^SATURDAY","^",$EXTRACT(IBD,IBI)+1)
- +7 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to stop this job from running"
- +8 SET DIR("?")="Type 'YES' if you do not want this job to run any longer."
- +9 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)
- SET IBQ=1
- QUIT
- +10 IF Y
- SET IBQ=1
- SET $PIECE(^IBE(354.6,IBLET,0),"^",6)=""
- WRITE !,"The job has been unscheduled."
- QUIT
- End DoDot:1
- IF IBQ
- GOTO SCHEDQ
- +11 ;
- +12 SET IBDAY=$$ASK
- IF IBDAY]""
- SET $PIECE(^IBE(354.6,IBLET,0),"^",6)=IBDAY
- SCHEDQ QUIT
- +1 ;
- ASK() ; Ask what days to generate letters.
- +1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,I,X,Y
- +2 WRITE !!?4,"Your printed letters may be picked up on the following mornings:"
- +3 WRITE !!?8,"0 SUNDAY"
- +4 WRITE !?8,"1 MONDAY"
- +5 WRITE !?8,"2 TUESDAY"
- +6 WRITE !?8,"3 WEDNESDAY"
- +7 WRITE !?8,"4 THURSDAY"
- +8 WRITE !?8,"5 FRIDAY"
- +9 WRITE !?8,"6 SATURDAY",!
- +10 SET DIR("A")=" Select, by number, those mornings to pick up letters"
- +11 SET DIR(0)="L^0:6"
- DO ^DIR
- IF Y'[","
- SET Y=""
- GOTO ASKQ
- +12 FOR I=1:1:$LENGTH(Y,",")
- IF $PIECE(Y,",",I)]""
- SET X($PIECE(Y,",",I))=""
- +13 SET (I,Y)=""
- FOR
- SET I=$ORDER(X(I))
- if I=""
- QUIT
- SET Y=Y_I
- ASKQ QUIT Y