| 1 | IBCIUT5 ;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 | ; | 
|---|
| 8 | OPENUSE() ; | 
|---|
| 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! | 
|---|
| 33 | AGAIN ; | 
|---|
| 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 | 
|---|
| 42 | OUXIT ; | 
|---|
| 43 | Q Y | 
|---|
| 44 | ; | 
|---|
| 45 | ; | 
|---|
| 46 | CODER(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 | 
|---|
| 112 | CODERX ; | 
|---|
| 113 | Q Y | 
|---|
| 114 | ; | 
|---|
| 115 | ; | 
|---|
| 116 | BILLER(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) | 
|---|
| 138 | BILLERX ; | 
|---|
| 139 | Q Y | 
|---|
| 140 | ; | 
|---|
| 141 | CMTINFO(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 | 
|---|
| 156 | CMTINX ; | 
|---|
| 157 | Q Y | 
|---|
| 158 | ; | 
|---|
| 159 | TD(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 | 
|---|
| 173 | TDX ; | 
|---|
| 174 | Q Y | 
|---|
| 175 | ; | 
|---|
| 176 | GETMOD(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 | 
|---|
| 191 | GETMODX ; | 
|---|
| 192 | Q IBMOD | 
|---|
| 193 | ; | 
|---|
| 194 | DASN(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 | 
|---|
| 198 | DASNX ; | 
|---|
| 199 | Q | 
|---|
| 200 | ; | 
|---|
| 201 | ; | 
|---|
| 202 | ENV() ; 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 | 
|---|
| 218 | ENVX ; | 
|---|
| 219 | Q MSGTYP | 
|---|
| 220 | ; | 
|---|