AHIFEE   ;NC/RLP    Copied and Modified the FBAACR routine        07-Dec-04 ; 12
/9/04 8:52am
FBAACR   ;AISC/CMR-OPT MED Cost Report ;6/1/1999
         ;;3.5;FEE BASIS;**4,77**;JAN 30, 1995
         D DATE^FBAAUTL Q:FBPOP
         S VAR="BEGDATE^ENDDATE",VAL=BEGDATE_"^"_ENDDATE,PGM="START^AHIFEE"
         W !?3,"Send output (data with ^ delimiters) to the NETSERVER device"
         D ZIS^FBAAUTL G END:FBPOP
         ;
START    K ^TMP($J,"FBAACR") S (FBAAOUT,DFN,FBA,FBB,FBC)=0,BEGDT=BEGDATE-1,Q="-"
,$P(Q,"-",25)="-",QQ="=",$P(QQ,"=",80)="=" U IO W:$E(IOST,1,2)["C-" @IOF D HED
         F FBDT=BEGDT:0 S FBDT=$O(^FBAAC("AK",FBDT)) Q:FBDT'>0!(FBDT>ENDDATE)  F
  S DFN=$O(^FBAAC("AK",FBDT,DFN)) Q:DFN'>0  F  S FBA=$O(^FBAAC("AK",FBDT,DFN,FBA
)) Q:FBA'>0  D  ;
         .F  S FBB=$O(^FBAAC("AK",FBDT,DFN,FBA,FBB)) Q:FBB'>0  F  S FBC=$O(^FBAA
C("AK",FBDT,DFN,FBA,FBB,FBC)) Q:FBC'>0  S FBPMT=^FBAAC(DFN,1,FBA,1,FBB,1,FBC,0),
FBSRVDT=+$G(^FBAAC(DFN,1,FBA,1,FBB,0)) I $P(FBPMT,"^",13)="" D  ;
         ..S FBPTC=$P(FBPMT,"^",17),FBAMT=$P(FBPMT,"^",3),FBNAME=$$NAME^FBCHREQ2
(DFN),FBCPT=$P(FBPMT,"^") D FBP23 D FBVEN
         ..S ^TMP($J,"FBAACR",FBNAME)=DFN,^TMP($J,"FBAACR",FBNAME,FBA,FBB,FBC)=F
BPTC_"^"_FBAMT_"^"_FBCPT_"^"_FBSRVDT_"^"_FBICDN_"^"_FBICDNM_"^"_FBVEN_"^"
         S (FBNAME,FBNM)="",(FBA,FBB,FBC,DFN,FBPTC,FBAMT,FBPAMT,FBTAMT,FBCPT,FBC
TR,FBTPT)=0
         F  S FBNAME=$O(^TMP($J,"FBAACR",FBNAME)) Q:FBNAME=""  S DFN=+^TMP($J,"F
BAACR",FBNAME) S FBTPT=FBTPT+1,FBPCTR=0 D  ;
         .F  S FBA=$O(^TMP($J,"FBAACR",FBNAME,FBA)) Q:FBA'>0  F  S FBB=$O(^TMP($
J,"FBAACR",FBNAME,FBA,FBB)) Q:FBB'>0  F  S FBC=$O(^TMP($J,"FBAACR",FBNAME,FBA,FB
B,FBC)) Q:FBC'>0  D  ;
         ..S FBPMT=^TMP($J,"FBAACR",FBNAME,FBA,FBB,FBC),FBPTC=$P(FBPMT,"^"),FBAM
T=$P(FBPMT,"^",2),FBCPT=$$CPT^FBAAUTL4(+$P(FBPMT,"^",3),1,+$P(FBPMT,"^",4)),FBPA
MT=FBPAMT+FBAMT,FBTAMT=FBTAMT+FBAMT D PRINT
         ;
END      K FBSRVDT,FBPMT,FBNAME,FBP23,FBICD9,FBICDN,FBICDNM,FBVEN,DFN,FBAAOUT,FB
A,FBB,FBC,FBAMT,FBPTC,FBPAMT,FBTAMT,FBCTR,FBDT,FBCPT,FBNM,FBPCTR,FBPTC1,FBTPT,BE
GDT,BEGDATE,ENDDATE,J,Q,QQ
         K ^TMP($J,"FBAACR") D CLOSE^FBAAUTL
         Q
         ;
PRINT    S FBPTC1=""
         S:FBPTC="" FBPTC="99" F I=1:1:8 S J=$T(TEXT+I) I $P(J,";;",2)=FBPTC S F
BPTC1=$P(J,";;",3) Q
         W !,$E(FBNAME,1,20),"^",$$SSN^FBAAUTL(DFN,1),"^",$E(FBPTC1,1,16),"^",$E
(FBCPT,1,30),"^",$J($FN(FBAMT,",",2),10),"^",$P(FBPMT,"^",5),"^",$P(FBPMT,"^",6)
,"^",$P(FBPMT,"^",7),"^"
         Q
         ;
HED      W !,"V12 - North Chicago's Fee Basis Outpatient Cost Report ",$$DATX^FB
AAUTL(BEGDATE)," through ",$$DATX^FBAAUTL(ENDDATE),"^"
         W !,"^","Patient","^","Treating","^"
         W !,"Patient Name","^","ID","^","Specialty","^","CPT Code","^","Amount
Paid","^","ICD #","^","ICD Diagnosis","^","Vendor","^"
         Q
FBP23    S (FBICD9,FBICDN,FBICDNM)=""
         S FBP23=$P(FBPMT,"^",23) I FBP23]"" D  ;
         . S FBICD9=^ICD9(FBP23,0)
         . S FBICDN=$P(FBICD9,"^",1)   ; 7 Length ICD Code Number
         . S FBICDNM=$P(FBICD9,"^",3)  ;30 Length ICD Diagnosis Name
         Q
FBVEN    S FBVEN=$P(^FBAAV(FBA,0),"^",1)  ;46 Length Vendor Name
         Q
         ;
TEXT     ;
         ;;00;;SURGICAL
         ;;10;;MEDICAL
         ;;60;;HOME NURSING SERVICE
         ;;85;;PSYCHIATRIC-CONTRACT
         ;;86;;PSYCHIATRIC
         ;;95;;NEUROLOGICAL-CONTRACT
         ;;96;;NEUROLOGICAL
         ;;99;;UNKNOWN