| 1 | IBCIUT1 ;DSI/SLM - MISC UTILITIES FOR CLAIMSMANAGER INTERFACE ;21-DEC-2000
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**161,210**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | NOW ;get current (or specific) date/time and convert to ClaimsManager format
|
|---|
| 7 | ;
|
|---|
| 8 | ;Input variable
|
|---|
| 9 | ; x = date or date/time (for date/time other than now)
|
|---|
| 10 | ;Output variable
|
|---|
| 11 | ; y = date or date/time in claimsmanager format
|
|---|
| 12 | ; (yyyymmdd) or (yyyymmddhhmmss)
|
|---|
| 13 | ;
|
|---|
| 14 | NEW YEAR,MON,DAY,HOUR,MIN,SEC
|
|---|
| 15 | I '$G(X) S X=$$NOW^XLFDT
|
|---|
| 16 | S YEAR=$E(X,1,3)+1700,MON=$E(X,4,5),DAY=$E(X,6,7)
|
|---|
| 17 | I MON="00" S MON="01"
|
|---|
| 18 | I DAY="00" S DAY="01"
|
|---|
| 19 | I +$P(X,".",2) D
|
|---|
| 20 | .S HOUR=$E($P(X,".",2),1,2),MIN=$E($P(X,".",2),3,4),SEC=$E($P(X,".",2),5,6)
|
|---|
| 21 | .S Y=YEAR_MON_DAY_HOUR_MIN_SEC
|
|---|
| 22 | E S Y=YEAR_MON_DAY
|
|---|
| 23 | Q
|
|---|
| 24 | NOW1(X) ;change date from mmddyyyy to yyyymmdd
|
|---|
| 25 | N DATE,MM,DD,YY
|
|---|
| 26 | S MM=$E(X,1,2),DD=$E(X,3,4),YY=$E(X,5,8)
|
|---|
| 27 | S DATE=YY_MM_DD
|
|---|
| 28 | Q DATE
|
|---|
| 29 | NAMSP ;split name into three pieces LAST^FIRST^MIDDLE
|
|---|
| 30 | ;Input variable
|
|---|
| 31 | ; x = LAST,FIRST MIDDLE
|
|---|
| 32 | ;Output variable
|
|---|
| 33 | ; y = LAST^FIRST^MIDDLE
|
|---|
| 34 | ;
|
|---|
| 35 | N NAME S Y=""
|
|---|
| 36 | S NAME(1)=$P(X,","),NAME(2)=$P(X,",",2,999)
|
|---|
| 37 | S NAME(3)=$P(NAME(2)," ",2,999)
|
|---|
| 38 | S NAME(2)=$P(NAME(2)," ",1)
|
|---|
| 39 | S Y=NAME(1)_"^"_NAME(2)_"^"_NAME(3)
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | CM(IBIFN) ;
|
|---|
| 43 | ; ClaimsManager environment check for IB routines. Checks to make
|
|---|
| 44 | ; sure CM is running and that the bill is a HCFA 1500 form type bill.
|
|---|
| 45 | ; Any other condition will return false.
|
|---|
| 46 | ;
|
|---|
| 47 | N Y
|
|---|
| 48 | S Y=0
|
|---|
| 49 | I $G(IBIFN),$$CK0(),'$$CK1(IBIFN) S Y=1
|
|---|
| 50 | Q Y
|
|---|
| 51 | ;
|
|---|
| 52 | CK0() ;checks to see if running ClaimsManager
|
|---|
| 53 | ;returns a 1 if running ClaimsManager
|
|---|
| 54 | N Y
|
|---|
| 55 | S Y=$S($P($G(^IBE(350.9,1,50)),U)=1:1,1:0)
|
|---|
| 56 | Q Y
|
|---|
| 57 | ;
|
|---|
| 58 | CK1(IBIFN) ;checks to see if it's a HCFA 1500 claim form
|
|---|
| 59 | ;returns 0 if HCFA 1500, returns 1 if any other form type
|
|---|
| 60 | ;
|
|---|
| 61 | N IBX,IBY
|
|---|
| 62 | S IBY=$P($G(^DGCR(399,IBIFN,0)),U,19)
|
|---|
| 63 | S IBX=$S(IBY=2:0,1:1)
|
|---|
| 64 | Q IBX
|
|---|
| 65 | ;
|
|---|
| 66 | CK2() ;checks to see if ClaimsManager is working ok
|
|---|
| 67 | ;returns a 1 if running ok
|
|---|
| 68 | ;
|
|---|
| 69 | N Y
|
|---|
| 70 | S Y=$S($P($G(^IBE(350.9,1,50)),U,2)=1:1,1:0)
|
|---|
| 71 | Q Y
|
|---|
| 72 | ;
|
|---|
| 73 | ST(IBCIST) ;set status field to ibcist
|
|---|
| 74 | ;
|
|---|
| 75 | ;input variables
|
|---|
| 76 | ; ibifn
|
|---|
| 77 | ; ibcist
|
|---|
| 78 | I '$D(IBIFN) Q
|
|---|
| 79 | I '$D(IBCIST) Q
|
|---|
| 80 | S IENS=IBIFN_",",FDA(351.9,IENS,.02)=IBCIST
|
|---|
| 81 | D FILE^DIE("K","FDA")
|
|---|
| 82 | K FDA,IENS
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | STAT(IBIFN) ;return value of status field in 351.9
|
|---|
| 86 | N IBCIST1
|
|---|
| 87 | S IBCIST1=$P(^IBA(351.9,IBIFN,0),U,2)
|
|---|
| 88 | Q IBCIST1
|
|---|
| 89 | ;
|
|---|
| 90 | ;
|
|---|
| 91 | LITMS(IBIFN) ; Returns the number of line items
|
|---|
| 92 | NEW IBXARRAY,IBXARRY,IBXDATA,IBXERR
|
|---|
| 93 | KILL ^TMP("IBXSAVE",$J)
|
|---|
| 94 | D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
|
|---|
| 95 | Q +$O(IBXDATA(""),-1)
|
|---|
| 96 | ;
|
|---|
| 97 | ;
|
|---|
| 98 | LSTA(IBCISNT) ; return the correct Ingenix line status based on the value
|
|---|
| 99 | ; of IBCISNT - where is the interface called from?
|
|---|
| 100 | Q $S(IBCISNT=5:"P",IBCISNT=4:"D",IBCISNT=7:"D",1:"A")
|
|---|
| 101 | ;
|
|---|
| 102 | RPHY(IBIFN) ; Attending/rendering physician information
|
|---|
| 103 | ;
|
|---|
| 104 | ; This function returns the physician information for bill# IBIFN.
|
|---|
| 105 | ; Data is returned in a pieced string:
|
|---|
| 106 | ;
|
|---|
| 107 | ; [1] Name
|
|---|
| 108 | ; for non-VA, this may be a facility (if no comma in Name)
|
|---|
| 109 | ; [2] ID#
|
|---|
| 110 | ; File 200 ien# for VA; "NVA"_ien# for non-VA
|
|---|
| 111 | ; [3] Department
|
|---|
| 112 | ; Service/Section file ien# for VA; "NVA" for non-VA
|
|---|
| 113 | ; [4] Specialty
|
|---|
| 114 | ;
|
|---|
| 115 | NEW IBXDATA,IBXARRAY,IBXARRY,IBXERR,Y,IBPRV
|
|---|
| 116 | S Y=""
|
|---|
| 117 | D F^IBCEF("N-ATT/REND PHYSICIAN NAME",,,IBIFN)
|
|---|
| 118 | S IBPRV=$P($G(IBXDATA),U,2)
|
|---|
| 119 | I 'IBPRV G RPHYX
|
|---|
| 120 | S $P(Y,U,1)=$P(IBXDATA,U,1)
|
|---|
| 121 | S $P(Y,U,4)=$$BILLSPEC^IBCEU3(IBIFN,IBPRV)
|
|---|
| 122 | ;
|
|---|
| 123 | ; Check for VA provider first and then get out
|
|---|
| 124 | I IBPRV'["IBA(355.93" D G RPHYX
|
|---|
| 125 | . S $P(Y,U,2)=+IBPRV
|
|---|
| 126 | . S $P(Y,U,3)=$P($G(^VA(200,+IBPRV,5)),U,1)
|
|---|
| 127 | . Q
|
|---|
| 128 | ;
|
|---|
| 129 | ; Now we're dealing with a Non-VA provider
|
|---|
| 130 | S $P(Y,U,2)="NVA"_+IBPRV
|
|---|
| 131 | S $P(Y,U,3)="NVA"
|
|---|
| 132 | RPHYX ;
|
|---|
| 133 | Q Y
|
|---|
| 134 | ;
|
|---|
| 135 | CKNER() ;check for no errors
|
|---|
| 136 | ;returns 1 if no errors, 0 if errors were found
|
|---|
| 137 | N IBCIY,LSEG S LSEG=0,IBCIY=1
|
|---|
| 138 | F S LSEG=$O(IBCIZ("RL",LSEG)) Q:'LSEG D
|
|---|
| 139 | .I $P(IBCIZ("RL",LSEG,0),U,2)]"" S IBCIY=0
|
|---|
| 140 | Q IBCIY
|
|---|
| 141 | CKLI(IBIFN) ;check for line items
|
|---|
| 142 | N LITEM
|
|---|
| 143 | I '$P($G(^IBA(351.9,IBIFN,3)),U,1) D UPDT^IBCIADD1 ; build if not there
|
|---|
| 144 | S LITEM=$S(+$P($G(^IBA(351.9,IBIFN,5,0)),U,4)>0:1,1:0)
|
|---|
| 145 | Q LITEM
|
|---|
| 146 | ;
|
|---|
| 147 | ;
|
|---|
| 148 | CKFT(IBIFN) ; Check for a form type change by the user
|
|---|
| 149 | NEW D0,DA,DB,DC,DE,DH,DI,DIC,DIE,DIEL,DIFLD,DIG,DIH
|
|---|
| 150 | NEW DIK,DIPA,DIV,DK,DL,DM,DP,DQ,DR,X,Y
|
|---|
| 151 | NEW IBCISNT,IBCISTAT,IBCIREDT,IBCIERR
|
|---|
| 152 | I '$$CK0() Q ; esg - 7/17/01 - bug fix
|
|---|
| 153 | ;
|
|---|
| 154 | ; If it's not there, but it is a hcfa 1500, then add it
|
|---|
| 155 | I '$D(^IBA(351.9,IBIFN)),'$$CK1(IBIFN) D ST1^IBCIST G CKFTX
|
|---|
| 156 | ;
|
|---|
| 157 | ; If it's there, but no longer a hcfa 1500, then delete it.
|
|---|
| 158 | ; esg - 1/3/2002 - If it has been sent to CM previously, then
|
|---|
| 159 | ; we need to send it with new send type 7.
|
|---|
| 160 | I $D(^IBA(351.9,IBIFN)),$$CK1(IBIFN) D
|
|---|
| 161 | . I $P($G(^IBA(351.9,IBIFN,0)),U,15) S IBCISNT=7 D ST2^IBCIST
|
|---|
| 162 | . S DIK="^IBA(351.9,",DA=IBIFN D ^DIK
|
|---|
| 163 | . Q
|
|---|
| 164 | CKFTX ;
|
|---|
| 165 | Q
|
|---|
| 166 | ;
|
|---|
| 167 | ;
|
|---|
| 168 | DIAG(IBIFN) ;return array of diagnosis codes for each line item
|
|---|
| 169 | NEW IBXDATA,IBXARRAY,IBXARRY,IBXERR
|
|---|
| 170 | NEW IBZDC1,SUB1,LITM,CODES,DNUM,DC,ICDIEN,CT
|
|---|
| 171 | K ^TMP("IBXSAVE",$J,"DX")
|
|---|
| 172 | S SUB1=$S($G(IBCIMSG)=1:"IBCIMSG",1:"DISPLAY")
|
|---|
| 173 | K ^TMP(SUB1,$J,IBIFN,"ICD")
|
|---|
| 174 | D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
|
|---|
| 175 | D F^IBCEF("N-DIAGNOSES","IBZDC1",,IBIFN)
|
|---|
| 176 | ;
|
|---|
| 177 | ; if IBCIMSG is on, need to count up the line items for the set below
|
|---|
| 178 | I $G(IBCIMSG) S (CT,LITM)=0 F S LITM=$O(IBXDATA(LITM)) Q:'LITM S CT=CT+1
|
|---|
| 179 | S LITM=0 F S LITM=$O(IBXDATA(LITM)) Q:'LITM D
|
|---|
| 180 | .S CODES=$P(IBXDATA(LITM),U,7)
|
|---|
| 181 | .S DNUM=0 F S DNUM=DNUM+1 Q:$P(CODES,",",DNUM)="" D
|
|---|
| 182 | ..S DC(DNUM)=$P(CODES,",",DNUM)
|
|---|
| 183 | ..S ICDIEN=$P(IBZDC1(DC(DNUM)),U,1)
|
|---|
| 184 | ..S ^TMP(SUB1,$J,IBIFN,"ICD",LITM,DNUM)=$P($$ICD9^IBACSV(ICDIEN),U)
|
|---|
| 185 | .I $G(IBCIMSG) S ^TMP(SUB1,$J,IBIFN,"ICD",LITM,0)=CT_U_(DNUM-1)
|
|---|
| 186 | K ^TMP("IBXSAVE",$J,"DX")
|
|---|
| 187 | Q
|
|---|
| 188 | ;
|
|---|
| 189 | ;
|
|---|
| 190 | EDATP(IBIFN,COMMCHG) ;edit assigned to person (ATP)
|
|---|
| 191 | ;
|
|---|
| 192 | ; This procedure reads in the Assigned to person from the user and
|
|---|
| 193 | ; makes sure that some user gets assigned to the bill (IBIFN). The
|
|---|
| 194 | ; parameter COMMCHG indicates whether or not the current user
|
|---|
| 195 | ; modified the ClaimsManager comments in any way.
|
|---|
| 196 | ;
|
|---|
| 197 | ; This procedure also determines if a MailMan message should get
|
|---|
| 198 | ; sent to the new assigned to person and invokes the procedure if
|
|---|
| 199 | ; it should.
|
|---|
| 200 | ;
|
|---|
| 201 | NEW D,D0,DA,DIC,DIE,DR,I,IBCIATPO,IBCIATPN,IBCIDEF,X,Y
|
|---|
| 202 | NEW IBCIGRP,IBCIGRPN,GRPONLY,CONMSG
|
|---|
| 203 | S IBCIATPO=$P($G(^IBA(351.9,IBIFN,0)),U,12) ; original ATP
|
|---|
| 204 | W !!!,?2,"Please enter the person to whom this bill should be assigned.",!
|
|---|
| 205 | S IBCIDEF=IBCIATPO ; default the current ATP, but ...
|
|---|
| 206 | I 'IBCIDEF S IBCIDEF=DUZ ; if not there, default the current user
|
|---|
| 207 | S DA=IBIFN,DIE="^IBA(351.9,"
|
|---|
| 208 | S DR=".12ASSIGNED TO PERSON//"_$P($G(^VA(200,IBCIDEF,0)),U,1)
|
|---|
| 209 | D ^DIE
|
|---|
| 210 | ;
|
|---|
| 211 | ; Make sure someone got assigned. Stuff in the current user if
|
|---|
| 212 | ; nobody got assigned. Set a variable indicating the new assigned
|
|---|
| 213 | ; to person.
|
|---|
| 214 | ;
|
|---|
| 215 | I '$P($G(^IBA(351.9,IBIFN,0)),U,12) D
|
|---|
| 216 | . S DIE="^IBA(351.9,",DA=IBIFN,DR=".12////"_DUZ D ^DIE
|
|---|
| 217 | . Q
|
|---|
| 218 | S IBCIATPN=$P($G(^IBA(351.9,IBIFN,0)),U,12) ; new ATP
|
|---|
| 219 | ;
|
|---|
| 220 | ; Display a confirmation message to the user
|
|---|
| 221 | W !!!?2,"Claim ",$P($G(^DGCR(399,IBIFN,0)),U,1)," has been assigned to "
|
|---|
| 222 | W $P($G(^VA(200,IBCIATPN,0)),U,1),"."
|
|---|
| 223 | ;
|
|---|
| 224 | ; Ask the user if they want to send the MailMan message to a specific
|
|---|
| 225 | ; mail group in addition to the new assigned to person.
|
|---|
| 226 | ; ESG - 9/4/01
|
|---|
| 227 | ;
|
|---|
| 228 | W !!!?2,"If you want to send a MailMan message about this bill assignment"
|
|---|
| 229 | W !?2,"to a specific Mail Group, then please choose that Mail Group here.",!
|
|---|
| 230 | S DIC="^XMB(3.8,",DIC(0)="ABEQV",DIC("A")="MAIL GROUP: "
|
|---|
| 231 | D ^DIC
|
|---|
| 232 | S (IBCIGRP,IBCIGRPN)=""
|
|---|
| 233 | I Y>0 S IBCIGRP=+Y,IBCIGRPN=$P(Y,U,2) ; group ien and name
|
|---|
| 234 | ;
|
|---|
| 235 | ; Now determine if a MailMan message should get sent out and send it.
|
|---|
| 236 | ; Don't send a MailMan message to yourself and don't send a message
|
|---|
| 237 | ; if the assignment has not changed. However, if the user chose a
|
|---|
| 238 | ; mail group at the above prompt, then always send a MailMan message
|
|---|
| 239 | ; to that mail group.
|
|---|
| 240 | ;
|
|---|
| 241 | ; The GRPONLY variable is true if the assigned to person is the
|
|---|
| 242 | ; current user OR if the assigned to person is the same as the original
|
|---|
| 243 | ; assigned to person.
|
|---|
| 244 | ;
|
|---|
| 245 | S GRPONLY=(IBCIATPN=DUZ)!(IBCIATPN=IBCIATPO)
|
|---|
| 246 | I 'IBCIGRP,GRPONLY G EDATPX ; No mailman in this case at all
|
|---|
| 247 | ;
|
|---|
| 248 | ; Call the procedure that creates the message
|
|---|
| 249 | D CAT^IBCIUT6(IBIFN,DUZ,IBCIATPN,IBCIGRP,GRPONLY)
|
|---|
| 250 | ;
|
|---|
| 251 | ; The CONMSG array is the confirmation message array so the user
|
|---|
| 252 | ; knows to whom a message was sent.
|
|---|
| 253 | I 'GRPONLY S CONMSG(1)=$P($G(^VA(200,IBCIATPN,0)),U,1)
|
|---|
| 254 | I IBCIGRP S CONMSG(2)=IBCIGRPN
|
|---|
| 255 | ;
|
|---|
| 256 | ; Build and display the confirmation message
|
|---|
| 257 | W !!?2,"A MailMan message has been sent to "
|
|---|
| 258 | S X=0
|
|---|
| 259 | F S X=$O(CONMSG(X)) Q:'X W CONMSG(X) I $O(CONMSG(X)) W !?30,"and to "
|
|---|
| 260 | W "."
|
|---|
| 261 | ;
|
|---|
| 262 | EDATPX ;
|
|---|
| 263 | ; Display a press return to continue message if coming in from
|
|---|
| 264 | ; the Listman screens
|
|---|
| 265 | I $D(VALMHDR) W !! S DIR("A")="Press RETURN to continue",DIR(0)="E",DIR("T")=10 D ^DIR K DIR
|
|---|
| 266 | Q
|
|---|
