42 lines
2.1 KiB
Mathematica
42 lines
2.1 KiB
Mathematica
FBPRICE1 ;AISC/DMK-GENERIC PRICER INTERFACE CON'T ;25JUN92
|
|
;;3.5;FEE BASIS;**56,55,77**;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
ICD ;ask Dx
|
|
W ! F I=1:1:5 S FBDX(I)=" "
|
|
S DIR(0)="PO^80:EQMZ"
|
|
F I=1:1:5 D Q:X=""!($D(DTOUT))!($D(DUOUT))
|
|
. N ICDVDT S ICDVDT=$$STR2FBDT^FBCSV1($G(FBFDT)) ;see DD for file #80
|
|
. N FBRT F D ^DIR Q:X=""!($D(DTOUT))!($D(DUOUT))!(+Y'>0) S FBRT=$$CHKICD9^FBCSV1(+Y,$$STR2FBDT^FBCSV1($G(FBFDT))) I FBRT]"" S FBDX(I)=$TR(FBRT,"."),FBDX(I)=FBDX(I)_$E(PAD,$L(FBDX(I))+1,7) Q
|
|
I FBDX(1)=" ",$D(DTOUT)!($D(DUOUT)) G END^FBPRICE
|
|
I FBDX(1)=" " W !,*7,"Must enter at least a primary diagnosis.",! G ICD
|
|
K DIR,I
|
|
PROC ;ask procedure codes
|
|
W ! F I=1:1:3 S FBPRC(I)=" "
|
|
S DIR(0)="PO^80.1:EQM"
|
|
F I=1:1:3 D Q:X=""!($D(DUOUT))!($D(DTOUT))
|
|
. N ICDVDT S ICDVDT=$$STR2FBDT^FBCSV1($G(FBFDT)) ;for ^DIR see DD for file #80.1
|
|
. N FBRT F D ^DIR Q:X=""!($D(DUOUT))!($D(DTOUT))!(+Y'>0) S FBRT=$$CHKICD0^FBCSV1(+Y,$$STR2FBDT^FBCSV1($G(FBFDT))) I FBRT]"" S FBPRC(I)=$TR(FBRT,"."),FBPRC(I)=FBPRC(I)_$E(PAD,$L(FBPRC(I))+1,7) Q
|
|
I 'FBPRC(1),$D(DTOUT)!($D(DUOUT)) G END^FBPRICE
|
|
K DIR,I
|
|
;
|
|
W ! S DIR(0)="162.5,6.6",DIR("A")="Billed Charges" D ^DIR K DIR G END^FBPRICE:$D(DIRUT) S FBBILL=$FN(Y,"",2),FBBILL=$TR(FBBILL,"."),FBBILL=$E("00000000",$L(FBBILL)+1,8)_FBBILL
|
|
;
|
|
S DIR(0)="162.5,6.6",DIR("A")="Amount Claimed" D ^DIR K DIR G END^FBPRICE:$D(DIRUT) S FBCLAIM=$FN(Y,"",2),FBCLAIM=$TR(FBCLAIM,"."),FBCLAIM=$E("00000000",$L(FBCLAIM)+1,8)_FBCLAIM
|
|
;
|
|
;S DIR("A")="Obligation Number",DIR(0)="F^6:6^D CKOB^FBAAUTL1" D ^DIR K DIR G END^FBPRICE:$D(DIRUT) S FBOBL=Y
|
|
S FBOBL="000000"
|
|
;
|
|
STRING ;set-up message text for pricer
|
|
W ! D WAIT^DICD
|
|
D ADDRESS^FBAAV01 Q:$G(VATERR) K VAT
|
|
S FBFLAG=1 D NEWMSG^FBAAV01
|
|
S FBPART1=FBSSN_FBFDT_FBSTAN
|
|
S FBSTR(1)=FBPART1_21_FBLNAM_FBFI_FBMI_FBSEX_FBDOB_FBLOS_FBDISP_FBBILL_FBCLAIM_FBAUTH_FBPAYT_FBOBL_"Y"
|
|
S FBSTR(2)=FBPART1_22_FBVID_FBMED_$E(PAD,1,29)_FBTDT_FBSTABR_FBDX(1)
|
|
S FBSTR(3)=FBPART1_23_FBDX(2)_FBDX(3)_FBDX(4)_FBDX(5)_FBPRC(1)_FBPRC(2)_FBPRC(3)_" "
|
|
F I=1:1:3 S FBSTR=FBSTR(I) D STORE^FBAAV01
|
|
D XMIT^FBAAV01 K FBFLAG
|
|
W !,"Case sent to pricer.",!
|
|
Q
|