| [613] | 1 | IBCSC4D ;ALB/ARH - ADD/ENTER DIAGNOSIS ;11/9/93
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**55,62,91,106,124,51,210**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;add/edit diagnosis for a bill, IBIFN required
|
|---|
| 6 | N IBINP
|
|---|
| 7 | S IBX=$G(^DGCR(399,+IBIFN,0))
|
|---|
| 8 | S IBINP=$$INPAT^IBCEF(+IBIFN)
|
|---|
| 9 | D DELALL^IBCSC4E(+IBIFN)
|
|---|
| 10 | I IBINP D DXINPT^IBCSC4E(IBIFN)
|
|---|
| 11 | I 'IBINP D DXOPT(IBIFN)
|
|---|
| 12 | S IBDIFN=0 D SET(IBIFN,.IBDXA,.IBPOA) D:+IBDXA DISP(.IBPOA)
|
|---|
| 13 | E1 S IBDX=$$ASKDX I +IBDX>0 S IBDIFN=+$G(IBDXA(+IBDX)) S:'IBDIFN IBDIFN=$$ADD(+IBDX,IBIFN) I +IBDIFN>0 D EDIT(+IBDIFN) D SET(IBIFN,.IBDXA,.IBPOA) G E1
|
|---|
| 14 | ;
|
|---|
| 15 | S IBX=$G(^DGCR(399,+IBIFN,0)) I $P(IBX,U,5)<3,$P(IBX,U,27)'=2 S DGRVRCAL=1
|
|---|
| 16 | EXIT K IBDIFN,IBDXA,IBPOA,IBDX,IBX
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | ASKDX() ;
|
|---|
| 20 | N X,Y,IBDATE,IBDTTX
|
|---|
| 21 | ;S DIR("A")="Select ICD DIAGNOSIS",DIR(0)="362.3,.01O" D ^DIR K DIR
|
|---|
| 22 | S IBDATE=$$BDATE^IBACSV(IBIFN)
|
|---|
| 23 | S IBDTTX=$$DAT1^IBOUTL(IBDATE)
|
|---|
| 24 | I $G(IBIFN),$$INPAT^IBCEF(IBIFN,1) D
|
|---|
| 25 | . N Z S Z=$$EXPAND^IBTRE(399,215,+$G(^DGCR(399,IBIFN,"U2")))
|
|---|
| 26 | . W !,$S(Z'="":"",1:"NO ")_"Admitting Diagnosis"_$S(Z'="":": "_Z,1:" found"),!
|
|---|
| 27 | AD S DIR("??")="^D HELP^IBCSC4D"
|
|---|
| 28 | S DIR("?",1)="Enter a diagnosis for this bill. Duplicates are not allowed. Only codes active on "_IBDTTX_"."
|
|---|
| 29 | S DIR("?")="Only diagnosis codes active on "_IBDTTX_", no duplicates for a bill, and bill must not be authorized or cancelled."
|
|---|
| 30 | S DIR(0)="PO^80:EAMQ"
|
|---|
| 31 | D ^DIR K DIR
|
|---|
| 32 | I Y>0,'$D(IBDXA(+Y)),'$$ICD9ACT^IBACSV(+Y,IBDATE) D G AD
|
|---|
| 33 | . W !!,*7,"The Diagnosis code is inactive for the date of service ("_IBDTTX_").",!
|
|---|
| 34 | Q Y
|
|---|
| 35 | ;
|
|---|
| 36 | ADD(DX,IFN) ;
|
|---|
| 37 | S DIC="^IBA(362.3,",DIC(0)="AQL",DIC("DR")=".02////"_IFN,X=DX K DA,DO D FILE^DICN K DA,DO,DIC,X
|
|---|
| 38 | Q Y
|
|---|
| 39 | ;
|
|---|
| 40 | EDIT(IBDXIFN) ;
|
|---|
| 41 | S DIDEL=362.3,DIE="^IBA(362.3,",DR=".01;.03",DA=IBDXIFN D ^DIE K DIE,DR,DA,DIC,DIDEL
|
|---|
| 42 | ;
|
|---|
| 43 | I $D(^IBA(362.3,IBDXIFN,0)),$$FIRSTDX(IBDXIFN) D G EDITQ
|
|---|
| 44 | . N DIE,DR,DA,Y,X,IB0
|
|---|
| 45 | . S IB0=^IBA(362.3,IBDXIFN,0)
|
|---|
| 46 | . S DIE="^DGCR(399,",DA=+$P(IB0,U,2),DR="215////"_+IB0 D ^DIE
|
|---|
| 47 | ;
|
|---|
| 48 | ; - if the entry was deleted, remove dangling pointers from #399.0304
|
|---|
| 49 | N IBPROC,IBPROCD,IBPIECE,IBHIT
|
|---|
| 50 | S (IBHIT,IBPROC)=0
|
|---|
| 51 | F S IBPROC=$O(^DGCR(399,IBIFN,"CP",IBPROC)) Q:'IBPROC S IBPROCD=$G(^(IBPROC,0)) I IBPROCD]"" D
|
|---|
| 52 | .F IBPIECE=11:1:14 I +$P(IBPROCD,"^",IBPIECE)=IBDXIFN S IBHIT=1 D UPD^IBCU72("@",IBPIECE-1)
|
|---|
| 53 | I IBHIT W *7,!,"This diagnosis was removed as a procedure diagnosis."
|
|---|
| 54 | EDITQ Q
|
|---|
| 55 | ;
|
|---|
| 56 | SET(IFN,DXARR,POARR) ;setup arrays of all dx's for bill, array names should be passed by reference
|
|---|
| 57 | ;returns: DXARR(DX)=DX IFN, POARR(ORDER)=DX ^ PRINT ORDER, (DXARR,POARR)=IFN ^ dx count
|
|---|
| 58 | ;if a dx does not have a print order then PRINT ORDER=(999+count of dx) so will be in order of entry if no print order
|
|---|
| 59 | N CNT,IBX,IBY,IBZ,DIFN,IBC,ARR K DXARR,POARR S IBC="AIFN"_$G(IFN)
|
|---|
| 60 | S (CNT,IBX)=0 F S IBX=$O(^IBA(362.3,IBC,IBX)) Q:'IBX D
|
|---|
| 61 | . S DIFN=$O(^IBA(362.3,IBC,IBX,0)),IBY=$G(^IBA(362.3,DIFN,0)) Q:'IBY
|
|---|
| 62 | . S CNT=CNT+1,IBZ=+$P(IBY,U,3) I 'IBZ S IBZ=999+CNT
|
|---|
| 63 | . S DXARR(+IBY)=DIFN,ARR(IBZ)=+IBY_"^"_$P(IBY,U,3)
|
|---|
| 64 | S (IBX,IBY)=0 F S IBY=$O(ARR(IBY)) Q:'IBY S IBX=IBX+1,POARR(IBX)=ARR(IBY)
|
|---|
| 65 | S (DXARR,POARR)=$G(IFN)_"^"_CNT
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | DISP(POARR) ;screen display of existing dx's for a bill,
|
|---|
| 69 | ;input should be print order array returned by SET^IBCSC4D: POARR(PRINT ORDER)=DX, passed by reference
|
|---|
| 70 | N IBX,IBY,IBZ,IBDATE
|
|---|
| 71 | S IBDATE=$$BDATE^IBACSV(+$G(IBIFN)) ; The bill date of service
|
|---|
| 72 | W !!,?5,"----------------- Existing Diagnoses for Bill -----------------",!
|
|---|
| 73 | S IBX=0 F S IBX=$O(POARR(IBX)) Q:'IBX S IBZ=POARR(IBX),IBY=$$ICD9^IBACSV(+IBZ,IBDATE) D
|
|---|
| 74 | . W !,?12,$P(IBY,U),?26,$P(IBY,U,3),?60,$S($P(IBZ,U,2)<1000:"("_$P(IBZ,U,2)_")",1:"")
|
|---|
| 75 | W !
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | DISP1(IFN) ;
|
|---|
| 79 | I +$G(IFN) N POARR D SET(IFN,"",.POARR),DISP(.POARR)
|
|---|
| 80 | Q
|
|---|
| 81 | HELP ;called for help from dx enter to display existing dx's
|
|---|
| 82 | Q:'$G(IBIFN) N IBX
|
|---|
| 83 | D SET(IBIFN,.IBDXA,"") S IBX=$G(^DGCR(399,+IBIFN,0)) I IBX="" Q
|
|---|
| 84 | I $P(IBX,U,5)>2 S DFN=$P(IBX,U,2),IBX=$G(^DGCR(399,+IBIFN,"U")) D OPTDX(DFN,$P(IBX,U,1),$P(IBX,U,2),.IBOEDX,.IBDXA),DISPOE(.IBOEDX,.IBDXA)
|
|---|
| 85 | D SET(IBIFN,.IBDXA,.IBPOA) D:+IBDXA DISP(.IBPOA)
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | ADD1(IFN) ;does not work, but it should replace ask add, and edit
|
|---|
| 89 | ;S DIC="^IBA(362.3,",DIC(0)="EMAQ",D="AIFN"_$G(IFN) D IX^DIC K DA,DO,DIC,D
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | ; ******************************************************************************************
|
|---|
| 93 | ;
|
|---|
| 94 | DXOPT(IBIFN) ; display and ask user to select PCE diagnosis
|
|---|
| 95 | N IBDXA,IBOEDX,IBLIST,DFN,IBX
|
|---|
| 96 | D SET(IBIFN,.IBDXA,"")
|
|---|
| 97 | S DFN=$P($G(^DGCR(399,+IBIFN,0)),U,2),IBX=$G(^DGCR(399,+IBIFN,"U"))
|
|---|
| 98 | D OPTDX(DFN,$P(IBX,U,1),$P(IBX,U,2),.IBOEDX,.IBDXA),DISPOE(.IBOEDX,.IBDXA)
|
|---|
| 99 | I +$P($G(IBOEDX),U,2) D NEWDX(+IBOEDX) I $D(IBLIST) D ADDNEW(IBIFN,IBLIST,.IBOEDX)
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | OPTDX(DFN,DT1,DT2,ARRAY,IBDXE) ; get diagnosis from PCE for encounters within date range
|
|---|
| 103 | ; ARRAY(X)= DX ^ ORDER ^ OUTPATIENT ENCOUNTER (409.68) ^ DATE/TIME ^ TRUE IF NON-BILL ^ NON-BILL MESS ^ CLINIC
|
|---|
| 104 | N IBDT,IBOE,IBDX,IBDXN,IBDXA,IBDXB,IBCNT,IBCNT1,ARR,IBI,IBJ,IBK,IBVAL,IBCBK
|
|---|
| 105 | K ARRAY
|
|---|
| 106 | S (IBCNT,IBCNT1)=0,DT1=$G(DT1)-.0001,DT2=$S(+$G(DT2):DT2,1:9999999)+.7999
|
|---|
| 107 | ;
|
|---|
| 108 | S IBVAL("DFN")=DFN,IBVAL("BDT")=DT1,IBVAL("EDT")=DT2
|
|---|
| 109 | S IBCBK="D OEDX^IBCU81(Y,.IBDXA,.IBDXB)"
|
|---|
| 110 | D SCAN^IBSDU("PATIENT/DATE",.IBVAL,"",IBCBK,1) K ^TMP("DIERR",$J)
|
|---|
| 111 | ;
|
|---|
| 112 | S (IBCNT,IBCNT1,IBI)=0 F S IBI=$O(IBDXA(IBI)) Q:'IBI D
|
|---|
| 113 | . S IBJ=0 F S IBJ=$O(IBDXA(IBI,IBJ)) Q:'IBJ D
|
|---|
| 114 | .. S IBK=0 F S IBK=$O(IBDXA(IBI,IBJ,IBK)) Q:'IBK D
|
|---|
| 115 | ... S IBDXN=0 F S IBDXN=$O(IBDXA(IBI,IBJ,IBK,IBDXN)) Q:'IBDXN D
|
|---|
| 116 | .... S IBDX=IBDXA(IBI,IBJ,IBK,IBDXN) I $D(ARR(+IBDX))!(+$P(IBDX,U,5)&(+$G(IBDXB(+IBDX)))) Q
|
|---|
| 117 | .... S IBCNT=IBCNT+1 I '$D(IBDXE(+IBDX)) S IBCNT1=IBCNT1+1
|
|---|
| 118 | .... S ARRAY(IBCNT)=IBDX S ARR(+IBDX)=""
|
|---|
| 119 | S ARRAY=IBCNT_"^"_IBCNT1 K IBDXA,IBDXB,ARR
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | NEWDX(IBX) ; user select PCE diagnosis to add to bill
|
|---|
| 123 | Q:'$G(IBX) N X,Y,DIR,DIRUT K IBLIST W !
|
|---|
| 124 | NEWDX1 S DIR("?",1)="Enter the number preceding the Diagnosis you want added to the bill.",DIR("?",2)="Multiple entries may be added separated by commas or ranges separated by a dash."
|
|---|
| 125 | S DIR("?")="The diagnosis will be added to the bill with a print order corresponding to its position in this list."
|
|---|
| 126 | S DIR("A")="SELECT NEW DIAGNOSES TO ADD THE BILL"
|
|---|
| 127 | S DIR(0)="LO^1:"_+IBX D ^DIR K DIR G:'Y!$D(DIRUT) NEWDXE
|
|---|
| 128 | S IBLIST=Y
|
|---|
| 129 | ;
|
|---|
| 130 | S DIR("A")="YOU HAVE SELECTED "_IBLIST_" TO BE ADDED TO THE BILL IS THIS CORRECT",DIR("B")="YES"
|
|---|
| 131 | S DIR(0)="YO" D ^DIR K DIR I $D(DIRUT) K IBLIST G NEWDXE
|
|---|
| 132 | I 'Y G NEWDX1
|
|---|
| 133 | NEWDXE Q
|
|---|
| 134 | ;
|
|---|
| 135 | ADDNEW(IBIFN,LIST,IBOEA) ; add selected PCE diagnosis to bill
|
|---|
| 136 | Q:'LIST N IBI,IBX,IBDX,IBDT,IBQ,IBY,IBPIFN,IBZ
|
|---|
| 137 | F IBI=1:1 S IBX=$P(LIST,",",IBI) Q:'IBX I $D(IBOEA(IBX)) D
|
|---|
| 138 | . S IBDX=+IBOEA(IBX) I $D(^IBA(362.3,"AIFN"_IBIFN,IBDX)) Q
|
|---|
| 139 | . I $$ADD(IBDX,IBIFN) W "."
|
|---|
| 140 | Q
|
|---|
| 141 | ;
|
|---|
| 142 | DISPOE(OEARR,EXARR) ; display outpatient PCE diagnosis
|
|---|
| 143 | N IBCNT,IBDX,IBX,IBY,IBDATE
|
|---|
| 144 | W @IOF,!,"============================= DIAGNOSIS SCREEN ==============================",!
|
|---|
| 145 | S IBDATE=$$BDATE^IBACSV(+$G(IBIFN)) ; The bills date of service
|
|---|
| 146 | S IBCNT=0 F S IBCNT=$O(OEARR(IBCNT)) Q:'IBCNT D
|
|---|
| 147 | . S IBY=OEARR(IBCNT),IBDX=$$ICD9^IBACSV(+IBY,IBDATE)
|
|---|
| 148 | . S IBX="" I $D(EXARR(+OEARR(IBCNT))) S IBX="*"
|
|---|
| 149 | . W !,$J(IBCNT,2),")",?5,IBX,?6,$P(IBDX,U),?14,$E($P(IBDX,U,3),1,19)
|
|---|
| 150 | . I +$P(IBY,U,7) W ?35,$E($P($G(^SC(+$P(IBY,U,7),0)),U,1),1,15)
|
|---|
| 151 | . I $P(IBY,U,2)'="" W ?52,$E($$EXPAND^IBTRE(9000010.07,.12,$P(IBY,U,2)),1,3)
|
|---|
| 152 | . I $P(IBY,U,4)'="" W ?57,$$FMTE^XLFDT($E($P(IBY,U,4),1,12),2)
|
|---|
| 153 | . I $P(IBY,U,6)'="" W ?72,$E($P(IBY,U,6),1,7)
|
|---|
| 154 | Q
|
|---|
| 155 | ;
|
|---|
| 156 | DISPID ; Display the Associated Dx and Rx # for a procedure in the identifier.
|
|---|
| 157 | ; Input: Naked reference to the 0th node of an entry in the
|
|---|
| 158 | ; Procedures (#304) sub-file of the Bill/Claims (#399) file.
|
|---|
| 159 | N I,X,IBY,Z
|
|---|
| 160 | S X=^(0),IBY=Y
|
|---|
| 161 | S I=$$PRCNM^IBCSCH1($P(X,U,1),$P(X,U,2)) W " ",$E($P(I,U,2)_$J("",27),1,27)
|
|---|
| 162 | S Z=$O(^DGCR(399,DA(1),"RC","ACP",+IBY,0))
|
|---|
| 163 | I Z S Z=$P($G(^DGCR(399,DA(1),"RC",Z,0)),U,11) W $E(" Rx: "_$S(Z:$P($G(^IBA(362.4,+Z,0)),U),1:"Missing")_$J("",14),1,14)
|
|---|
| 164 | I +$P(X,U,11) S I=+$G(^IBA(362.3,+$P(X,U,11),0)) W " Dx 1: ",$P($$ICD9^IBACSV(+I),U)
|
|---|
| 165 | Q
|
|---|
| 166 | FIRSTDX(DA) ; Called by trigger cross reference #2 on file 362.3,.03
|
|---|
| 167 | ; DA is the ien of the entry in file 362.3
|
|---|
| 168 | ; Check if the corresponding bill is for an inpatient episode, the
|
|---|
| 169 | ; admitting dx for the corresponding bill is null and the dx being
|
|---|
| 170 | ; entered is the first for the bill. If this is all true, admitting
|
|---|
| 171 | ; dx should be set to the dx.
|
|---|
| 172 | ;
|
|---|
| 173 | N OK,Z
|
|---|
| 174 | S Z=$G(^IBA(362.3,DA,0)),OK=0
|
|---|
| 175 | I $$INPAT^IBCEF(+$P(Z,U,2)),$P($G(^DGCR(399,+$P(Z,U,2),"U2")),U)="",'$O(^IBA(362.3,"AO",+$P(Z,U,2),+$P(Z,U,3)),-1) S OK=1
|
|---|
| 176 | Q OK
|
|---|
| 177 | ;
|
|---|
