| 1 | FBUCOUT1 ;ALBISC/TET - OUTPUTS cont'd ;6/27/2001
|
|---|
| 2 | ;;3.5;FEE BASIS;**32**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ONE ;display/print all claims for one vendor/veteran/other party
|
|---|
| 5 | ;sort by treatment from/to dates, group by master claim
|
|---|
| 6 | ;sort by vendor if vet or other selected, otherwise veteran
|
|---|
| 7 | ;'*' denotes secondary claim
|
|---|
| 8 | N FBI,FBIEN,FBIX,FBMC,FBOIEN,FBPTR,FBSORT,FBZ S (FBVEN,FBVET,FBOTH)=""
|
|---|
| 9 | D IEN^FBUCUTL3 G END:'FBIEN
|
|---|
| 10 | ; ask if report for just mill-bill (1725) or just non-mill bill claims
|
|---|
| 11 | S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
|
|---|
| 12 | I FBIX="AOMS" S FBOIEN=FBIEN,FBOTH=$P($G(^VA(200,FBOIEN,0)),U),FBIEN=+$P($$FBZ^FBUCUTL(+$O(^FB583(FBIX,FBOIEN,0))),U,4)
|
|---|
| 13 | S:FBIX'="AVMS" FBVET=$P($G(^DPT(FBIEN,0)),U) S:FBIX="AVMS" FBVEN=$P($G(^FBAAV(FBIEN,0)),U)
|
|---|
| 14 | Q ;que to print
|
|---|
| 15 | S:FBIX="AOMS" FBIEN=FBOIEN S VAR="FBIX^FBIEN^FBVEN^FBVET^FBOTH^FB1725R",VAL=VAR,PGM="SORT^FBUCOUT1" D ZIS^FBAAUTL G:FBPOP END
|
|---|
| 16 | SORT ;sort all claims output
|
|---|
| 17 | U IO K ^TMP("FB",$J) N FBI,FBMC,FBZ
|
|---|
| 18 | S FBMC="" F S FBMC=$O(^FB583(FBIX,FBIEN,FBMC)) Q:FBMC']"" S FBI=0 F S FBI=$O(^FB583("AMC",+FBMC,FBI)) Q:'FBI S FBZ=$G(^FB583(FBI,0)) I FBZ]"" D
|
|---|
| 19 | .; if user requested just mill-bill (1725) or non-mill bill claims then
|
|---|
| 20 | .; check claim and skip when appropriate
|
|---|
| 21 | .Q:$S(FB1725R="M"&'+$P(FBZ,U,28):1,FB1725R="N"&+$P(FBZ,U,28):1,1:0)
|
|---|
| 22 | .N FBPTR,FBSORT,NODE S FBPTR=$S(FBIX="AVMS":$P(FBZ,U,4),1:$P(FBZ,U,3))
|
|---|
| 23 | .S FBSORT=$P($$PTR^FBUCUTL($S(FBIX="AVMS":"^DPT(",1:"^FBAAV("),FBPTR),U) I FBIX="AVMS" S FBSORT=$E(FBSORT,1,30)
|
|---|
| 24 | .S NODE=$E($P($$PROG^FBUCUTL(+$P(FBZ,U,2)),U),1,15)_U_$E($P($$PTR^FBUCUTL("^FB(162.92,",$P(FBZ,U,24)),U),1,20) I "^40^70^90^"[$$ORDER^FBUCUTL($P(FBZ,U,24)) S NODE=NODE_U_$$CODE^FBUCOUT($P(FBZ,U,11))
|
|---|
| 25 | .S ^TMP("FB",$J,+$P(FBZ,U,5)_";"_+$P(FBZ,U,6),+FBMC_$S(+FBMC=FBI:"P",1:"S")_";"_FBI,$S(+FBMC=FBI:"",1:" *")_FBSORT_";"_FBPTR)=NODE
|
|---|
| 26 | .S FBMC=+FBMC_"z"
|
|---|
| 27 | PRINT ;print all claims output
|
|---|
| 28 | N DIRUT,DTOUT,DUTOUT,FBCRT,FBDASH,FBDT,FBHDR,FBMC,FBN,FBNODE,FBOMC,FBOUT,FBPG
|
|---|
| 29 | S FBHDR=$S(FBIX="AVMS":"VENDOR: "_FBVEN,FBIX="APMS":"VETERAN: "_FBVET,1:"OTHER PARTY: "_FBOTH),FBPG=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBOUT=0,$P(FBDASH,"=",80)="" D PAGE
|
|---|
| 30 | S FBOMC=0,FBDT=""
|
|---|
| 31 | F S FBDT=$O(^TMP("FB",$J,FBDT)) Q:FBDT']""!(FBOUT) S FBMC="" F S FBMC=$O(^TMP("FB",$J,FBDT,FBMC)) Q:FBMC']"" W:+FBOMC'=+FBMC !! S FBOMC=FBMC D Q:FBOUT
|
|---|
| 32 | .S FBN="" F S FBN=$O(^TMP("FB",$J,FBDT,FBMC,FBN)) Q:FBN']"" S FBNODE=$G(^TMP("FB",$J,FBDT,FBMC,FBN)) D Q:FBOUT
|
|---|
| 33 | ..I IOSL<($Y+5) D PAGE Q:FBOUT
|
|---|
| 34 | ..W !,$P(FBN,";"),?34,$P(FBNODE,U),?53,$P(FBNODE,U,2),?75,$P(FBNODE,U,3)
|
|---|
| 35 | ..W !?3,"Treatment From: ",$$DATX^FBAAUTL($P(FBDT,";")),?29,"Treatment To: ",$$DATX^FBAAUTL($P(FBDT,";",2))
|
|---|
| 36 | ..I FBIX="AOMS" W ?54,"VETERAN: ",$E($$VET^FBUCUTL(+$P($$FBZ^FBUCUTL(+$P(FBMC,";",2)),U,4)),1,16)
|
|---|
| 37 | END ;kill variables,tmp global and quit
|
|---|
| 38 | K FBIEN,FBIX,FBOTH,FBPOP,FBVEN,FBVET,PGM,POP,VAL,VAR,^TMP("FB",$J),FB1725R
|
|---|
| 39 | D CLOSE^FBAAUTL
|
|---|
| 40 | Q
|
|---|
| 41 | PAGE ;write new page
|
|---|
| 42 | D:FBCRT&(FBPG>0) CR Q:FBOUT
|
|---|
| 43 | HDR W:FBCRT!(FBPG>0) @IOF S FBPG=FBPG+1
|
|---|
| 44 | W !,FBHDR,!?70,"Page: ",FBPG,!,$S(FBIX="AVMS":"Veteran",1:"Vendor"),?34,"Fee Program",?53,"Status",?75,"Code",!,FBDASH
|
|---|
| 45 | Q
|
|---|
| 46 | CR ;ask end of page prompt
|
|---|
| 47 | ;OUTPUT: FBOUT is set if time out or up arrow out
|
|---|
| 48 | W ! S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1
|
|---|
| 49 | Q
|
|---|
