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