| 1 | IBCSC4E ;ALB/ARH - ADD/ENTER PTF/OE DIAGNOSIS ;3/2/94
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**8,106,121,124,210,266**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | DXINPT(IBIFN) ; display and ask user to select PTF diagnosis
|
|---|
| 6 | N IBLIST,IBPTFDX
|
|---|
| 7 | D PTFDSP(IBIFN),PTFASK I $D(IBLIST) D PTFADD(IBIFN,IBLIST)
|
|---|
| 8 | K ^TMP($J,"IBDX")
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | PTFASK ;
|
|---|
| 12 | D PTF Q:$G(IBPTFDX)'>0 N X,Y,DIR,DIRUT K IBLIST W !
|
|---|
| 13 | PTFASK1 S DIR("A")="SELECT DIAGNOSIS FROM THE PTF RECORD TO INCLUDE ON THE BILL"
|
|---|
| 14 | S DIR("?",1)="Enter the alphanumeric preceding the diagnosis you want added to the bill.",DIR("?",2)=""
|
|---|
| 15 | S DIR("?",3)="To enter more than one separate them by a comma or within a movement use a"
|
|---|
| 16 | S DIR("?",4)="range separated by a dash. * indicates the diagnosis is already on the bill."
|
|---|
| 17 | S DIR("?")="The print order for each diagnosis will be determined by the order in this list."
|
|---|
| 18 | S DIR(0)="FO^^D ITPTF^IBCSC4E" D ^DIR K DIR Q:$D(DIRUT)!(Y="")
|
|---|
| 19 | ;
|
|---|
| 20 | S X=Y D ITPTF S IBLIST=X,DIR("A",1)="YOU HAVE SELECTED "_X_" TO BE ADDED TO THE BILL",DIR("A")="IS THIS CORRECT",DIR("B")="YES"
|
|---|
| 21 | S DIR(0)="YO" D ^DIR K DIR I $D(DIRUT) K IBLIST Q
|
|---|
| 22 | I 'Y K IBLIST G PTFASK1
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | PTF ;
|
|---|
| 26 | Q:'$D(^TMP($J,"IBDX","S")) N IBX,IBY,IBZ,IBORD,IBNUM K IBPTFDX S IBORD="",IBPTFDX=0
|
|---|
| 27 | S IBX="" F S IBX=$O(^TMP($J,"IBDX","S",IBX)) Q:IBX="" D
|
|---|
| 28 | . S IBZ=+$G(^TMP($J,"IBDX","S",IBX)) Q:'IBZ
|
|---|
| 29 | . S IBORD=$E(IBX) Q:IBORD'?1A S IBNUM=+$E(IBX,2,999) Q:IBNUM'>0
|
|---|
| 30 | . I IBNUM>$G(IBPTFDX(IBORD)) S IBPTFDX(IBORD)=IBNUM
|
|---|
| 31 | . I '$D(^IBA(362.3,"AIFN"_+$G(IBIFN),+IBZ)) S IBPTFDX=IBPTFDX+1
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | ITPTF ;
|
|---|
| 35 | N IBI,IB1,IB2,IB3,IBJ,IBX,IBY,IBZ,IBA
|
|---|
| 36 | S IBA="",IBX=X
|
|---|
| 37 | F IBI=1:1 S IBY=$P(IBX,",",IBI) Q:IBY="" D Q:'$D(X) S X=IBA
|
|---|
| 38 | . I IBY["-" S IBZ=$P(IBY,"-",1),IB2=$P(IBY,"-",2) D Q:'$D(X)
|
|---|
| 39 | .. I $E(IBZ,1)'=$E(IB2,1) K X Q
|
|---|
| 40 | .. S IBY="",IB1=$E(IBZ,2,999),IB2=$E(IB2,2,999),IBZ=$E(IBZ,1) I +IB2'>+IB1 K X Q
|
|---|
| 41 | .. F IBJ=IB1:1:IB2 S IBY=IBY_IBZ_IBJ_"-" I IBJ>$G(IBPTFDX(IBZ)) Q
|
|---|
| 42 | . F IBJ=1:1 S IB1=$P(IBY,"-",IBJ) Q:IB1="" S IB2=$E(IB1,1),IB3=$E(IB1,2,99) D Q:'$D(X)
|
|---|
| 43 | .. I IB1'?1U1.3N K X Q
|
|---|
| 44 | .. I IB2=""!'IB3 K X Q
|
|---|
| 45 | .. I '$D(IBPTFDX(IB2)) K X Q
|
|---|
| 46 | .. I IB3>+$G(IBPTFDX(IB2)) K X Q
|
|---|
| 47 | .. S IBA=IBA_IB2_IB3_","
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | PTFADD(IBIFN,LIST) ;
|
|---|
| 51 | Q:'$D(^TMP($J,"IBDX","S"))!($G(LIST)="")!('$G(IBIFN)) N IBX,IBY,IBI,IBCD,IBDX
|
|---|
| 52 | F IBI=1:1 S IBCD=$P(LIST,",",IBI) Q:IBCD="" D
|
|---|
| 53 | . S IBDX=+$G(^TMP($J,"IBDX","S",IBCD)) Q:'IBDX
|
|---|
| 54 | . I ($$ICD9^IBACSV(+IBDX)'=""),'$D(^IBA(362.3,"AIFN"_IBIFN,+IBDX)) I $$ADD^IBCSC4D(+IBDX,IBIFN) W "."
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | PTFDSP(IBIFN) ; display PTF diagnosis within date range of the bill
|
|---|
| 58 | ; Output: ^TMP($J,"IBDX") as defined by PTFDXDT^IBCSC4F and
|
|---|
| 59 | ; ^TMP($J,"IBDX","S",x) = DIAGNOSIS w/x=selection identifer for a dx
|
|---|
| 60 | N IB0,IBPTF,IBTF,IBU,IBFDT,IBTDT,IBDSCH,IBW,IBC,IBA,IBN,IBCNT,IBMCNT,IBMDT,IBMV,IBDT,IBLN,IBLABEL,IBDXCNT,IBI
|
|---|
| 61 | N IBDX,IBID,IBON,IBY,IBMDRG,X,IBDATE
|
|---|
| 62 | ;
|
|---|
| 63 | K ^TMP($J,"IBDX") S IBW=41
|
|---|
| 64 | ;
|
|---|
| 65 | S IBDATE=$$BDATE^IBACSV(IBIFN) ; The Event Date of the bill
|
|---|
| 66 | S IB0=$G(^DGCR(399,+$G(IBIFN),0)),IBPTF=$P(IB0,U,8),IBTF=$P(IB0,U,6) Q:'$G(IBPTF)
|
|---|
| 67 | S IBU=$G(^DGCR(399,+IBIFN,"U")),IBFDT=+IBU,IBTDT=$P(IBU,U,2) Q:$P(IB0,U,5)>2
|
|---|
| 68 | ;
|
|---|
| 69 | D PTFDXDT^IBCSC4F(IBPTF,IBFDT,IBTDT,IBTF) S IBDSCH=$P(+$P($G(^TMP($J,"IBDX","M")),U,3),".")
|
|---|
| 70 | ;
|
|---|
| 71 | F IBN="M","D" S (IBCNT,IBMCNT,IBMDT)="" F S IBMDT=$O(^TMP($J,"IBDX",IBN,IBMDT)) Q:'IBMDT S IBMCNT=IBMCNT+1 D
|
|---|
| 72 | . S IBMV=$G(^TMP($J,"IBDX",IBN,IBMDT)),IBDT=+IBMV,IBMDRG=$P(IBMV,U,4)
|
|---|
| 73 | . I IBN="M" S IBC=0,IBLABEL="Move",IBA=$C(64+IBMCNT) I 'IBDT S IBDT="D/C"
|
|---|
| 74 | . I IBN="D" S IBC=41,IBLABEL="Discharge",IBA="X" I 'IBDT S IBDT="NOT DISCHARGED"
|
|---|
| 75 | . ;
|
|---|
| 76 | . S IBLN=IBLABEL_": "_$S(+IBDT:$P($$FMTE^XLFDT(+IBDT,2),"@",1),1:IBDT)
|
|---|
| 77 | . S IBLN=IBLN_" "_$E($P($G(^DIC(42.4,+$P(IBMV,U,2),0)),U,1),1,12)
|
|---|
| 78 | . S IBLN=IBLN_" "_$J("",(29-$L(IBLN)))_$S(+$P(IBMV,U,3):"<SC>",1:"<NSC>")
|
|---|
| 79 | . ;
|
|---|
| 80 | . S IBCNT=IBCNT+1,X(IBCNT)=$G(X(IBCNT))_$J("",IBW)
|
|---|
| 81 | . S IBCNT=IBCNT+1,X(IBCNT)=$G(X(IBCNT))_$J("",IBW),X(IBCNT)=$E(X(IBCNT),1,IBC)_IBLN
|
|---|
| 82 | . ;
|
|---|
| 83 | . I '$O(^TMP($J,"IBDX",IBN,IBMDT,"")) S IBCNT=IBCNT+1,X(IBCNT)=$G(X(IBCNT))_$J("",IBW),X(IBCNT)=$E(X(IBCNT),1,IBC)_" No DX Codes Entered For "_IBLABEL
|
|---|
| 84 | . ;
|
|---|
| 85 | . S (IBDXCNT,IBI)="" F S IBI=$O(^TMP($J,"IBDX",IBN,IBMDT,IBI)) Q:'IBI D
|
|---|
| 86 | .. S IBDX=^TMP($J,"IBDX",IBN,IBMDT,IBI),IBY=$$ICD9^IBACSV(+IBDX,IBDATE)
|
|---|
| 87 | .. S IBDXCNT=IBDXCNT+1,IBID=IBA_IBDXCNT,IBON=$S($O(^IBA(362.3,"AIFN"_IBIFN,+IBDX,"")):"*",1:" ")
|
|---|
| 88 | .. ;
|
|---|
| 89 | .. S IBLN=" "_IBON_IBID_" - "_$P(IBY,U,1)_$J("",(7-$L($P(IBY,U,1))))_$E($P(IBY,U,3),1,23)
|
|---|
| 90 | .. S IBCNT=IBCNT+1,X(IBCNT)=$G(X(IBCNT))_$J("",IBW),X(IBCNT)=$E(X(IBCNT),1,IBC)_IBLN
|
|---|
| 91 | .. S ^TMP($J,"IBDX","S",IBID)=IBDX
|
|---|
| 92 | . ;
|
|---|
| 93 | . I 'IBMDRG,IBN="M" S IBLN=" *** No DRG for Charges ***",IBCNT=IBCNT+1,X(IBCNT)=$G(X(IBCNT))_$J("",IBW),X(IBCNT)=$E(X(IBCNT),1,IBC)_IBLN
|
|---|
| 94 | . I IBMDRG S IBLN=$P($$DRG^IBACSV(+IBMDRG,IBDATE),U,1)_" - "_$E($$DRGTD^IBACSV(+IBMDRG,IBDATE),1,30),IBCNT=IBCNT+1,X(IBCNT)=$G(X(IBCNT))_$J("",IBW),X(IBCNT)=$E(X(IBCNT),1,IBC)_IBLN
|
|---|
| 95 | ;
|
|---|
| 96 | I IBDSCH,IBTDT<IBDSCH S IBCNT=2,X(IBCNT)=$G(X(IBCNT))_$J("",IBW),X(IBCNT)=$E(X(IBCNT),1,IBW)_"Discharge: "_$$FMTE^XLFDT(+$P(IBDSCH,"."),2)_" Not In Bill Range"
|
|---|
| 97 | I 'IBDSCH,IBTDT<DT S IBCNT=2,X(IBCNT)=$G(X(IBCNT))_$J("",IBW),X(IBCNT)=$E(X(IBCNT),1,IBW)_"Discharge: NOT DISCHARGED"
|
|---|
| 98 | ;
|
|---|
| 99 | W @IOF,"=============================== Diagnosis Screen ==============================="
|
|---|
| 100 | S IBI="" F S IBI=$O(X(IBI)) Q:'IBI W !,$E(X(IBI),1,80)
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | DELALL(IBIFN) ; ask/delete all diagnosis on a bill, including all CPT associated Diagnosis
|
|---|
| 104 | Q:'$O(^IBA(362.3,"AIFN"_+$G(IBIFN),0))
|
|---|
| 105 | ;
|
|---|
| 106 | N DIR,DIRUT,DUOUT,DTOUT,X,Y,DIK W !
|
|---|
| 107 | S DIR("?")="Enter Yes to delete all Diagnosis currently defined for a bill, including any CPT Associated Diagnosis.",DIR("??")="^D DISP1^IBCSC4D("_IBIFN_")"
|
|---|
| 108 | S DIR("A")="DELETE ALL DIAGNOSIS ON BILL, INCLUDING CPT ASSOCIATED DIAGNOSIS"
|
|---|
| 109 | S DIR(0)="YO",DIR("B")="NO" D ^DIR K DIR Q:Y'=1
|
|---|
| 110 | ;
|
|---|
| 111 | N IBPROC,IBPROCD,IBXRF,IBDX,IBDXI,DIE,DIC,DA,DR
|
|---|
| 112 | S IBPROC=0 F S IBPROC=$O(^DGCR(399,IBIFN,"CP",IBPROC)) Q:'IBPROC D
|
|---|
| 113 | . S IBPROCD=$G(^DGCR(399,IBIFN,"CP",IBPROC,0)) I "^^^"[$P(IBPROCD,U,11,14) Q
|
|---|
| 114 | . S DIE="^DGCR(399,"_IBIFN_",""CP"",",DA=IBPROC,DA(1)=IBIFN,DR="10///@;11///@;12///@;13///@" D ^DIE K DA,DIE,DR
|
|---|
| 115 | ;
|
|---|
| 116 | S IBXRF="AIFN"_+IBIFN
|
|---|
| 117 | S IBDX=0 F S IBDX=$O(^IBA(362.3,IBXRF,IBDX)) Q:'IBDX D
|
|---|
| 118 | . S IBDXI=0 F S IBDXI=$O(^IBA(362.3,IBXRF,IBDX,IBDXI)) Q:'IBDXI D
|
|---|
| 119 | .. S DIK="^IBA(362.3,",DA=IBDXI D ^DIK K DIK,DA
|
|---|
| 120 | W " .... deleted"
|
|---|
| 121 | Q
|
|---|
