| 1 | FBPAY ;AISC/DMK,GRR,TET-PATIENT/VENDOR PAYMENT OUTPUT DRIVER ;20/NOV/2006
|
|---|
| 2 | ;;3.5;FEE BASIS;**32,69,101**;JAN 30, 1995;Build 2
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | GETVEN ;select vendor
|
|---|
| 5 | K FBX S FBSORT=0 ;FBSORT=1 for patient, = 0 for vendor
|
|---|
| 6 | S DIC="^FBAAV(",DIC(0)="AEQMZ",DIC("A")="Select Fee Vendor: " W !! D ^DIC K DIC("A") G EXIT:$D(DTOUT)!($D(DUOUT))!(X=""),GETVEN:Y<0
|
|---|
| 7 | S FBIEN=+Y,FBNAME=$S(Y(0,0)]"":Y(0,0),1:"UNKNOWN"),FBID=$S($P(Y(0),U,2)]"":$P(Y(0),U,2),1:"UNKNOWN") G DATE
|
|---|
| 8 | GETVET ;select patient
|
|---|
| 9 | K FBX S FBSORT=1 ;FBSORT=1 for patient, =0 for vendor
|
|---|
| 10 | S DIC="^FBAAA("
|
|---|
| 11 | S DIC(0)="AEQMNZ",DIC("A")="Select Fee Patient: " W !! D ^DIC K DIC("A") G EXIT:$D(DTOUT)!($D(DUOUT))!(X=""),GETVET:Y<0
|
|---|
| 12 | S FBIEN=+Y,FBNAME=Y(0,0),FBID=$$SSNL4^FBAAUTL($$SSN^FBAAUTL(FBIEN))
|
|---|
| 13 | DATE ;select date range
|
|---|
| 14 | D DATE^FBAAUTL I FBPOP G GETVET:FBSORT,GETVEN
|
|---|
| 15 | S FBBDATE=BEGDATE,FBEDATE=ENDDATE
|
|---|
| 16 | S Z=9999999.9999,FBBEG=Z-FBEDATE,FBEND=Z-FBBDATE
|
|---|
| 17 | PROG ;select one/many/all fee programs
|
|---|
| 18 | I '$G(FBCHK) S DIC="^FBAA(161.8,",DIC("S")="I $P(^(0),U,3)",VAUTSTR="FEE Program",VAUTNI=2,VAUTVB="FBPROG" D FIRST^VAUTOMA I 'FBPROG&('$O(FBPROG(0))) G GETVET:FBSORT,GETVEN
|
|---|
| 19 | I FBPROG S FBERR=0 D ARRAY G EXIT:FBERR
|
|---|
| 20 | ASKMB ; if outpatient or civil hospital or pharmacy selected then ask if
|
|---|
| 21 | ; report for just mill-bill (1725) or just non-mill bill claims
|
|---|
| 22 | I $D(FBPROG(2))!$D(FBPROG(3))!$D(FBPROG(6)) S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G EXIT
|
|---|
| 23 | Q K ^TMP($J,"FB"),^TMP($J,"FBTR"),DIC S FBX=FBSORT
|
|---|
| 24 | S VAR="FBNAME^FBIEN^FBID^FBBEG^FBEND^FBBDATE^FBEDATE^FBPROG^FBPROG(^FBSORT^FB1725R",VAL=VAR,PGM="DQ^FBPAY" D ZIS^FBAAUTL G:FBPOP EXIT
|
|---|
| 25 | DQ S $P(FBDASH,"=",80)="",$P(FBDASH1,"-",80)="",FBPG=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBOUT=0,FBBEG=FBBEG-.9 U IO
|
|---|
| 26 | SORT ;sort driver for payment output(s)
|
|---|
| 27 | S FBPI=0 F S FBPI=$O(FBPROG(FBPI)) Q:'FBPI S FBXPROG=FBPROG(FBPI) D
|
|---|
| 28 | .I FBPI=2 D EN^FBPAY2 ;outpatient payments
|
|---|
| 29 | .I FBPI=3 D EN^FBPAY3 ;pharmacy payments
|
|---|
| 30 | .I FBPI=6!(FBPI=7) S:FBPI=6&$D(FBPROG(7)) FBPIFLG=67 D EN^FBPAY67 S:$D(FBPIFLG) FBPI=7 K FBPIFLG ;civil hospital/cnh payments
|
|---|
| 31 | PRINT ;print driver for payment output(s)
|
|---|
| 32 | S FBPI=$O(^TMP($J,"FB",0)) I FBPI']"" D WMSG G OUT
|
|---|
| 33 | S (FBOUT,FBPI)=0 F S FBPI=$O(FBPROG(FBPI)) Q:'FBPI S FBXPROG=FBPROG(FBPI) D Q:FBOUT
|
|---|
| 34 | .I FBPI=2,$D(^TMP($J,"FB",FBPI)) D PRINT^FBPAY21 Q:$G(FBOUT) D:$D(^TMP($J,"FB",FBPI_"O")) OTH Q
|
|---|
| 35 | .I FBPI=3 D:$D(^TMP($J,"FB",FBPI)) PRINT^FBPAY3 Q:$G(FBOUT) D:$D(^TMP($J,"FB",FBPI_"O")) OTH Q
|
|---|
| 36 | .I FBPI=6!(FBPI=7) D:$D(^TMP($J,"FB",FBPI)) PRINT^FBPAY671 Q:$G(FBOUT) D:$D(^TMP($J,"FB",FBPI_"O")) OTH Q
|
|---|
| 37 | OUT I FBOUT!$D(ZTQUEUED) G EXIT
|
|---|
| 38 | D KILL G GETVET:FBX,GETVEN
|
|---|
| 39 | Q
|
|---|
| 40 | EXIT ;kill and quit
|
|---|
| 41 | K FBX
|
|---|
| 42 | KILL ;kill all variables set in the FBPAY* routines, other than fbx
|
|---|
| 43 | D CLOSE^FBAAUTL K ^TMP($J,"FB"),^TMP($J,"FBTR")
|
|---|
| 44 | K A1,A2,A3,BEGDATE,B3,C,C3,D,D2,DFN,DIC,DIR,DTOUT,DUOUT,ENDDATE
|
|---|
| 45 | K FBAACPTC,FBAC,FBAP,FBBATCH,FBBDATE,FBBEG,FBBN,FBCNT,FBCP,FBCRT,FBDA1,FBDASH,FBDASH1,FBDATA,FBDOB,FBDRUG,FBDT,FBDT1,FBDOS,FBEDATE,FBEND,FBERR,FBFD,FBFD1,FBHEAD,FBMOD
|
|---|
| 46 | K FBI,FBID,FBIEN,FBIN,FBINVN,FBIX,FBLOC,FBM,FBNAME,FBOB,FBOPI,FBOUT,FBOV,FBP,FBPAT,FBPD,FBPDX,FBPG,FBPI,FBPID,FBPIFLG,FBPIN,FBPISV,FBPNAME,FBPROG,FBPT,FBPV,FBQTY,FBREIM,FBR,FBRX,FBTRCK
|
|---|
| 47 | K FBADJLA,FBADJLR,FBFPPSC,FBFPPSL,TAMT,FBRRMKL,FBADJ,FBINV
|
|---|
| 48 | K FBSC,FBSL,FBSORT,FBSTR,FBSUSP,FBTA,FBTRDT,FBTRX,FBTYPE,FBV,FBVCHAIN,FBVNAME,FBVI,FBVID,FBVP,FBXPROG,FBY,FBZ,I,J,K,L,M,PGM,T,V,VA,VAERR,VAL,VAR,VAUTNI,VAUTSTR,VAUTVB,X,Y,Z
|
|---|
| 49 | K FB1725R
|
|---|
| 50 | Q
|
|---|
| 51 | ARRAY ;set array if all programs are selected
|
|---|
| 52 | S FBPI=0 F S FBPI=$O(^FBAA(161.8,FBPI)) Q:'FBPI S FBPIN=$G(^(FBPI,0)) I $P(FBPIN,U,3) S FBPROG(FBPI)=$P(FBPIN,U)
|
|---|
| 53 | I '$D(FBPROG) S FBERR=1
|
|---|
| 54 | Q
|
|---|
| 55 | WMSG ;write message if no matches found
|
|---|
| 56 | S FBPG=FBPG+1 W:$G(FBCRT) @IOF W !
|
|---|
| 57 | W !?25,$S($G(FBSORT):"VETERAN",1:"VENDOR")," PAYMENT HISTORY"
|
|---|
| 58 | I $G(FB1725R)]"",FB1725R'="A" W " ",$S(FB1725R="M":"for 38 U.S.C. 1725 Claims",1:"excluding 38 U.S.C. 1725 Claims")
|
|---|
| 59 | W !?24,$E(FBDASH,1,24),?71,"Page: ",FBPG
|
|---|
| 60 | I FBSORT W !,"Patient: ",FBNAME,?41,"Patient ID:",FBID
|
|---|
| 61 | I 'FBSORT W !,"Vendor: ",FBNAME,?41,"Vendor ID:",FBID
|
|---|
| 62 | ;W !?(IOM-12/2),"FEE PROGRAM:"
|
|---|
| 63 | W !?3,"('*' Reimb. to Patient '+' Cancel. Activity '#' Voided Payment)"
|
|---|
| 64 | W !!!,FBDASH
|
|---|
| 65 | W !!,"There are no payments on file for "_$S(FBSORT:"Veteran",1:"Vendor")_" ",FBNAME,!?3,"for specified date range: ",$$DATX^FBAAUTL(FBBDATE)," through ",$$DATX^FBAAUTL(FBEDATE)
|
|---|
| 66 | I 'FBPROG D
|
|---|
| 67 | .W !?3,"and selected Fee Program(s):"
|
|---|
| 68 | .S FBPI=0 F S FBPI=$O(FBPROG(FBPI)) Q:'FBPI W !?30,FBPROG(FBPI)
|
|---|
| 69 | I FBPROG W !?3,"and ALL Fee programs"
|
|---|
| 70 | W ".",*7,!!
|
|---|
| 71 | Q
|
|---|
| 72 | OTH ;other fee basis programs
|
|---|
| 73 | I '$D(^TMP($J,"FB",FBPI_"O")) Q
|
|---|
| 74 | S FBZ=FBPI,FBPI=FBPI_"O",FBPROG(FBPI)="**OUTPATIENT** "_FBXPROG
|
|---|
| 75 | D PRINT^FBPAY21
|
|---|
| 76 | K FBPROG(FBPI) S FBPI=FBZ K FBZ
|
|---|
| 77 | Q
|
|---|
