source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBPRICE.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1FBPRICE ;AISC/DMK-GENERIC PRICER INTERFACE ;25JUN92
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;build a transaction to send to the Austin Pricer system
5 ;this data will NOT be stored anywhere. It serves only
6 ;as a tool to determine reimbursement rates.
7 S PAD=" "
8 S FB("ERROR")="" D STATION^FBAAUTL G END:FB("ERROR") K FB("ERROR")
9 S FBSTAN=FBAASN_$E(PAD,$L(FBAASN)+1,6)
10PAT ;ask patient name [this is not a look-up on file 2]
11 W ! S DIR("A")="Want to select patient from DHCP Patient File",DIR(0)="Y",DIR("B")="Yes" D ^DIR K DIR Q:$D(DIRUT) I Y D G END:'$D(FBSSN),VEND
12 .W ! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC K DIC Q:X="^"!(X="")!(Y<0)
13 .D PAT^FBAAUTL2 S FBLNAM=$E(FBFLNAM,1,12),FBSSN=$E(FBSSN,10)_$E(FBSSN,1,9)_" "
14 ;
15 W ! S DIR("A")="Enter LAST NAME",DIR(0)="F^3:20^K:X'?.A X",DIR("?")="Enter last name of patient. Answer must be 3 to 20 characters in length" D ^DIR K DIR Q:$D(DIRUT) S FBLNAM=$E(Y,1,12)_$E(PAD,$L(Y)+1,12)
16 ;
17 S DIR("A")="Enter FIRST INITIAL",DIR(0)="F^1:1^K:X'?1A X" D ^DIR K DIR Q:$D(DIRUT) S FBFI=Y
18 ;
19 S DIR("A")="Enter MIDDLE INITIAL",DIR(0)="FO^1:1^K:X'?1A X" D ^DIR K DIR Q:$D(DUOUT)!($D(DTOUT)) S FBMI=$S(Y]"":Y,1:" ")
20 ;
21 S FBNAME=FBLNAM_FBFI_FBMI
22SSN ;ASK SSN
23 S DIR("A")="Patient ID Number",DIR("?")="Answer must contain 9 numbers. Pseudo-SSN not allowed",DIR(0)="F^9:9^K:X'?9N X" D ^DIR K DIR Q:$D(DIRUT) S FBSSN=" "_Y_" "
24 ;
25DOB S DIR(0)="2,.03",DIR("A")="Date of Birth" D ^DIR K DIR Q:$D(DIRUT) S FBDOB=$E(Y,4,7)_($E(Y,1,3)+1700)
26 ;
27SEX ;ask sex of patient
28 S DIR("A")="Sex of Patient",DIR(0)="2,.02" D ^DIR K DIR G END:$D(DIRUT) S FBSEX=Y
29VEND ;ask vendor
30 S DIR("A")="Want to select a vendor from DHCP Fee Basis Vendor file",DIR(0)="Y",DIR("B")="Yes" D ^DIR K DIR Q:$D(DIRUT) I Y D G END:+$G(FBOUT),VEND:'$D(FBVID),CONT
31 .W ! S DIC="^FBAAV(",DIC(0)="AEQMZ" D ^DIC K DIC S:X=""!(X="^") FBOUT=1 Q:Y<0 S FBSTABR=+$P(Y(0),"^",5),FBSTABR=$P($G(^DIC(5,FBSTABR,0)),"^",2),FBSTABR=$S('$L(FBSTABR):" ",1:FBSTABR)
32 .S FBVID=$P(Y(0),"^",17) I FBVID="" K FBVID W !!,*7,"Vendor must have a Medicare ID number to send to the pricer.",! Q
33 W ! S DIR("A")="Select Vendor Name",DIR(0)="F^2:46" D ^DIR K DIR G END:$D(DIRUT) S FBVEN=Y
34 S DIR("A")="Enter Medicare ID Number",DIR(0)="161.2,22" D ^DIR K DIR G END:$D(DIRUT) S FBVID=Y
35 S DIR("A")="State of Vendor",DIR(0)="P^5:EQMZ" D ^DIR K DIR G END:$D(DIRUT) S FBSTABR=$S($L($P(Y(0),"^",2)):$P(Y(0),"^",2),1:" ")
36 ;
37CONT ;ask admission and treatment type information
38 W ! S DIR("A")="Admission Date: ",DIR(0)="DA^::EX",DIR("?")="^D HELP^%DTC" D ^DIR K DIR G END:$D(DIRUT) S FBFDT=Y
39 S DIR("A")="Discharge Date: ",DIR(0)="DA^"_FBFDT_"::EX",DIR("?")="^D HELP^%DTC" D ^DIR K DIR G END:$D(DIRUT) S FBTDT=Y
40 S X1=FBTDT,X2=FBFDT D ^%DTC S FBLOS=$S(X<1:1,1:X),FBLOS=$E("000",$L(FBLOS)+1,3)_FBLOS
41 F I="FBFDT","FBTDT" S @I=$E(@I,4,7)_($E(@I,1,3)+1700)
42 ;
43 S DIR(0)="P^43.4:EQM",DIR("A")="Admitting Authority" D ^DIR K DIR G END:$D(DIRUT) S Z=+Y
44 S FBAUTH=$$AUTH^FBAAV6(Z) K Z
45 ;
46 S DIR("A")="Disposition Code",DIR(0)="P^162.6:QEMZ" D ^DIR K DIR G END:$D(DIRUT) S FBDISP=$E("00",$L($P(Y(0),"^",2))+1,2)_$P(Y(0),"^",2)
47 ;
48 S DIR("A")="Is this a Patient Reimbursement",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR G END:$D(DIRUT) S FBPAYT=$S(Y:"P",1:"V")
49 ;
50 S DIR("A")="Payment by Medicare or Other Federal Agency",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR G END:$D(DIRUT) S FBMED=$S(Y:"Y",1:"N")
51 ;
52 D ^FBPRICE1
53 ;
54END K FBSTAN,FBAUTH,FBBILL,FBCLAIM,FBDISP,FBDOB,FBDX,FBFDT,FBFI,FBFLNAM,FBLNAM,FBLOS,FBMED,FBMI,FBNAME,FBOBL,FBPAYT,FBPRC,FBSEX,FBSITE,FB,FBAASN,FBFEE,FBI,FBJ,FBLN,FBNVP,FBOKTX,FBSN,FBXMZ
55 K FBSSN,FBSTR,FBSTABR,FBTDT,FBVID,PAD,POP,PRC,DUOUT,DTOUT,DIRUT,DIR,FBPART1,FBVEN,FBSDI,VAT,VATERR,VATNAME,Y,FBPOP,FBVAR,FBXMFEE,FBXMNVP,FBPOP
56 Q
Note: See TracBrowser for help on using the repository browser.