| [613] | 1 | FBPHON1 ;AISC/CMR-LIST PAYMENTS CONT. ;5/13/1999
|
|---|
| 2 | ;;3.5;FEE BASIS;**4,69**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | GATHER(DFN,FBV) ;gather vendor/veteran specific payment info
|
|---|
| 5 | ;required input DFN = veteran ien
|
|---|
| 6 | ; FBV = vendor ien
|
|---|
| 7 | ;output ^TMP($J,"FBPHON", containing pmnts for all programs
|
|---|
| 8 | N FBCNT,FBI,FBJ,FBK,FBSDI,FBAADT,FBAACPI,FBX,FBMODLE,FBXAD,FBXADJC
|
|---|
| 9 | Q:'$G(DFN)!('$G(FBV))
|
|---|
| 10 | S FBCNT=0
|
|---|
| 11 | OPT ;gather opt payments
|
|---|
| 12 | S FBSDI=0 F S FBSDI=$O(^FBAAC(DFN,1,FBV,1,FBSDI)) Q:'FBSDI S FBAADT=+^(FBSDI,0),FBAACPI=0 F S FBAACPI=$O(^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI)) Q:'FBAACPI D
|
|---|
| 13 | .S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,"_FBAACPI_",""M"")","E")
|
|---|
| 14 | .S FBX=^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI,0),FBFL=$S($P(FBX,U,20)="R":"*",1:""),FBFL=FBFL_$S($P(FBX,U,21)="VP":"#",1:""),FBCNT=FBCNT+1
|
|---|
| 15 | .S FBXAD=$$ADJLRA^FBAAFA(FBAACPI_","_FBSDI_","_FBV_","_DFN_",")
|
|---|
| 16 | .S FBXADJC=$P(FBXAD,U,1) ;Adjustment code list
|
|---|
| 17 | .I FBXADJC["," S FBXADJC=$P(FBXADJC,",",1)_"&" ;More than one adj code
|
|---|
| 18 | .I FBXADJC="" S FBXADJC=$P(FBX,U,5) ;No adj codes use Suspense code
|
|---|
| 19 | .S ^TMP($J,"FBPHON",-FBAADT,FBCNT)="OPT"_"^"_FBAADT_"^"_$$CPT^FBAAUTL4(+FBX)_$S($G(FBMODLE)]"":"-"_FBMODLE,1:"")_"^"_$P(FBX,U,2)_"^"_$P(FBX,U,3)_"^"_FBXADJC_"^"_$P(FBX,U,16)_"^"_$P(FBX,U,8)_"^"_DFN_","_FBV_","_FBSDI_","_FBAACPI_"^"_FBFL
|
|---|
| 20 | .K FBX,FBFL
|
|---|
| 21 | K FBSDI,FBAACPI,FBAADT
|
|---|
| 22 | INP ;gather inpt payments
|
|---|
| 23 | S FBI=0 F S FBI=$O(^FBAAI("AK",DFN,FBV,FBI)) Q:'FBI I $D(^FBAAI(FBI,0)) S FBX=^FBAAI(FBI,0),FBCNT=FBCNT+1,FBFL=$S($P(FBX,U,13)="R":"*",1:""),FBFL=FBFL_$S($P(FBX,U,14)="VP":"#",1:"") D
|
|---|
| 24 | .S FBXAD=$$ADJLRA^FBCHFA(FBI_",")
|
|---|
| 25 | .S FBXADJC=$P(FBXAD,U)
|
|---|
| 26 | .I FBXADJC["," S FBXADJC=$P(FBXADJC,",",1)_"&" ;More than one adj code
|
|---|
| 27 | .I FBXADJC="" S FBXADJC=$P(FBX,U,11) ;No adj codes use Suspense code
|
|---|
| 28 | .S ^TMP($J,"FBPHON",-$P(FBX,U,6),FBCNT)=$S($P(FBX,U,12)=6:"CH",$P(FBX,U,12)=7:"CNH",1:"")_"^"_$P(FBX,U,6)_"-"_$P(FBX,U,7)_"^^"_$P(FBX,U,8)_"^"_$P(FBX,U,9)_"^"_FBXADJC_"^"_+FBX_"^"_$P(FBX,U,17)_"^"_FBI_"^"_FBFL
|
|---|
| 29 | .K FBX,FBFL
|
|---|
| 30 | K FBI
|
|---|
| 31 | PHARM ;gather pharm payments
|
|---|
| 32 | S FBAADT=0 F S FBAADT=$O(^FBAA(162.1,"AD",DFN,FBAADT)) Q:'FBAADT S FBI=0 F S FBI=$O(^FBAA(162.1,"AD",DFN,FBAADT,FBI)) Q:'FBI I $D(^FBAA(162.1,"AN",FBV,FBI)) D
|
|---|
| 33 | .S FBJ=0 F S FBJ=$O(^FBAA(162.1,"AD",DFN,FBAADT,FBI,FBJ)) Q:'FBJ I $D(^FBAA(162.1,FBI,"RX",FBJ,0)) S FBX=^(0),FBFL=$S($P(FBX,U,20)="R":"*",1:""),FBFL=FBFL_$S($P($G(^FBAA(162.1,FBI,"RX",FBJ,2)),U,3)="VP":"#",1:"") D
|
|---|
| 34 | ..S FBCNT=FBCNT+1
|
|---|
| 35 | ..S FBXAD=$$ADJLRA^FBRXFA(FBJ_","_FBI_",")
|
|---|
| 36 | ..S FBXADJC=$P(FBXAD,U,1) ;Adjustment code list
|
|---|
| 37 | ..I FBXADJC["," S FBXADJC=$P(FBXADJC,",",1)_"&" ;More than one adj code
|
|---|
| 38 | ..I FBXADJC="" S FBXADJC=$P(FBX,U,8)
|
|---|
| 39 | ..S ^TMP($J,"FBPHON",-(9999999-FBAADT),FBCNT)="PHAR^"_(9999999-FBAADT)_"^"_$P(FBX,U)_"^"_$P(FBX,U,4)_"^"_$P(FBX,U,16)_"^"_FBXADJC_"^"_+$G(^FBAA(162.1,FBI,0))_"^"_$P(FBX,U,17)_"^"_FBI_","_FBJ_"^"_FBFL
|
|---|
| 40 | .K FBX,FBFL
|
|---|
| 41 | K FBAADT,FBI,FBJ
|
|---|
| 42 | Q
|
|---|
