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

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

initial load of WorldVistAEHR

File size: 7.2 KB
Line 
1IBCIUT5 ;DSI/ESG - UTILITIES FOR CLAIMSMANAGER INTERFACE ;9-MAR-2001
2 ;;2.0;INTEGRATED BILLING;**161,210**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Can't call from the top
6 Q
7 ;
8OPENUSE() ;
9 ; Function to open and use an available tcp/ip port on the
10 ; ClaimsManager server. This function returns 1 if a port was
11 ; successfully locked, opened, and is being used. Otherwise, this
12 ; function returns 0. No variables need to be set up before the
13 ; call. Variable IBCISOCK is returned if a port has been opened.
14 ; IBCISOCK will not be returned if this utility fails. IBCISOCK
15 ; is the port number that is being used.
16 ;
17 ; IO* variables are also returned from the Kernel utility.
18 ;
19 NEW IBCIIP,POP,PORTLOOK,PORTS,Y
20 ;
21 ; Get the IP address of the ClaimsManager server.
22 ; IP address stored in variable IBCIIP.
23 ; IB SITE PARAMETERS file (#350.9), field# 50.05
24 ;
25 S IBCIIP=$P($G(^IBE(350.9,1,50)),U,5) I IBCIIP="" S Y=0 G OUXIT
26 ;
27 ; Build an array of valid and available tcp/ip port numbers
28 ; Array name: PORTS
29 ;
30 M PORTS=^IBE(350.9,1,50.06,"B") I '$D(PORTS) S Y=0 G OUXIT
31 ;
32 S PORTLOOK=0,POP=1 ; POP=1 ==> failure | POP=0 ==> success!
33AGAIN ;
34 S IBCISOCK=""
35 F S IBCISOCK=$O(PORTS(IBCISOCK)) Q:IBCISOCK="" D Q:'POP
36 . L +^IBCITCP(IBCISOCK):0 E S POP=1 Q
37 . D CALL^%ZISTCP(IBCIIP,IBCISOCK,1) I POP L -^IBCITCP(IBCISOCK) Q
38 . Q
39 I 'POP S Y=1 G OUXIT
40 S PORTLOOK=PORTLOOK+1 I PORTLOOK<6 HANG .5 G AGAIN
41 S Y=0 KILL IBCISOCK
42OUXIT ;
43 Q Y
44 ;
45 ;
46CODER(IBIFN) ; Returns the inpatient/outpatient coder of this bill
47 ;
48 ; Input into this function
49 ; IBIFN - ien of the bill/claims file (#399)
50 ;
51 ; Output from this function
52 ; A string with the following 3 pieces:
53 ; [1] "O" or "I" (outpatient/inpatient indicator)
54 ; [2] coder's ien in the new person file (#200)
55 ; [3] coder's name
56 ;
57 NEW Y,IBD0,OIFLG,PTF,PTF0,CDIEN,CDNM,D1
58 NEW DFN,IBDU,BEGDATE,ENDDATE,ENCDT,LSTEDT,IEN,SCE
59 ;
60 S Y="",IBIFN=+$G(IBIFN)
61 S IBD0=$G(^DGCR(399,IBIFN,0))
62 I IBD0="" G CODERX
63 S OIFLG="O" ; default outpatient
64 I $$INPAT^IBCEF(IBIFN) S OIFLG="I" ; check for inpatient
65 S $P(Y,U,1)=OIFLG ; at least return the flag
66 ;
67 ; *** Inpatient Bill Processing ***
68 ; Use the PTF file (#45)
69 ;
70 I OIFLG="I" D G CODERX
71 . S PTF=+$P(IBD0,U,8) ; PTF entry number
72 . S PTF0=$G(^DGPT(PTF,0)) Q:PTF0="" ; check for valid pointer
73 . S CDIEN=+$P(PTF0,U,7) ; closed out by field
74 . S CDNM=$P($G(^VA(200,CDIEN,0)),U,1) ; try to get the name
75 . I CDNM="" D
76 .. S D1=$O(^DGPT(PTF,1,99999999),-1) Q:'D1
77 .. S CDIEN=+$P($G(^DGPT(PTF,1,D1,0)),U,1) ; coding clerk field
78 .. S CDNM=$P($G(^VA(200,CDIEN,0)),U,1) ; try to get the name
79 .. Q
80 . S $P(Y,U,2,3)=CDIEN_U_CDNM ; save the data
81 . Q
82 ;
83 ; *** Outpatient Bill Processing ***
84 ; Use the Outpatient Encounter file (#409.68)
85 ;
86 S DFN=$P(IBD0,U,2) ; patient ien
87 S IBDU=$G(^DGCR(399,IBIFN,"U")) ; "U" node
88 S BEGDATE=$P(IBDU,U,1) ; statement covers from
89 S ENDDATE=$P(IBDU,U,2) ; statement covers to
90 ;
91 ; If there's a problem with either of these dates, use the event date
92 I 'BEGDATE!'ENDDATE S (BEGDATE,ENDDATE)=$P(IBD0,U,3)
93 KILL ^TMP($J,"IBCICODER") ; kill scratch global
94 S ENCDT=$O(^SCE("ADFN",DFN,BEGDATE),-1) ; get the starting date
95 F S ENCDT=$O(^SCE("ADFN",DFN,ENCDT)) Q:'ENCDT!($P(ENCDT,".",1)>ENDDATE) D
96 . S IEN=0
97 . F S IEN=$O(^SCE("ADFN",DFN,ENCDT,IEN)) Q:'IEN D
98 .. S SCE=$G(^SCE(IEN,"USER"))
99 .. I '$P(SCE,U,1) Q ; edited last by
100 .. I '$P(SCE,U,2) Q ; date/time last edited
101 .. S ^TMP($J,"IBCICODER",$P(SCE,U,2),IEN)=$P(SCE,U,1)
102 .. Q
103 . Q
104 ;
105 I '$D(^TMP($J,"IBCICODER")) G CODERX ; get out if no hits
106 S LSTEDT=$O(^TMP($J,"IBCICODER",""),-1) ; most recent date
107 S IEN=$O(^TMP($J,"IBCICODER",LSTEDT,""),-1) ; most recent ien
108 S CDIEN=^TMP($J,"IBCICODER",LSTEDT,IEN) ; edited last by field
109 S CDNM=$P($G(^VA(200,CDIEN,0)),U,1) ; try to get the name
110 KILL ^TMP($J,"IBCICODER") ; clean up scratch global
111 S $P(Y,U,2,3)=CDIEN_U_CDNM ; save the data
112CODERX ;
113 Q Y
114 ;
115 ;
116BILLER(IBIFN) ; Returns the entered/edited by person for this bill
117 ;
118 ; Input into this function
119 ; IBIFN - ien of the bill/claims file (#399)
120 ;
121 ; Output from this function
122 ; A string with the following 2 pieces:
123 ; [1] biller's ien in the new person file (#200)
124 ; [2] biller's name
125 ;
126 NEW Y
127 S IBIFN=+$G(IBIFN)
128 S Y=+$P($G(^DGCR(399,IBIFN,"S")),U,2)
129 ;
130 ; if the POSTMASTER is identified as the biller, then try in file 351.9
131 I Y=.5 D
132 . S Y=+$P($G(^IBA(351.9,IBIFN,0)),U,5) ; last sent to CM by
133 . I 'Y S Y=+$P($G(^IBA(351.9,IBIFN,0)),U,9) ; last edited by
134 . I 'Y S Y=.5 ; postmaster default
135 . Q
136 ;
137 S $P(Y,U,2)=$P($G(^VA(200,Y,0)),U,1)
138BILLERX ;
139 Q Y
140 ;
141CMTINFO(IBIFN) ; Comment Information; Username, date/time stamp display
142 ;
143 ; Returns a line of text in the following format
144 ; "Comment entered by [username] on [date/time]"
145 ;
146 ; Returns "" if no comments or no pointers
147 ;
148 NEW Y,IB0,WHEN,USER
149 S Y="",IBIFN=+$G(IBIFN)
150 I '$D(^IBA(351.9,IBIFN,2)) G CMTINX
151 S IB0=$G(^IBA(351.9,IBIFN,0))
152 S WHEN=$$EXTERNAL^DILFD(351.9,.13,"",$P(IB0,U,13))
153 S USER=$$EXTERNAL^DILFD(351.9,.14,"",$P(IB0,U,14))
154 I WHEN="",USER="" G CMTINX
155 S Y="Comments last edited by "_USER_" on "_WHEN
156CMTINX ;
157 Q Y
158 ;
159TD(IBIFN) ; Terminal digit
160 ;
161 ; Input = IBIFN
162 ; Output = A pieced string
163 ; [1] terminal digit of SSN
164 ; [2] SSN
165 ;
166 NEW Y,DFN,SSN,TD
167 S IBIFN=+$G(IBIFN)
168 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2)
169 S SSN=$P($G(^DPT(DFN,0)),U,9)
170 S TD="999999999"
171 I $L(SSN)'<9 S TD=$E(SSN,8,9)_$E(SSN,6,7)_$E(SSN,4,5)_$E(SSN,1,3)
172 S Y=TD_U_SSN
173TDX ;
174 Q Y
175 ;
176GETMOD(Z) ; Build a comma delimited string of modifier codes
177 ;
178 ; Input: a comma delimited string of modifier ien's
179 ; Output: a comma delimited string of external modifiers
180 ;
181 NEW IBMOD,I,IEN,MOD
182 S IBMOD=""
183 I Z="" G GETMODX
184 F I=1:1:$L(Z,",") S IEN=$P(Z,",",I) D
185 . I IEN="" Q
186 . S MOD=$$MOD^ICPTMOD(IEN,"I")
187 . I MOD<1 Q
188 . I IBMOD="" S IBMOD=$P(MOD,U,2)
189 . E S IBMOD=IBMOD_","_$P(MOD,U,2)
190 . Q
191GETMODX ;
192 Q IBMOD
193 ;
194DASN(IBIFN) ; Delete the assigned to person field in 351.9
195 NEW DIE,DA,DR,%,D,D0,DI,DIC,DQ,X
196 S DIE="^IBA(351.9,",DA=IBIFN,DR=".12///@"
197 D ^DIE
198DASNX ;
199 Q
200 ;
201 ;
202ENV() ; This function will return either a "T" for test claim or a "L" for
203 ; live claim. This is the message type of the claim in the Ingenix
204 ; interface specs. This value will be determined based on the value
205 ; of IBCISNT and also which VistA environment we are currently in.
206 ;
207 NEW MSGTYP,MNETNAME,TNM
208 S TNM=".TEST.MIR.TST.MIRROR.TRAIN." ; various test names
209 S MSGTYP="T" ; assume Test claim
210 I $G(IBCISNT)=3 G ENVX ; test send to CM
211 ;
212 ; Check the node name and make sure it exists and is not a test name
213 S MNETNAME=$G(^XMB("NETNAME"))
214 I MNETNAME="" G ENVX
215 I $F(TNM,"."_$P(MNETNAME,".",1)_".") G ENVX
216 ;
217 S MSGTYP="L" ; Otherwise it's a Live claim
218ENVX ;
219 Q MSGTYP
220 ;
Note: See TracBrowser for help on using the repository browser.