| 1 | IBAUTL6 ;AAS/ALB-RX EXEMPTION UTILITY ROUTINE (CONT.);2-NOV-92
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**34,195**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ADDP ; -- Add patient to file 354
|
|---|
| 6 | ; -- Input : dfn = entry in patient file
|
|---|
| 7 | ; returns : ibadd = 0 if not added, 1 if added
|
|---|
| 8 | ;
|
|---|
| 9 | N DINUM,DLAYGO,X
|
|---|
| 10 | I '$D(DT) D DT^DICRW
|
|---|
| 11 | S IBWHER=11,IBEXERR=""
|
|---|
| 12 | S IBADD=0
|
|---|
| 13 | I $S('$D(DFN):1,'$D(^IBA(354)):1,$D(^IBA(354,DFN)):1,1:0) G ADDPQ
|
|---|
| 14 | K DO,DD,DIC,DR,DA,DIE S DIC="^IBA(354,",DIC(0)="L",DLAYGO=354
|
|---|
| 15 | L +^IBA(354,DFN):15 I $T,'$D(^IBA(354,DFN)) S (DINUM,X)=DFN D FILE^DICN I +Y>0 S IBADD=1
|
|---|
| 16 | I IBADD'=1 S IBEXERR=9
|
|---|
| 17 | L -^IBA(354,DFN)
|
|---|
| 18 | ;
|
|---|
| 19 | ADDPQ K DO,DD,DIC,DR,DIE,DA
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ADDEX(IBEXREA,IBDT,IBHOW,IBTYPE,IBOLDAUT) ; -- add entry to 354.1 and update
|
|---|
| 23 | ; -- this will become the active entry for this effective date
|
|---|
| 24 | ; other entries for this effective date should be cancelled
|
|---|
| 25 | ; prior to making this call
|
|---|
| 26 | ;
|
|---|
| 27 | ; -- input dfn = pt ien (required)
|
|---|
| 28 | ; ibexrea = pointer to exemption reason file (required)
|
|---|
| 29 | ; ibdt = internal form of effective date (required)
|
|---|
| 30 | ; ibhow = 1=system added, 2=user override (optional) default =1
|
|---|
| 31 | ; ibtype = type of exemption (optional) default =1 (copay)
|
|---|
| 32 | ; iboldaut = date (optional) if defined is the date of a previous exemption status (automatic) that needs to be inactivated
|
|---|
| 33 | ;
|
|---|
| 34 | ; -- returns ibadde = ibexrea^ibdt or null if not added
|
|---|
| 35 | ; iberr = error if occurs else null
|
|---|
| 36 | ;
|
|---|
| 37 | L +^IBA(354,DFN):30 I '$T S IBEXERR=1 W:$D(IBTALK)&('$D(ZTQUEUED)) !,"ENTRY LOCKED" G ADDEXQ
|
|---|
| 38 | A1 I '$D(^IBA(354,DFN,0)) D ADDP G ADDEXQ:$G(IBEXERR)
|
|---|
| 39 | ;
|
|---|
| 40 | N IBDGMTA,IBDGMTP,IBDGMTF
|
|---|
| 41 | I $D(DGMTA) S IBDGMTA=$G(DGMTA),IBDGMTP=$G(DGMTP),IBDGMTF=$G(DGMTINF)
|
|---|
| 42 | N X,X1,X2,Y,IBCNT,DGMTA,DGMTP,DGMTINF
|
|---|
| 43 | I $D(IBDGMTA) S DGMTA=$G(IBDGMTA),DGMTP=$G(IBDGMTP),DGMTINF=$G(IBDGMTF)
|
|---|
| 44 | S IBWHER=12,IBEXERR="",IBADDE=""
|
|---|
| 45 | ;
|
|---|
| 46 | ; - one last quick check
|
|---|
| 47 | I IBDT'?7N S IBEXERR=3 G ADDEXQ
|
|---|
| 48 | I DUZ,$G(^VA(200,+DUZ,0))="" S IBEXERR=8 G ADDEXQ
|
|---|
| 49 | ; if DUZ=0, it will be considered as .5 (POSTMASTER) by the input template [IB NEW EXEMPTION]
|
|---|
| 50 | ;
|
|---|
| 51 | D BEFORE^IBARXEVT ;get prior exemption
|
|---|
| 52 | ;
|
|---|
| 53 | N IBSTAT,IBEXDA
|
|---|
| 54 | S IBSTAT=$P($G(^IBE(354.2,+IBEXREA,0)),"^",4)
|
|---|
| 55 | S IBHOW=$S('$D(IBHOW):1,IBHOW="":1,IBHOW>2:1,IBHOW<1:1,1:IBHOW)
|
|---|
| 56 | S IBTYPE=$S('$D(IBTYPE):1,IBTYPE="":1,1:IBTYPE)
|
|---|
| 57 | ;I '$D(IBACTION) S IBACTION="ADD"
|
|---|
| 58 | ;
|
|---|
| 59 | ; -- inactivate a current autoexempt of no longer autoexempt
|
|---|
| 60 | I $G(IBOLDAUT)?7N D INACT^IBAUTL7(IBOLDAUT) ;I '$D(ZTQUEUED),$D(IBTALK) W !,"Inactivating current non-income based exemption for patient"
|
|---|
| 61 | ;
|
|---|
| 62 | ; -- if forcing a new entry to correct problems
|
|---|
| 63 | I $G(IBFORCE)?7N D INACT^IBAUTL7(IBFORCE)
|
|---|
| 64 | ;
|
|---|
| 65 | ; -- check for duplicate entry
|
|---|
| 66 | I $G(IBOLDAUT)'?7N,$G(IBFORCE)'?7N,$$DUPL() W:'$D(ZTQUEUED)&($D(IBTALK)) !,"Exemption Attempting to Add is a duplicate, nothing added!",! G ADDEXQ
|
|---|
| 67 | ;
|
|---|
| 68 | ; -- inactivate previous active entries
|
|---|
| 69 | D INACT^IBAUTL7(IBDT) I $G(IBEXERR) G ADDEXQ
|
|---|
| 70 | ;
|
|---|
| 71 | ; -- if no income data from conversion set date = start date
|
|---|
| 72 | I $D(IBCONVER),$P($G(^IBE(354.2,+IBEXREA,0)),"^",5)=210 S IBDT=$$STDATE^IBARXEU
|
|---|
| 73 | ;
|
|---|
| 74 | ; -- add entry
|
|---|
| 75 | S DIC="^IBA(354.1,",DIC(0)="L",X=IBDT K DO,DD D FILE^DICN
|
|---|
| 76 | S (IBEXDA,DA)=+Y I Y<1 W:'$D(ZTQUEUED)&($D(IBTALK)) !,"Can't add entry to exemption file" S IBEXERR=4 G ADDEXQ
|
|---|
| 77 | ;
|
|---|
| 78 | ; -- edit new entry
|
|---|
| 79 | S DIE="^IBA(354.1,",DR="[IB NEW EXEMPTION]" ; use compiled template
|
|---|
| 80 | ;
|
|---|
| 81 | ;DR=".02////"_DFN_";.03////"_IBTYPE_";.04////"_IBSTAT_";.05////"_IBEXREA_";.06////"_IBHOW_";.07////"_DUZ_";.08///NOW;.1////1;.11////"_$G(IBASIG)
|
|---|
| 82 | ;
|
|---|
| 83 | D ^DIE K DIC,DIE,DA,DR
|
|---|
| 84 | I $D(Y) S IBEXERR=5 G ADDEXQ
|
|---|
| 85 | S IBADDE=IBEXREA_"^"_IBDT
|
|---|
| 86 | ;
|
|---|
| 87 | ; --if effective date is in last 365 days make current
|
|---|
| 88 | I IBDT>$$MINUS^IBARXEU0(DT) D CURREX^IBAUTL7(IBSTAT,IBDT) I $G(IBEXERR) G ADDEXQ
|
|---|
| 89 | ;
|
|---|
| 90 | I '$D(ZTQUEUED),$G(IBADDE),$D(IBTALK) W !!,"Medication Copayment Exemption Status Updated: ",$P(^IBE(354.2,+IBADDE,0),"^")," ",$$DAT1^IBOUTL($P(IBADDE,"^",2))
|
|---|
| 91 | ; -- setup and call event driver
|
|---|
| 92 | I '$D(IBCONVER) D ;if not from conversion do following
|
|---|
| 93 | .D AFTER^IBARXEVT
|
|---|
| 94 | .S IBEVT=$$RXST^IBARXEU(DFN,$S(IBDT<$$STDATE^IBARXEU:$$STDATE^IBARXEU,1:IBDT))
|
|---|
| 95 | .D ^IBARXEVT
|
|---|
| 96 | .I IBSTAT D CANCEL^IBARXEU3 ;exempt patient cancel old charges
|
|---|
| 97 | .D ^IBARXEB ; process bulletins and alerts
|
|---|
| 98 | ;
|
|---|
| 99 | ADDEXQ ;
|
|---|
| 100 | L -^IBA(354,DFN)
|
|---|
| 101 | I $G(IBEXERR) D ^IBAERR
|
|---|
| 102 | K DO,DD,DIC,DIE,DA,DR,IBEVT,IBEVTP,IBEVTA,IBASIG,IBARCAN
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | DUPL() ; -- see if entry is a duplicate
|
|---|
| 106 | N X,Y
|
|---|
| 107 | S X=0
|
|---|
| 108 | S Y=$$LST^IBARXEU0(DFN,IBDT)
|
|---|
| 109 | I IBDT=+Y,+IBEXREA=+$P(Y,"^",5),IBTYPE=$P(Y,"^",3) S X=1
|
|---|
| 110 | Q X
|
|---|
