source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP6.m@ 1713

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1IBCEP6 ;ALB/TMP - PROVIDER ID MAINT menu and INS CO EDIT hook ;11-02-00
2 ;;2.0;INTEGRATED BILLING;**137,232,320,377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; -- main entry point
6 N IBRESP
7 D FULL^VALM1
8 F Q:'$$MENU(.IBRESP) D @IBRESP
9ENQ ;
10 Q
11 ;
12EN1 ; Provider maintenance from the billing screen 8
13 N DIR,X,Y,IBEDIT
14 W !
15 I '$D(^XUSEC("IB PROVIDER EDIT",DUZ)) S DIR(0)="EA",DIR("A")="Press ENTER to continue: ",DIR("A",1)="YOU LACK THE SECURITY KEY FOR THIS ACTION" D ^DIR K DIR Q
16 D EN
17 Q
18 ;
19PO ; provider's own IDs
20 N IBPRV,IBINS
21 N IBSLEV,DIR,Y,X,IBPRMPT,IBNVAFL,IBIF
22 K IBFASTXT
23 S IBIF=""
24 S IBPRMPT="PROVIDER"
25 D FULL^VALM1
26 S IBSLEV=1
27 D EN^VALM("IBCE PRVPRV MAINT")
28POX ;
29 Q
30 ;
31PI ; provider's IDs provided by an insurance company
32 N IBPRV,IBINS
33 N IBSLEV,DIR,Y,X,IBPRMPT,IBNVAFL,IBIF
34 K IBFASTXT
35 S IBIF=""
36 S IBPRMPT="PROVIDER"
37 D FULL^VALM1
38 S IBSLEV=2
39 D EN^VALM("IBCE PRVPRV MAINT")
40PIX ;
41 Q
42 ;
43BI ; Insurance company batch ID entry
44 D EN^IBCEP9
45BIX ;
46 Q
47 ;
48II ; Insurance company IDs
49 D EN^IBCEP0
50IIX ;
51 Q
52 ;
53CP ; Care Unit maintenance - performing providers
54 N IBINS,IBALL,IB95
55 N IBSLEV,DIR,Y
56 K IBFASTXT
57 D FULL^VALM1
58 S IBSLEV=1
59 D EN^VALM("IBCE PRVCARE UNIT MAINT")
60CPX ;
61 Q
62 ;
63CB ; Care Unit maintenance - billing provider
64 N IBINS,IBALL,IB95
65 N IBSLEV,DIR,Y
66 K IBFASTXT
67 D FULL^VALM1
68 S IBSLEV=2
69 D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT")
70CBX ;
71 Q
72 ;
73NP ; non-VA individual provider information
74 N IBNVPMIF
75 S IBNVPMIF="I"
76 D EN^IBCEP8
77NPX ;
78 Q
79 ;
80NF ; non-VA facility provider information
81 N IBNVPMIF
82 S IBNVPMIF="F"
83 D EN^IBCEP8
84NFX ;
85 Q
86 ;
87MENU(IBSEL) ; display main provider ID maintenance menu and receive response from user
88 ; function value returns 0 if user exits from menu or "^" out
89 ; function value returns 1 otherwise
90 ; IBSEL is the internal value of the user's selection if any (pass by reference)
91 N IBQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,C,Z
92 N IORESET,IORVON,IORVOFF,IOUON,IOUOFF,IOINHI,IOINLOW,IOINORM
93 S IBQ=1,IBSEL=""
94 S X="IORESET;IORVON;IORVOFF;IOUON;IOUOFF;IOINHI;IOINLOW;IOINORM"
95 D ENDR^%ZISS
96 ;
97 S $P(DIR(0),U,1)="SOA"
98 S $P(Z,";",1)="PO:Provider Own IDs"
99 S $P(Z,";",2)="PI:Provider Insurance IDs"
100 S $P(Z,";",3)="BI:Batch ID Entry"
101 S $P(Z,";",4)="II:Insurance Co IDs"
102 S $P(Z,";",5)="CP:Care Units for Providers"
103 S $P(Z,";",6)="CB:Care Units for Billing Provider"
104 S $P(Z,";",7)="NP:Non-VA Provider"
105 S $P(Z,";",8)="NF:Non-VA Facility"
106 ;
107 S $P(DIR(0),U,2)=Z
108 ;
109 S DIR("L",1)=" "_IOINHI_"Provider IDs"_IOINORM
110 S DIR("L",2)=" "_$P($P(Z,";",1),":",1)_" "_$P($P(Z,";",1),":",2)
111 S DIR("L",3)=" "_$P($P(Z,";",2),":",1)_" "_$P($P(Z,";",2),":",2)
112 S DIR("L",4)=""
113 S DIR("L",5)=" "_IOINHI_"Insurance IDs"_IOINORM
114 S DIR("L",6)=" "_$P($P(Z,";",3),":",1)_" "_$P($P(Z,";",3),":",2)
115 S DIR("L",7)=" "_$P($P(Z,";",4),":",1)_" "_$P($P(Z,";",4),":",2)
116 S DIR("L",8)=""
117 S DIR("L",9)=" "_IOINHI_"Care Units"_IOINORM
118 S DIR("L",10)=" "_$P($P(Z,";",5),":",1)_" "_$P($P(Z,";",5),":",2)
119 S DIR("L",11)=" "_$P($P(Z,";",6),":",1)_" "_$P($P(Z,";",6),":",2)
120 S DIR("L",12)=""
121 S DIR("L",13)=" "_IOINHI_"Non-VA Items"_IOINORM
122 S DIR("L",14)=" "_$P($P(Z,";",7),":",1)_" "_$P($P(Z,";",7),":",2)
123 S DIR("L")=" "_$P($P(Z,";",8),":",1)_" "_$P($P(Z,";",8),":",2)
124 ;
125 S DIR("?")="^D MENH^IBCEP6"
126 S DIR("A")=" Select Provider ID Maintenance Option: "
127 ;
128 ; paint the screen and display menu first time in
129 D MENH
130 W !
131 S C=0 F S C=$O(DIR("L",C)) Q:'C W !,DIR("L",C)
132 W !,DIR("L"),!
133 D ^DIR K DIR W !
134 I $D(DIRUT) S IBQ=0 G MENUX
135 S IBSEL=Y
136 I IBSEL="" S IBQ=0
137MENUX ;
138 Q IBQ
139 ;
140MENH ; menu help
141 W @IOF,!?4,"Provider ID Maintenance Main Menu"
142 W !!?4,"Enter a code from the list."
143MENHX ;
144 Q
145 ;
Note: See TracBrowser for help on using the repository browser.