| 1 | FBPRICE1 ;AISC/DMK-GENERIC PRICER INTERFACE CON'T ;25JUN92
|
|---|
| 2 | ;;3.5;FEE BASIS;**56,55,77**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ICD ;ask Dx
|
|---|
| 6 | W ! F I=1:1:5 S FBDX(I)=" "
|
|---|
| 7 | S DIR(0)="PO^80:EQMZ"
|
|---|
| 8 | F I=1:1:5 D Q:X=""!($D(DTOUT))!($D(DUOUT))
|
|---|
| 9 | . N ICDVDT S ICDVDT=$$STR2FBDT^FBCSV1($G(FBFDT)) ;see DD for file #80
|
|---|
| 10 | . 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
|
|---|
| 11 | I FBDX(1)=" ",$D(DTOUT)!($D(DUOUT)) G END^FBPRICE
|
|---|
| 12 | I FBDX(1)=" " W !,*7,"Must enter at least a primary diagnosis.",! G ICD
|
|---|
| 13 | K DIR,I
|
|---|
| 14 | PROC ;ask procedure codes
|
|---|
| 15 | W ! F I=1:1:3 S FBPRC(I)=" "
|
|---|
| 16 | S DIR(0)="PO^80.1:EQM"
|
|---|
| 17 | F I=1:1:3 D Q:X=""!($D(DUOUT))!($D(DTOUT))
|
|---|
| 18 | . N ICDVDT S ICDVDT=$$STR2FBDT^FBCSV1($G(FBFDT)) ;for ^DIR see DD for file #80.1
|
|---|
| 19 | . 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
|
|---|
| 20 | I 'FBPRC(1),$D(DTOUT)!($D(DUOUT)) G END^FBPRICE
|
|---|
| 21 | K DIR,I
|
|---|
| 22 | ;
|
|---|
| 23 | 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
|
|---|
| 24 | ;
|
|---|
| 25 | 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
|
|---|
| 26 | ;
|
|---|
| 27 | ;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
|
|---|
| 28 | S FBOBL="000000"
|
|---|
| 29 | ;
|
|---|
| 30 | STRING ;set-up message text for pricer
|
|---|
| 31 | W ! D WAIT^DICD
|
|---|
| 32 | D ADDRESS^FBAAV01 Q:$G(VATERR) K VAT
|
|---|
| 33 | S FBFLAG=1 D NEWMSG^FBAAV01
|
|---|
| 34 | S FBPART1=FBSSN_FBFDT_FBSTAN
|
|---|
| 35 | S FBSTR(1)=FBPART1_21_FBLNAM_FBFI_FBMI_FBSEX_FBDOB_FBLOS_FBDISP_FBBILL_FBCLAIM_FBAUTH_FBPAYT_FBOBL_"Y"
|
|---|
| 36 | S FBSTR(2)=FBPART1_22_FBVID_FBMED_$E(PAD,1,29)_FBTDT_FBSTABR_FBDX(1)
|
|---|
| 37 | S FBSTR(3)=FBPART1_23_FBDX(2)_FBDX(3)_FBDX(4)_FBDX(5)_FBPRC(1)_FBPRC(2)_FBPRC(3)_" "
|
|---|
| 38 | F I=1:1:3 S FBSTR=FBSTR(I) D STORE^FBAAV01
|
|---|
| 39 | D XMIT^FBAAV01 K FBFLAG
|
|---|
| 40 | W !,"Case sent to pricer.",!
|
|---|
| 41 | Q
|
|---|
