| 1 | IBATLM1B ;LL/ELZ - TRANSFER PRICING TRANSACTION LIST MENU ; 15-SEP-1998
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**115,261**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | CF ; -- change facility from patient level
|
|---|
| 6 | D LMOPT^IBATUTL,CFP^IBATLM0A(DFN),HDR^IBATLM1
|
|---|
| 7 | Q
|
|---|
| 8 | CS ; -- change status of patient from patient level
|
|---|
| 9 | D LMOPT^IBATUTL,CSP^IBATLM0A(DFN),HDR^IBATLM1
|
|---|
| 10 | Q
|
|---|
| 11 | CT ; -- cancel a transaction
|
|---|
| 12 | N IBVAL,DIE,DA,DR,DTOUT,%
|
|---|
| 13 | D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
|
|---|
| 14 | S (DA,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
|
|---|
| 15 | S DA=$O(@VALMAR@("INDEX",IBVAL,DA))
|
|---|
| 16 | I $P(^IBAT(351.61,DA,0),U,5)="X" W !!,"Transaction already cancelled!" D H Q
|
|---|
| 17 | W !!,"Are you sure you want to cancel this transaction"
|
|---|
| 18 | S %=2 D YN^DICN Q:%'=1
|
|---|
| 19 | D CANC^IBATFILE(DA),ARRAY^IBATLM1A(VALMAR)
|
|---|
| 20 | Q
|
|---|
| 21 | CD ; -- change the current date range for transactions displayed
|
|---|
| 22 | N IBSAVE S IBSAVE=IBBDT_"^"_IBEDT
|
|---|
| 23 | D LMOPT^IBATUTL
|
|---|
| 24 | I $$SLDR^IBATUTL S IBBDT=$P(IBSAVE,"^"),IBEDT=$P(IBSAVE,"^",2)
|
|---|
| 25 | D ARRAY^IBATLM1A(VALMAR),HDR^IBATLM1
|
|---|
| 26 | Q
|
|---|
| 27 | CP ; -- change the currently selected patient
|
|---|
| 28 | N IBDFN
|
|---|
| 29 | D LMOPT^IBATUTL
|
|---|
| 30 | S IBDFN=$$SLPT^IBATUTL I 'IBDFN Q
|
|---|
| 31 | I $$SLDR^IBATUTL Q
|
|---|
| 32 | S DFN=IBDFN K ^TMP("VALM DATA",$J),^TMP("VALMAR",$J)
|
|---|
| 33 | D HDR^IBATLM1,ARRAY^IBATLM1A(VALMAR)
|
|---|
| 34 | Q
|
|---|
| 35 | AT ; -- add a transaction
|
|---|
| 36 | N X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 37 | D LMOPT^IBATUTL
|
|---|
| 38 | S DIR(0)="SMBA^I:Inpatient;O:Outpatient;P:Prescription;R:Prosthetic"
|
|---|
| 39 | S DIR("A")="Select type of Transaction to add: " D ^DIR Q:$D(DIRUT)
|
|---|
| 40 | D @Y K ^TMP("VALM DATA",$J),^TMP("VALMAR",$J)
|
|---|
| 41 | D HDR^IBATLM1,ARRAY^IBATLM1A(VALMAR)
|
|---|
| 42 | Q
|
|---|
| 43 | I ; -- select an inpatient stay and add
|
|---|
| 44 | N IBXA,IBADM,DIRUT,IBIEN,VAIP,IBCHARGE,IBPPF,IBRES
|
|---|
| 45 | S IBXA=7,IBADM=+$$ADSEL^IBECEA31(DFN) Q:IBADM<0
|
|---|
| 46 | I IBADM=0 W !!,"Patient has no admissions on file." D H Q
|
|---|
| 47 | D DUP(IBADM_";DGPM(",.DIRUT)
|
|---|
| 48 | I $D(DIRUT) D H Q
|
|---|
| 49 | S VAIP("E")=IBADM D IN5^VADPT S IBPPF=$$PPF^IBATUTL(DFN)
|
|---|
| 50 | S IBIEN=$$ADM^IBATFILE(DFN,+VAIP(13,1),IBPPF,(+IBADM)_";DGPM(")
|
|---|
| 51 | I 'IBIEN D M(,$P(IBIEN,"^",2)) Q
|
|---|
| 52 | I '$G(VAIP(17)) D M(IBIEN,"missing discharge information") Q
|
|---|
| 53 | S IBRES=$$DIS^IBATFILE(IBIEN,+VAIP(17,1),VAIP(12),VAIP(17))
|
|---|
| 54 | I 'IBRES D M(IBIEN,$P(IBRES,"^",2)) Q
|
|---|
| 55 | S IBFINDRT=$$FINDRT^IBATEI(VAIP(12),VAIP(13),DFN)
|
|---|
| 56 | I '+IBFINDRT D M(IBIEN,"Cannot price transaction") Q
|
|---|
| 57 | I $P(IBFINDRT,"^",3)="B" S IBRES=$$INPT^IBATFILE(IBIEN,0,0,$P(IBFINDRT,"^",4),0,$P(IBFINDRT,"^",4),$P(IBFINDRT,"^",7))
|
|---|
| 58 | E S IBRES=$$INPT^IBATFILE(IBIEN,$P(IBFINDRT,"^",3),$P(IBFINDRT,"^",2),$P(IBFINDRT,"^",4),$P(IBFINDRT,"^",5),$P(IBFINDRT,"^",6),$P(IBFINDRT,"^",7))
|
|---|
| 59 | I 'IBRES D M(IBIEN,"Error in filling pricing information") Q
|
|---|
| 60 | D M(IBIEN)
|
|---|
| 61 | Q
|
|---|
| 62 | M(X,Y) ; Prints message and hangs
|
|---|
| 63 | N IBSITE S IBSITE=$$SITE^IBATUTL
|
|---|
| 64 | I $D(X) W !,"Transaction #",IBSITE,X," Added"
|
|---|
| 65 | I $D(Y) W !,"Cannot complete, ",Y
|
|---|
| 66 | D H
|
|---|
| 67 | Q
|
|---|
| 68 | O ; -- select an outpatient stay
|
|---|
| 69 | N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,IBDATA,IBX,IBC,CPTLIST,IBIEN,IBFAC
|
|---|
| 70 | K ^TMP("IBAT",$J)
|
|---|
| 71 | S DIR(0)="D^::AEPX",DIR("A")="Visit Date" D ^DIR Q:$D(DIRUT)
|
|---|
| 72 | S IBDATA("DFN")=DFN,IBDATA("BDT")=Y,IBDATA("EDT")=Y+.99999
|
|---|
| 73 | ;
|
|---|
| 74 | ; scan for the appointments and set up tmp global
|
|---|
| 75 | ; screen to eliminate children and inpatient appointments
|
|---|
| 76 | D SCAN^IBSDU("PATIENT/DATE",.IBDATA,"I '$P(Y0,""^"",6),$P(Y0,""^"",12)'=8","S ^TMP(""IBAT"",$J,Y)=Y0","")
|
|---|
| 77 | ;
|
|---|
| 78 | I '$D(^TMP("IBAT",$J)) W !!,"No appointments exist for the date!" D H Q
|
|---|
| 79 | W !,?10,"Choose which Visit:" S IBX=0
|
|---|
| 80 | F IBC=1:1 S IBX=$O(^TMP("IBAT",$J,IBX)) Q:IBX<1 S IBDATA=^(IBX) D
|
|---|
| 81 | . W !,?4,IBC,?10,$$FMTE^XLFDT($P(IBDATA,"^"),"1P")
|
|---|
| 82 | . W ?35,$$EX^IBATUTL(409.68,.04,$P(IBDATA,"^",4))
|
|---|
| 83 | . W ?55,$$EX^IBATUTL(409.68,.12,$P(IBDATA,"^",12))
|
|---|
| 84 | S DIR(0)="N^1:"_(IBC-1),DIR("A")="Select" D ^DIR Q:$D(DIRUT)
|
|---|
| 85 | S IBX=0 F IBC=1:1:Y S IBX=$O(^TMP("IBAT",$J,IBX))
|
|---|
| 86 | ; check for duplicates
|
|---|
| 87 | D DUP(IBX_";SCE(",.DIRUT) I $D(DIRUT) D H Q
|
|---|
| 88 | ; setup visit info
|
|---|
| 89 | S IBX(0)=^TMP("IBAT",$J,IBX)
|
|---|
| 90 | D GETCPT^SDOE(IBX,"CPTLIST") ;GETDX^SDOE(IBX,"DXLIST")
|
|---|
| 91 | S IBFAC=$$PPF^IBATUTL(DFN)
|
|---|
| 92 | ; ok now lets format cpts and price
|
|---|
| 93 | S IBIEN=0 F S IBIEN=$O(CPTLIST(IBIEN)) Q:IBIEN<1 D
|
|---|
| 94 | . N IBCPT,IBQTY,IBPRICE
|
|---|
| 95 | . S IBCPT=$P(CPTLIST(IBIEN),"^"),IBQTY=$P(CPTLIST(IBIEN),"^",16)
|
|---|
| 96 | . S IBPRICE=$$OPT^IBATCM(IBCPT,$P(IBX(0),"^"),IBFAC)
|
|---|
| 97 | . S IBIEN(IBCPT)=IBQTY_"^"_$S(IBPRICE:$P(IBPRICE,"^",4),1:0)
|
|---|
| 98 | S IBIEN=$$OUT^IBATFILE(DFN,$P(IBX(0),"^"),IBFAC,IBX_";SCE(",.IBIEN)
|
|---|
| 99 | W !!,"Transaction Number ",$P(^IBAT(351.61,IBIEN,0),"^")," Added!" D H
|
|---|
| 100 | K ^TMP("IBAT",$J)
|
|---|
| 101 | Q
|
|---|
| 102 | P ; -- select an rx
|
|---|
| 103 | N IBRX,IBPSRX,IBOUT,IBCOUNT,DIRUT,DIR,IBP,IBNUM,IBSITE,IBQUIT,IBBDT,IBEDT
|
|---|
| 104 | S (IBCOUNT,IBOUT)=0
|
|---|
| 105 | Q:$$SLDR^IBATUTL
|
|---|
| 106 | D RX^IBATRX(DFN,IBBDT,IBEDT,.IBRX)
|
|---|
| 107 | I '$D(IBRX) W !!,"No Rx's on file for date range selected." D H Q
|
|---|
| 108 | W @IOF,!,"Prescriptions Issued:",!
|
|---|
| 109 | S IBPSRX=0 F S IBPSRX=$O(IBRX(IBPSRX)) Q:IBPSRX=""!(IBOUT) D
|
|---|
| 110 | . S IBDT=0 F S IBDT=$O(IBRX(IBPSRX,IBDT)) Q:IBDT<1!(IBOUT) D
|
|---|
| 111 | .. S IBDAT=IBRX(IBPSRX,IBDT),IBCOUNT=IBCOUNT+1
|
|---|
| 112 | .. W !,IBCOUNT,?4,$$FMTE^XLFDT(IBDT,"5D"),?18,$P(IBDAT,"^")
|
|---|
| 113 | .. W "(",$P(IBDAT,"^",2),")",?35,$E($P(IBDAT,"^",4),1,27)
|
|---|
| 114 | .. W ?65,$J($FN($P(IBDAT,"^",5)*$P(IBDAT,"^",6),",",2),12)
|
|---|
| 115 | .. ;I $Y+4>IOSL D H X:'$D(DIRUT) "W @IOF,!" I $D(DIRUT) S IBOUT=1 Q
|
|---|
| 116 | .. S IBNUM(IBCOUNT)=IBPSRX_"^"_IBDT
|
|---|
| 117 | W ! K DIRUT S DIR(0)="L^1:"_IBCOUNT,DIR("A")="Which Prescriptions"
|
|---|
| 118 | D ^DIR Q:$D(DIRUT) W !!,"Selected number(s): "_Y S IBNUM=Y
|
|---|
| 119 | W !,"Ok to add: " S %=1 D YN^DICN I %'=1 D H Q
|
|---|
| 120 | S IBFAC=$$PPF^IBATUTL(DFN),IBSITE=$$SITE^IBATUTL
|
|---|
| 121 | F IBP=1:1 S IBRX=$P(IBNUM,",",IBP) Q:'IBRX D
|
|---|
| 122 | . S IBRX(0)=IBRX($P(IBNUM(IBRX),"^"),$P(IBNUM(IBRX),"^",2))
|
|---|
| 123 | . D DUP($P(IBRX(0),"^")_";PSRX(;"_$P(IBRX(0),"^",2),.IBQUIT)
|
|---|
| 124 | . I $G(IBQUIT) K IBQUIT Q
|
|---|
| 125 | . W !!,"Adding Transaction number ",IBSITE
|
|---|
| 126 | . W $$RX^IBATFILE(DFN,$P(IBNUM(IBRX),"^",2),IBFAC,$P(IBRX(0),"^")_";PSRX(;"_$P(IBRX(0),"^",2),$P(IBRX(0),"^",3),$P(IBRX(0),"^",5),$P(IBRX(0),"^",6))
|
|---|
| 127 | . W "!" H 1
|
|---|
| 128 | D H
|
|---|
| 129 | Q
|
|---|
| 130 | R ; -- select an prosthetic
|
|---|
| 131 | N IBBDT,IBEDT,IBCOUNT,IBOUT,IBDA,IBDATA,IBP,IBC,IBCOUNT,%,DIRUT
|
|---|
| 132 | ;
|
|---|
| 133 | S (IBCOUNT,IBOUT)=0
|
|---|
| 134 | Q:$$SLDR^IBATUTL
|
|---|
| 135 | ;
|
|---|
| 136 | ; look up prosthetic devices issued
|
|---|
| 137 | S IBDA="" F S IBDA=$O(^RMPR(660,"C",DFN,IBDA)) Q:'IBDA D
|
|---|
| 138 | . ;
|
|---|
| 139 | . ; valid data
|
|---|
| 140 | . S IBDATA=$G(^RMPR(660,+IBDA,0)) Q:IBDATA=""
|
|---|
| 141 | . ;
|
|---|
| 142 | . ; valid date range
|
|---|
| 143 | . I $P(IBDATA,"^",12)<IBBDT!($P(IBDATA,"^",12)>IBEDT) Q
|
|---|
| 144 | . ;
|
|---|
| 145 | . ; checks from RMPRBIL copied 4/7/2000 with mod for AM node patients
|
|---|
| 146 | . I $S('$D(^RMPR(660,IBDA,"AM")):1,$P(IBDATA,"^",9)="":1,$P(IBDATA,"^",12)="":1,$P(IBDATA,"^",6)="":1,$P(IBDATA,"^",14)="V":1,$P(IBDATA,"^",15)="*":1,1:0) Q
|
|---|
| 147 | . ;
|
|---|
| 148 | . ; set array
|
|---|
| 149 | . S IBCOUNT=IBCOUNT+1,IBP(IBCOUNT,IBDA)=IBDATA
|
|---|
| 150 | ;
|
|---|
| 151 | I 'IBCOUNT W !!,"No Prosthetic Devices on file for date range selected." D H Q
|
|---|
| 152 | ;
|
|---|
| 153 | W @IOF,!,"Prosthetic Devices Issued:",!
|
|---|
| 154 | F IBC=1:1:IBCOUNT Q:IBOUT D
|
|---|
| 155 | . S IBDATA=IBP(IBC,$O(IBP(IBC,0)))
|
|---|
| 156 | . W !,IBC,?4,$$FMTE^XLFDT($P(IBDATA,"^",12),"5D")
|
|---|
| 157 | . W ?20,$$EX^IBATUTL(660,4,$P(IBDATA,"^",6)),?40,"("
|
|---|
| 158 | . W $$EX^IBATUTL(660,62,$P(^RMPR(660,$O(IBP(IBC,0)),"AM"),"^",3)),")"
|
|---|
| 159 | . W ?65,$J($FN($P(IBDATA,"^",16),",",2),12)
|
|---|
| 160 | ;
|
|---|
| 161 | W ! K DIRUT S DIR(0)="N^1:"_IBCOUNT_":0"
|
|---|
| 162 | S DIR("A")="Which Prosthetic Device" D ^DIR Q:$D(DIRUT) S IBC=+Y
|
|---|
| 163 | W !,"Ok to add: " S %=1 D YN^DICN I %'=1 D H Q
|
|---|
| 164 | S IBDA=$O(IBP(IBC,0)),IBDATA=IBP(IBC,IBDA)
|
|---|
| 165 | D DUP(IBDA_";RMPR(660,",.DIRUT)
|
|---|
| 166 | I $D(DIRUT) D H Q
|
|---|
| 167 | W !!,"Adding Transaction number ",$$SITE^IBATUTL
|
|---|
| 168 | W $$RMPR^IBATFILE(DFN,$P(IBDATA,"^",12),$$PPF^IBATUTL(DFN),(IBDA_";RMPR(660,"),$P(IBDATA,"^",6),$P(IBDATA,"^",16))
|
|---|
| 169 | W "!" H 1
|
|---|
| 170 | D H
|
|---|
| 171 | Q
|
|---|
| 172 | H ; -- page reader
|
|---|
| 173 | N DIR,X,Y,DTOUT,DUOUT,DIROUT
|
|---|
| 174 | W !! S DIR(0)="E" D ^DIR
|
|---|
| 175 | Q
|
|---|
| 176 | DUP(IBSOURCE,IBQUIT) ; -- checks for dups that are not cancelled
|
|---|
| 177 | N IBT S IBT=0
|
|---|
| 178 | F S IBT=$O(^IBAT(351.61,"AD",IBSOURCE,IBT)) Q:IBT<1!($D(IBQUIT)) D
|
|---|
| 179 | . Q:$P(^IBAT(351.61,IBT,0),"^",5)="X"
|
|---|
| 180 | . W !,$S(IBSOURCE["SCE(":"Visit",IBSOURCE["DGPM(":"Admission",IBSOURCE["RMPR(":"Prosthetic",1:"Prescription")," exists already!" S IBQUIT=1
|
|---|
| 181 | Q
|
|---|
