source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBPHON2.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1FBPHON2 ;AISC/CMR-LIST PAYMENTS CONT. ;4/17/2000
2 ;;3.5;FEE BASIS;**4,21,77**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 D FULL^VALM1
5EN N FBI,FBX,FBAAOUT,Q S Q="-",$P(Q,"-",80)="-",FBAAOUT=0,VALMBCK="R"
6 D SEL^VALM2 G END:'$O(VALMY(0))
7 S FBI=0 F S FBI=$O(VALMY(FBI)) Q:'FBI I $D(^TMP("FBPHIDX",$J,FBI)) S FBX=^(FBI) D @FBPR I '$G(FBAAOUT) S DIR(0)="E",DIR("A")="Press 'ENTER' to "_$S($O(VALMY(FBI)):"view next selection",1:"return to list") D ^DIR K DIR Q:'Y
8 Q
9END S VALMBCK="R" Q
10BT ;display batch for chosen line item
11 W @IOF N B
12 S B=$P(FBX,U,8) I B']"" D ERR Q
13 I $D(^FBAA(161.7,B,0)) S FBTYPE=$P(^FBAA(161.7,B,0),U,3)
14 D ENM^FBAACCB:FBTYPE="B3",ENP^FBAACCB:FBTYPE="B5",ENT^FBAACCB0:FBTYPE="B2",PRTC^FBAACCB1:FBTYPE="B9"
15 Q
16INV ;display invoice for chosen line item
17 W @IOF N FBAAIN,FBAAOUT,FBINTOT,J,DA,FBI
18 I $P(FBX,U,7)']"" D ERR Q
19 I $P(FBX,U)="PHAR" S DA=$P(FBX,U,7) D START^FBAAPII Q
20 I $P(FBX,U)="CH"!($P(FBX,U)="CNH") S FBI=$P(FBX,U,7) D START^FBCHDI2 Q
21 I $P(FBX,U)="OPT" D D Q^FBAAPIN
22 .S FBAAIN=$P(FBX,U,7),(FBAAOUT,FBINTOT,J)=0 F S J=$O(^FBAAC("C",FBAAIN,J)) Q:'J!(FBAAOUT) D MMORE^FBAAPIN
23 D Q^FBAAPIN
24 Q
25BS ;display batch status for chosen line item
26 W @IOF N DA
27 I $P(FBX,U,8)']"" D ERR Q
28 S DA=$P(FBX,U,8) D START^FBAABS
29 Q
30DV ;display vendor demographics for chosen vendor
31 N DA S VALMBCK="R"
32 S DA=FBV D CLEAR^VALM1,EN1^FBAAVD
33 I $D(^XUSEC("FBAA ESTABLISH VENDOR",DUZ)) S DIR(0)="Y",DIR("A")="Want to Edit data",DIR("B")="NO" D ^DIR K DIR Q:$D(DIRUT) D:Y EDITV^FBAAVD
34 I '$D(^XUSEC("FBAA ESTABLISH VENDOR",DUZ)) S DIR(0)="E" D ^DIR K DIR
35 D Q^FBAAVD Q
36DA ;display patient auth for selected line item
37 W @IOF N FB1,FBDA,FBTYP
38 S FBDA=$P(FBX,U,9)
39 I $P(FBX,U)="OPT" S FB1=$P(^FBAAC(DFN,1,FBV,1,$P(FBDA,",",3),1,$P(FBDA,",",4),0),U,13) D Q
40 .I FB1']"" S FBPROG=$P(^FBAAC(DFN,1,FBV,1,$P(FBDA,",",3),0),U,4),FBPROG=$S(FBPROG:"I FBI="_FBPROG,1:""),PI="" D ^FBAADEM K FBPROG,FBAUT,PI Q
41 .I FB1["583" D UNAUTH Q
42 .I FB1["7078" D INP Q
43 I $P(FBX,U)="PHAR" S FB1=$P(^FBAA(162.1,+FBDA,"RX",$P(FBDA,",",2),2),U,6) D Q
44 .I FB1']"" S FBPROG=$P($G(^FBAA(162.1,+FBDA,"RX",$P(FBDA,",",2),2)),U,7),FBPROG=$S(FBPROG:"I FBI="_FBPROG,1:""),PI="" D ^FBAADEM K FBPROG,FBAUT,PI Q
45 .I FB1["583" D UNAUTH Q
46 .I FB1["7078" D INP Q
47 I $P(FBX,U)["C" S FB1=$P(^FBAAI(+FBDA,0),U,5) I FB1["583" D UNAUTH Q
48INP N DA,FBDA,DIC,DR S (FBDA,DA)=+FB1,DIC="^FB7078(",DR="0;1" W @IOF D EN^DIQ
49 I $$DISCH^FBCH780(FBDA)]"" W ?2,"DISCHARGE TYPE: ",$$DISCH^FBCH780(FBDA)
50 Q
51UNAUTH N DA,DIC,DR S DA=+FB1,DIC="^FB583(",DR="0;1" W @IOF D EN^DIQ
52 Q
53EV ;expand view
54 W @IOF N FBZ S FBZ=$P(FBX,U,9)
55 I $P(FBX,U)="OPT" S DIC="^FBAAC("_DFN_",1,"_FBV_",1,"_$P(FBZ,",",3)_",1,",DA(3)=DFN,DA(2)=FBV,DA(1)=$P(FBZ,",",3),DA=$P(FBZ,",",4),DR=""
56 I $P(FBX,U)="PHAR" S DIC="^FBAA(162.1,"_+FBZ_",""RX"",",DA(1)=+FBZ,DA=$P(FBZ,",",2),DR=""
57 I $P(FBX,U)["C" S DIC="^FBAAI(",DA=FBZ,DR=""
58 W @IOF D EN^DIQ
59 K DIC,DA,DR
60 Q
61CP ;change patient
62 D CLEAR^VALM1
63 N FBCP S VALMBCK="R"
64 S DIR(0)="P^161:EMZ",DIR("A")="Payments for veteran" D ^DIR K DIR I $D(DIRUT) Q
65 S DFN=+Y,FBCP=1 D HDR^FBPHON,START^FBPHON
66 Q
67CV ;change vendor
68 D CLEAR^VALM1
69 N FBCP S VALMBCK="R"
70 S DIR(0)="P^161.2:EMZ" D ^DIR K DIR Q:$D(DIRUT)
71 S FBV=+Y,FBCP=1 D HDR^FBPHON,START^FBPHON
72 Q
73DC ;display check
74 W @IOF S FBCN=$P(FBX,U,11) I FBCN']"" W !,*7,"No check found for this line item." Q
75 D START^FBCKDIS
76 Q
77CD ;display CPT/MOD description
78 W @IOF
79 N FBCPT,FBJ,FBMOD,FBMODX
80 Q:$P(FBX,U)'="OPT"!($P(FBX,U,3)']"")
81 S FBCPT=$P(FBX,U,3) W !,"Line item #",FBI,!?5,"CPT: ",$P(FBCPT,"-"),?18,$P($$CPT^ICPTCOD($P(FBCPT,"-"),$S(+$P(FBX,U,2)>0:+$P(FBX,U,2),1:""),1),U,3)
82 I FBCPT["-" F FBJ=1:1 S FBMOD=$P($P(FBCPT,"-",2),",",FBJ) Q:FBMOD="" D
83 . W !?5,"MOD: ",FBMOD
84 . S FBMODX=$$MOD^ICPTMOD(FBMOD,"E",$P(FBX,U,2))
85 . ; if modifier data not obtained then try another API to resolve it
86 . ; since there can be duplicate modifiers with same external value
87 . I $P(FBMODX,U)'>0 D
88 . . N FBY
89 . . S FBY=$$MODP^ICPTMOD($P(FBCPT,"-"),FBMOD,"E",$P(FBX,U,2))
90 . . I $P(FBY,U)>0 S FBMODX=$$MOD^ICPTMOD($P(FBY,U),"I",$P(FBX,U,2))
91 . W ?18,$S($P(FBMODX,U)>0:$P(FBMODX,U,3),1:"")
92 Q
93ERR ;
94 W !,"No ",$S(FBPR["B":"batch",1:"invoice")," number on file for this entry" Q
Note: See TracBrowser for help on using the repository browser.