| 1 | FBUCPAY ;ALBISC/TET - PAYMENT DRIVER ;4/30/93 11:34
|
|---|
| 2 | ;;3.5;FEE BASIS;**7**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ASK ;ask to whom payment should be made, vendor and veteran (to narrow selection)
|
|---|
| 5 | S DIR(0)="SMO^1:PATIENT;2:VENDOR",DIR("A")="Select to whom payment should be made" D ^DIR K DIR G END:$D(DIRUT),ASK:'+Y!($G(Y(0))']"")
|
|---|
| 6 | S FBPAY=+Y ;1 for patient, 2 for vendor
|
|---|
| 7 | GET ;get claim for payment, only approved dispositioned claims, non cnh program, ven and vet must match
|
|---|
| 8 | K FBVEN,FBVET
|
|---|
| 9 | VET ;get vet info
|
|---|
| 10 | S DIR(0)="162.7,2O",DIR("A")="Select VETERAN" D ^DIR K DIR G END:$D(DIRUT),VET:+Y'>0 S FBVET=+Y
|
|---|
| 11 | VEN ;get vendor info
|
|---|
| 12 | S DIR(0)="162.7,1O",DIR("A")="Select FEE VENDOR" D ^DIR K DIR G END:$D(DUOUT)!($D(DTOUT)),VEN:+Y'>0 S FBVEN=+Y
|
|---|
| 13 | LOOKUP ;select claim
|
|---|
| 14 | S FBIX="APMS",FBIEN=FBVET,FBO="40^70^90^" D DISP7^FBUCUTL5(FBIX,FBIEN,FBO) ;lookup by patient, dispostioned claim only
|
|---|
| 15 | ;delete entries from array which don't meet criteria: program=7(cnh), vendor'=fbven, disposition not approved or approved to stabilization
|
|---|
| 16 | S (FBCNT,FBI)=0 F S FBI=$O(^TMP("FBAR",$J,FBI)) Q:'FBI S FBZ=$G(^FB583(+^(FBI),0)) D
|
|---|
| 17 | .I $S($P(FBZ,U,2)=7:1,$P(FBZ,U,3)'=FBVEN:1,$P(FBZ,U,11)'=1&($P(FBZ,U,11)'=4):1,1:0) D:$$GO(FBI) K ^TMP("FBAR",$J,FBI) S $P(^("FBAR"),";")=+^TMP("FBAR",$J,"FBAR")-1 Q
|
|---|
| 18 | ..S FBZ=$P(^(FBI+1),";")_"; "_$$EXTRL^FBMRASVR($P($P(^(FBI),U),";",2))_U_$P($P(^(FBI+1),U),";",2)_U_$P(^(FBI),U,3,8),$P(FBZ,U,7)=" "_$$EXTRL^FBMRASVR($P(FBZ,U,7)),^TMP("FBAR",$J,FBI+1)=FBZ K FBZ
|
|---|
| 19 | .S FBCNT=FBCNT+1 I FBI'=FBCNT S ^TMP("FBAR",$J,FBCNT)=^TMP("FBAR",$J,FBI) K ^TMP("FBAR",$J,FBI)
|
|---|
| 20 | D DISPX^FBUCUTL1(1,1) ;display/make selection
|
|---|
| 21 | K ^TMP("FBAR",$J) G END:FBOUT!('+$G(FBARY)) ;nothing selected so go to end
|
|---|
| 22 | LOOP ;loop thru selection and make payments
|
|---|
| 23 | N FBDA,FBI,FBNODE,FBP,FBPL,FBW,FBZ D PARSE^FBUCUTL4(FBARY)
|
|---|
| 24 | S (FBOUT,FBI)=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI S FBNODE=$G(^(FBI)),FBDA=+$P(FBNODE,";"),FBZ=$G(^FB583(FBDA,0)) D ;D:$D(FBMESS) WRITE G END:FBOUT,ASK
|
|---|
| 25 | .I +$G(FBARY)>1 D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
|
|---|
| 26 | .N FBI,FTP,DUOUT,DTOUT S FBOUT=0 D PAY(FBVET,FBPAY,FBZ)
|
|---|
| 27 | D END G ASK
|
|---|
| 28 | ;
|
|---|
| 29 | PAY(FBVET,FBPAY,FBZ) ;determine payments
|
|---|
| 30 | I '($P(FBZ,U,11)=1!($P(FBZ,U,11)=4)) W *7 S FBMESS="Unauthorized claim must be Approved or Approved to Stabilization" D WRITE S FBMESS=" in order to make a payment." D WRITE S FBOUT=1 Q
|
|---|
| 31 | S (DFN,D0)=FBVET,FBPROG(1)=+$P(FBZ,U,2),FBSUBMIT=$P(FBZ,U,23),FBAAPTC=$S(FBPAY=2:"V",1:"R"),FBAIEN=+$P(FBZ,U,27) ;,FBAAPTC=$S(FBSUBMIT["DPT(":"R",FBSUBMIT["FBAAV(":"V",FBSUBMIT["VA(200,":"O",1:0)
|
|---|
| 32 | I FBPROG(1)=7 W *7,! S FBMESS="Fee program is community nursing home." D WRITE S FBMESS="Payments should not be authorized." D WRITE S FBOUT=1 Q
|
|---|
| 33 | I FBPROG(1)=6 S DIR(0)="YO",DIR("A")="Is this an ancillary payment",DIR("B")="No" D ^DIR K DIR S:$D(DIRUT) FBOUT=1 Q:$G(FBOUT) S FBANC=+Y
|
|---|
| 34 | S FBPROG="I $P(^(0),""^"",9)[""FB583(""&($P(^(0),""^"",3)="_FBPROG(1)_")"
|
|---|
| 35 | S X=FBAIEN,CNT=X,CNT(CNT)=X D 2^FBAAUTL1 I $D(DUOUT)!(FTP']"") S FBOUT=1 Q
|
|---|
| 36 | I 'FBAIEN W *7 S FBMESS="No authorization associated with this 583!" D WRITE S FBOUT=1 Q
|
|---|
| 37 | ;I FB583'=FBDA W *7 S FBMESS="Authorization does not pertain to the selected unauthorized claim." D WRITE S FBOUT=1 Q
|
|---|
| 38 | I FBTYPE'=FBPROG(1) W *7 S FBMESS="Authorization Fee program differs from Fee program in Unauthorized Claim." D WRITE S FBOUT=1 Q
|
|---|
| 39 | S FBV583=FB583_";FB583("
|
|---|
| 40 | D CR Q:FBOUT
|
|---|
| 41 | D HOME^%ZIS W @IOF,!?25,"< UNAUTHORIZED CLAIM >",!! S DIC="^FB583(",DA=FB583,DR="",DIQ(0)="C" D EN^DIQ W ! K DIC,DIQ,DR,DA,CNT,X
|
|---|
| 42 | D CR Q:FBOUT
|
|---|
| 43 | D ;G 2:FBPROG(1)=2,3:FBPROG(1)=3,6:FBPROG(1)=6,7:FBPROG(1)=7
|
|---|
| 44 | .;payment for outpatinet
|
|---|
| 45 | .I FBPROG(1)=2 D EN583^FBAACO Q
|
|---|
| 46 | .;payments for pharmacy
|
|---|
| 47 | .I FBPROG(1)=3 D ^FBAAPIE Q
|
|---|
| 48 | .;payments for civil hospital
|
|---|
| 49 | .I FBPROG(1)=6 S FBI7078=FB583_";FB583(",$P(FBZ(0),"^",4)=$P(FBZ,U,5),FBRESUB="" D EN583^FBCHEP:'FBANC,EN583^FBCHCO:FBANC Q
|
|---|
| 50 | .;payments for community nursing home
|
|---|
| 51 | .I FBPROG(1)=7 W *7,! S FBMESS="Fee program is community nursing home." D WRITE S FBMESS="Payments should not be authorized." D WRITE
|
|---|
| 52 | Q
|
|---|
| 53 | END ;kill variables and quit
|
|---|
| 54 | K FB,FBAABDT,FBAAEDT,FBAAOUT,FBAAPTC,FBAIEN,FBANC,FBASSOC,FBARY,FBCNT,FBDA,FBD1,FBFDC,FBI,FBIEN,FBIX,FBI7078,FBMST,FBO,FBOUT
|
|---|
| 55 | K FBRESUB,FBTTYPE,FBDMRA,FBMESS,FBPAY,FBPOV,FBPSA,FBPROG,FBPT,FBSUBMIT,FBTP,FBTT,FBTYPE,FBVEN,FBVET,FBV583,FBZ,FB583,FB7078,FTP
|
|---|
| 56 | K CNT,DFN,D0,DTOUT,DUOUT,DIC,DIR,DIRUT,DTOUT,DUOUT,TA,X,Y,^TMP("FBARY",$J)
|
|---|
| 57 | Q
|
|---|
| 58 | WRITE ;write message
|
|---|
| 59 | W !?5,FBMESS
|
|---|
| 60 | Q
|
|---|
| 61 | CR ;ask carriage return to continue
|
|---|
| 62 | S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S FBOUT=1
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | GO(X) ;X=counter from ^TMP("FBAR",$J,X)
|
|---|
| 66 | I '$G(X) Q 0
|
|---|
| 67 | Q $S($P($G(^TMP("FBAR",$J,X)),U,3,8)']"":0,'$G(^TMP("FBAR",$J,X+1)):0,$P($G(^TMP("FBAR",$J,X+1)),U,3,8)]"":0,1:1)
|
|---|
