| [613] | 1 | FBCKDIS1 ;AISC/CMR - OUTPUT BY CHECK # cont. ;20APR94
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D OPT,INPT,PHARM,TRAV
|
|---|
| 5 | Q
|
|---|
| 6 | OPT ;find outpatient payments for check #
|
|---|
| 7 | Q:'$D(^FBAAC("ACK",FBCN))
|
|---|
| 8 | S FBPROG="OPT",FBCNT=0
|
|---|
| 9 | S FB1=0 F S FB1=$O(^FBAAC("ACK",FBCN,FB1)) Q:'FB1 S FB2=0 F S FB2=$O(^FBAAC("ACK",FBCN,FB1,FB2)) Q:'FB2 S FB3=0 F S FB3=$O(^FBAAC("ACK",FBCN,FB1,FB2,FB3)) Q:'FB3 S FB4=0 F S FB4=$O(^FBAAC("ACK",FBCN,FB1,FB2,FB3,FB4)) Q:'FB4 D
|
|---|
| 10 | .Q:$S('$D(^FBAAC(FB1,1,FB2,1,FB3,1,FB4,0)):1,'$D(^FBAAC(FB1,1,FB2,1,FB3,1,FB4,2)):1,'$D(^FBAAC(FB1,1,FB2,1,FB3,0)):1,1:0)
|
|---|
| 11 | .S FBCNT=FBCNT+1,FBDA=FB1_"^"_FB2_"^"_FB3_"^"_FB4,DFN=FB1,FBV=FB2
|
|---|
| 12 | .D SETMP
|
|---|
| 13 | D CLN Q
|
|---|
| 14 | INPT ;find inpatient payments for check #
|
|---|
| 15 | Q:'$D(^FBAAI("ACK",FBCN))
|
|---|
| 16 | S (FBCNTCH,FBCNTCNH)=0
|
|---|
| 17 | S FB1=0 F S FB1=$O(^FBAAI("ACK",FBCN,FB1)) Q:'FB1 D
|
|---|
| 18 | .Q:$S('$D(^FBAAI(FB1,0)):1,'$D(^FBAAI(FB1,2)):1,1:0)
|
|---|
| 19 | .S FBA=^FBAAI(FB1,0),DFN=$P(FBA,U,4),FBV=$P(FBA,U,3)
|
|---|
| 20 | .S FBPROG=$S($P(FBA,U,12)=6:"CH",$P(FBA,U,12)=7:"CNH",1:"") Q:FBPROG']""
|
|---|
| 21 | .I FBPROG="CH" S FBCNTCH=FBCNTCH+1,FBCNT=FBCNTCH
|
|---|
| 22 | .I FBPROG="CNH" S FBCNTCNH=FBCNTCNH+1,FBCNT=FBCNTCNH
|
|---|
| 23 | .S FBDA=FB1
|
|---|
| 24 | .D SETMP
|
|---|
| 25 | D CLN Q
|
|---|
| 26 | PHARM ;find pharmacy payments for check #
|
|---|
| 27 | Q:'$D(^FBAA(162.1,"ACK",FBCN))
|
|---|
| 28 | S FBCNT=0,FBPROG="PHAR"
|
|---|
| 29 | S FB1=0 F S FB1=$O(^FBAA(162.1,"ACK",FBCN,FB1)) Q:'FB1 S FB2=0 F S FB2=$O(^FBAA(162.1,"ACK",FBCN,FB1,FB2)) Q:'FB2 D
|
|---|
| 30 | .Q:$S('$D(^FBAA(162.1,FB1,"RX",FB2,0)):1,'$D(^FBAA(162.1,FB1,"RX",FB2,2)):1,'$D(^FBAA(162.1,FB1,0)):1,1:0)
|
|---|
| 31 | .S FBCNT=FBCNT+1
|
|---|
| 32 | .S FBA=^FBAA(162.1,FB1,"RX",FB2,0),DFN=$P(FBA,U,5),FBV=$P(^FBAA(162.1,FB1,0),U,4)
|
|---|
| 33 | .S FBDA=FB1_"^"_FB2
|
|---|
| 34 | .D SETMP
|
|---|
| 35 | D CLN Q
|
|---|
| 36 | TRAV ;find travel payments for check #
|
|---|
| 37 | Q:'$D(^FBAAC("ACKT",FBCN))
|
|---|
| 38 | S FBCNT=0,FBPROG="TRAV"
|
|---|
| 39 | S FB1=0 F S FB1=$O(^FBAAC("ACKT",FBCN,FB1)) Q:'FB1 S FB2=0 F S FB2=$O(^FBAAC("ACKT",FBCN,FB1,FB2)) Q:'FB2 D
|
|---|
| 40 | .Q:'$D(^FBAAC(FB1,3,FB2,0))
|
|---|
| 41 | .S FBCNT=FBCNT+1
|
|---|
| 42 | .S DFN=FB1,FBV="R"
|
|---|
| 43 | .S FBDA=FB1_"^"_FB2
|
|---|
| 44 | .D SETMP
|
|---|
| 45 | D CLN Q
|
|---|
| 46 | SETMP ;set up tmp global
|
|---|
| 47 | S ^TMP($J,"FBCK",FBPROG,FBV,DFN,FBCNT)=FBDA
|
|---|
| 48 | Q
|
|---|
| 49 | CLN K FB1,FB2,FB3,FB4,FBA,FBCNT,DFN,FBCNTCH,FBCNTCNH,FBPROG Q
|
|---|
| 50 | SUSP ;get suspense code
|
|---|
| 51 | S FBSUSP=$S(FBSUSP="":"",$D(^FBAA(161.27,FBSUSP,0)):^FBAA(161.27,FBSUSP,0),1:"")
|
|---|
| 52 | Q
|
|---|
