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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1IBCEP0A ;ALB/TMP - EDI UTILITIES for insurance assigned provider ID ;01-NOV-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 ;
5NEW(IBINS,IBPRV,IBPTYP,IBDEF) ; Add new insurance co assigned id
6 ; IBDEF = flag sent as 1 if only insurance co defaults are being added
7 N DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IBQ,IBIEN,IBCUND,DTOUT,DUOUT
8 D FULL^VALM1
9 S IBQ=0
10 I $G(IBDEF)="D" W !!,"YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",!
11 I '$G(IBPRV),$G(IBDEF)'="D" D G:IBQ NEWQ
12 . N DA,IBO
13 . S IBO=($G(IBDSP)'="I")
14 . S DIR(0)="355.9,.01A"_$S(IBO:"O",1:""),DIR("A")="Select PROVIDER"_$S(IBO:" (optional)",1:"")_": "
15 . S DIR("?")="Select the PROVIDER to be assigned a provider ID"
16 . I IBO S DIR("?",1)=DIR("?"),DIR("?")="Or Press ENTER to add an insurance co level default id (all providers)"
17 . W ! D ^DIR K DIR W !
18 . I $D(DTOUT)!$D(DUOUT) S IBQ=1 Q
19 . S IBPRV=$S(Y>0:$P(Y,U),1:"")
20 . Q:IBPRV
21 . S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",DIR("A")="IS THIS OK?: "
22 . W ! D ^DIR K DIR W !
23 . I $D(DTOUT)!$D(DUOUT)!(Y'=1) S IBQ=1
24 . Q
25 ;
26 I '$G(IBPTYP) D G:IBQ NEWQ
27 . S DIR(0)="PAr^355.97:AEMQ",DIR("A")="Select Provider ID Qualifier: "
28 . S DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
29 . S DIR("S")="I $$RAINS^IBCEPU(Y)" ; Rendering/Attending IDs provided by ins
30 . S DA=0
31 . W ! D ^DIR K DIR W !
32 . I $D(DTOUT)!$D(DUOUT)!'Y S IBQ=1 Q
33 . S IBPTYP=+Y
34 ;
35 S IBQ=$$ADDID(IBINS,IBPRV,IBPTYP)
36 ;
37NEWQ D:'$G(IBQ) BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
38 S VALMBCK="R"
39 Q
40 ;
41DEL1 ; Delete Insurance Co assigned provider ID's
42 ; IBPRV = vp ien of provider if editing entry in file 355.9
43 ; otherwise, null
44 N IB1,IBDA,IBFILE
45 D FULL^VALM1
46 D SEL^IBCEP0(.IBDA)
47 G:'$O(IBDA(0)) DEL1Q
48 S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
49 G:'IBDA DEL1Q
50 S IB1=$P(IBDA,U,2),IBDA=+IBDA
51 S IBFILE=$S(IB1:355.9,1:355.91)
52 I IBDA>0 D DEL^IBCEP5B(IBFILE,IBDA,1),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
53 ;
54DEL1Q S VALMBCK="R"
55 Q
56 ;
57CHG1 ; Edit Provider ID's
58 N IBDA,IB1,IBFILE
59 D FULL^VALM1
60 D SEL^IBCEP0(.IBDA)
61 G:'$O(IBDA(0)) CHG1Q
62 S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
63 G:'IBDA CHG1Q
64 S IB1=$P(IBDA,U,2),IBDA=+IBDA
65 S IBFILE=$S(IB1:355.9,1:355.91)
66 I IBDA>0 D
67 . I IBFILE=355.9 W !!,"PROVIDER: ",$$EXPAND^IBTRE(355.9,.01,IB1)
68 . I IBFILE'=355.9 W !!," <<INS CO DEFAULT>>"
69 . D CHG^IBCEP5B(IBFILE,IBDA),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
70 ;
71CHG1Q S VALMBCK="R"
72 Q
73 ;
74PRVJMP(IBDSP) ; Navigate to a specific sort level in current LM list
75 ; (from insurance co option)
76 ; IBDSP = 'I', 'A' or 'D' to indicate format selected for display
77 ; ([P]ROVIDER, PROVIDER [T]YPE OR [I]NSURANCE DEFAULT)
78 ; Sets VALMBG = LINE # if a provider in list selected
79 ;
80 I $G(IBDSP)="I" D PRVNJMP(.VALMBG)
81 I $G(IBDSP)="D"!($G(IBDSP)="A") D PRVTJMP(.VALMBG)
82 S VALMBCK="R"
83 Q
84 ;
85PRVNJMP(VALMBG) ; Navigate to a specific provider name (from insurance co
86 ; option)
87 ;
88 N DIR,X,Y,DA
89 D FULL^VALM1
90 S DIR(0)="355.9,.01AO^^I '$D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Y)_U_$P(Y,U))) K X"
91 S DIR("?",1)="*** YOU MAY ONLY SELECT PROVIDERS INCLUDED IN THE CURRENT LIST ***",DIR("?",2)=" ",DIR("?",3)="SELECTING A PROVIDER WILL FORCE THE DISPLAY TO SKIP TO THE DATA FOR THAT",DIR("?")=" PROVIDER"
92 S DIR("A")="SELECT PROVIDER: "
93 S DIR("S")="N Z S Z=$P(^(0),U) I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Z)_U_Z))"
94 W ! D ^DIR K DIR W !
95 I Y>0,'$D(DTOUT),'$D(DUOUT) D
96 . N Z
97 . S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPRV",U_$$EXPAND^IBTRE(355.9,.01,$P(Y,U))_U_$P(Y,U)))
98 . I Z S VALMBG=Z Q
99 . S DIR(0)="EA",DIR("A",1)="THIS PROVIDER DOES NOT EXIST IN THE CURRENT DISPLAY",DIR("A")="PRESS THE ENTER KEY TO CONTINUE"
100 . W ! D ^DIR K DIR W !
101 Q
102 ;
103PRVTJMP(VALMBG) ; Navigate to a specific type of ID qualifier (from ins co option)
104 ;
105 N DIR,X,Y
106 D FULL^VALM1
107 S DIR(0)="PAO^355.97:AEMQ",DIR("A")="Select type of ID Qualifier: "
108 S DIR("?")="Select a type of ID Qualifier to display the IDs of that type."
109 S DIR("S")="I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPTYP"",+Y))"
110 W ! D ^DIR K DIR W !
111 I Y>0,'$D(DTOUT),'$D(DUOUT) D
112 . N Z
113 . S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPTYP",+Y))
114 . I Z S VALMBG=Z Q
115 . S DIR(0)="EA",DIR("A",1)="This type of ID Qualifier does not exist in the current display",DIR("A")="Press the Enter key to continue"
116 . W ! D ^DIR K DIR W !
117 Q
118 ;
119CHGINS ; Change insurance co being displayed, using the same or new params
120 ; Assumes IBINS exists = IEN of insurance co (file 36)
121 N IBINEW,IBSAVE,DIC,DA,Y,X,DIR
122 D FULL^VALM1
123 S DIC="^DIC(36,",DIC(0)="AEMQ" D ^DIC
124 S IBINEW=+Y
125 ;
126 I IBINEW>0,IBINS'=IBINEW D
127 . D COPYPROV^IBCEP5A(IBINS)
128 . S DIR(0)="YA",DIR("?")="IF YOU WANT TO CHANGE THE FORMAT OF THE DISPLAY, RESPOND NO HERE"
129 . S DIR("A")="DO YOU WANT TO DISPLAY THE NEW INS. CO IDS USING THE CURRENT DISPLAY FORMAT?: ",DIR("B")="YES" W ! D ^DIR W ! K DIR
130 . Q:Y'=1
131 . S IBSAVE("IBINS")=IBINS
132 . K ^TMP("IBPRV_INS_ID",$J),VALMHDR S VALMBG=1,IBINS=IBINEW
133 . I Y=1 D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT)) Q
134 . D INIT^IBCEP0
135 . I '$G(VALMQUIT) Q
136 . S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
137 S VALMBCK="R"
138 Q
139 ;
140CHGFMT ; Change format parameters for display
141 N IBSAVE
142 S IBSAVE("IBINS")=$G(IBINS)
143 D INIT^IBCEP0
144 I '$G(VALMQUIT) G CHGFMTQ
145 S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
146CHGFMTQ S VALMBCK="R"
147 Q
148 ;
149IPARAM ; Display Insurance co parameters and care unit requirements
150 ; Assumes IBINS exists = IEN of insurance co
151 N IBDSP,IBSORT,IBHOLD
152 D FULL^VALM1
153 S IBHOLD("IBINS")=$G(IBINS)
154 D EN^VALM("IBCE PRVINS PARAM DISPLAY")
155 S:$G(IBHOLD("IBINS"))'="" IBINS=IBHOLD("IBINS")
156 K VALMQUIT
157 S VALMBCK="R"
158 Q
159 ;
160ADDID(IBINS,IBPRV,IBPTYP) ; Adds a new ID for the provider and/or ins co
161 ; IBINS = ien of file 36
162 ; IBPRV = vp ien of file 355.9
163 ; IBPTYP = ien of file 355.97
164 ; FUNCTION returns 1 if record not added, 0 if filed OK
165 N IBIEN,IBQ,DIC,DA,DO,DD,DLAYGO,X,Y
166 S IBQ=0
167 I $G(IBPRV) D G:IBQ ADDIDQ
168 . ; Provider specific for insurance co - add to file 355.9
169 . S DIC(0)="L",DLAYGO=355.9,DIC="^IBA(355.9,",X=IBPRV
170 . S:$G(IBINS) DIC("DR")=".02////"_IBINS
171 . D FILE^DICN K DIC,DLAYGO,DD,DO
172 . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
173 . S IBIEN=+Y
174 . D NEWID^IBCEP5B(355.9,IBINS,IBPRV,IBPTYP,IBIEN,"")
175 E D
176 . ; Insurance co default - add to file 355.91
177 . S DIC(0)="L",DLAYGO=355.91,DIC="^IBA(355.91,",X=IBINS
178 . D FILE^DICN K DIC,DLAYGO,DD,DO
179 . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
180 . S IBIEN=+Y
181 . D NEWID^IBCEP5B(355.91,IBINS,"",IBPTYP,IBIEN,1)
182ADDIDQ Q IBQ
Note: See TracBrowser for help on using the repository browser.