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

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

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