Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCIUT1

IBCIUT1.m

Go to the documentation of this file.
  1. IBCIUT1 ;DSI/SLM - MISC UTILITIES FOR CLAIMSMANAGER INTERFACE ;21-DEC-2000
  1. ;;2.0;INTEGRATED BILLING;**161,210**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. NOW ;get current (or specific) date/time and convert to ClaimsManager format
  1. ;
  1. ;Input variable
  1. ; x = date or date/time (for date/time other than now)
  1. ;Output variable
  1. ; y = date or date/time in claimsmanager format
  1. ; (yyyymmdd) or (yyyymmddhhmmss)
  1. ;
  1. NEW YEAR,MON,DAY,HOUR,MIN,SEC
  1. I '$G(X) S X=$$NOW^XLFDT
  1. S YEAR=$E(X,1,3)+1700,MON=$E(X,4,5),DAY=$E(X,6,7)
  1. I MON="00" S MON="01"
  1. I DAY="00" S DAY="01"
  1. I +$P(X,".",2) D
  1. .S HOUR=$E($P(X,".",2),1,2),MIN=$E($P(X,".",2),3,4),SEC=$E($P(X,".",2),5,6)
  1. .S Y=YEAR_MON_DAY_HOUR_MIN_SEC
  1. E S Y=YEAR_MON_DAY
  1. Q
  1. NOW1(X) ;change date from mmddyyyy to yyyymmdd
  1. N DATE,MM,DD,YY
  1. S MM=$E(X,1,2),DD=$E(X,3,4),YY=$E(X,5,8)
  1. S DATE=YY_MM_DD
  1. Q DATE
  1. NAMSP ;split name into three pieces LAST^FIRST^MIDDLE
  1. ;Input variable
  1. ; x = LAST,FIRST MIDDLE
  1. ;Output variable
  1. ; y = LAST^FIRST^MIDDLE
  1. ;
  1. N NAME S Y=""
  1. S NAME(1)=$P(X,","),NAME(2)=$P(X,",",2,999)
  1. S NAME(3)=$P(NAME(2)," ",2,999)
  1. S NAME(2)=$P(NAME(2)," ",1)
  1. S Y=NAME(1)_"^"_NAME(2)_"^"_NAME(3)
  1. Q
  1. ;
  1. CM(IBIFN) ;
  1. ; ClaimsManager environment check for IB routines. Checks to make
  1. ; sure CM is running and that the bill is a HCFA 1500 form type bill.
  1. ; Any other condition will return false.
  1. ;
  1. N Y
  1. S Y=0
  1. I $G(IBIFN),$$CK0(),'$$CK1(IBIFN) S Y=1
  1. Q Y
  1. ;
  1. CK0() ;checks to see if running ClaimsManager
  1. ;returns a 1 if running ClaimsManager
  1. N Y
  1. S Y=$S($P($G(^IBE(350.9,1,50)),U)=1:1,1:0)
  1. Q Y
  1. ;
  1. CK1(IBIFN) ;checks to see if it's a HCFA 1500 claim form
  1. ;returns 0 if HCFA 1500, returns 1 if any other form type
  1. ;
  1. N IBX,IBY
  1. S IBY=$P($G(^DGCR(399,IBIFN,0)),U,19)
  1. S IBX=$S(IBY=2:0,1:1)
  1. Q IBX
  1. ;
  1. CK2() ;checks to see if ClaimsManager is working ok
  1. ;returns a 1 if running ok
  1. ;
  1. N Y
  1. S Y=$S($P($G(^IBE(350.9,1,50)),U,2)=1:1,1:0)
  1. Q Y
  1. ;
  1. ST(IBCIST) ;set status field to ibcist
  1. ;
  1. ;input variables
  1. ; ibifn
  1. ; ibcist
  1. I '$D(IBIFN) Q
  1. I '$D(IBCIST) Q
  1. S IENS=IBIFN_",",FDA(351.9,IENS,.02)=IBCIST
  1. D FILE^DIE("K","FDA")
  1. K FDA,IENS
  1. Q
  1. ;
  1. STAT(IBIFN) ;return value of status field in 351.9
  1. N IBCIST1
  1. S IBCIST1=$P(^IBA(351.9,IBIFN,0),U,2)
  1. Q IBCIST1
  1. ;
  1. ;
  1. LITMS(IBIFN) ; Returns the number of line items
  1. NEW IBXARRAY,IBXARRY,IBXDATA,IBXERR
  1. KILL ^TMP("IBXSAVE",$J)
  1. D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
  1. Q +$O(IBXDATA(""),-1)
  1. ;
  1. ;
  1. LSTA(IBCISNT) ; return the correct Ingenix line status based on the value
  1. ; of IBCISNT - where is the interface called from?
  1. Q $S(IBCISNT=5:"P",IBCISNT=4:"D",IBCISNT=7:"D",1:"A")
  1. ;
  1. RPHY(IBIFN) ; Attending/rendering physician information
  1. ;
  1. ; This function returns the physician information for bill# IBIFN.
  1. ; Data is returned in a pieced string:
  1. ;
  1. ; [1] Name
  1. ; for non-VA, this may be a facility (if no comma in Name)
  1. ; [2] ID#
  1. ; File 200 ien# for VA; "NVA"_ien# for non-VA
  1. ; [3] Department
  1. ; Service/Section file ien# for VA; "NVA" for non-VA
  1. ; [4] Specialty
  1. ;
  1. NEW IBXDATA,IBXARRAY,IBXARRY,IBXERR,Y,IBPRV
  1. S Y=""
  1. D F^IBCEF("N-ATT/REND PHYSICIAN NAME",,,IBIFN)
  1. S IBPRV=$P($G(IBXDATA),U,2)
  1. I 'IBPRV G RPHYX
  1. S $P(Y,U,1)=$P(IBXDATA,U,1)
  1. S $P(Y,U,4)=$$BILLSPEC^IBCEU3(IBIFN,IBPRV)
  1. ;
  1. ; Check for VA provider first and then get out
  1. I IBPRV'["IBA(355.93" D G RPHYX
  1. . S $P(Y,U,2)=+IBPRV
  1. . S $P(Y,U,3)=$P($G(^VA(200,+IBPRV,5)),U,1)
  1. . Q
  1. ;
  1. ; Now we're dealing with a Non-VA provider
  1. S $P(Y,U,2)="NVA"_+IBPRV
  1. S $P(Y,U,3)="NVA"
  1. RPHYX ;
  1. Q Y
  1. ;
  1. CKNER() ;check for no errors
  1. ;returns 1 if no errors, 0 if errors were found
  1. N IBCIY,LSEG S LSEG=0,IBCIY=1
  1. F S LSEG=$O(IBCIZ("RL",LSEG)) Q:'LSEG D
  1. .I $P(IBCIZ("RL",LSEG,0),U,2)]"" S IBCIY=0
  1. Q IBCIY
  1. CKLI(IBIFN) ;check for line items
  1. N LITEM
  1. I '$P($G(^IBA(351.9,IBIFN,3)),U,1) D UPDT^IBCIADD1 ; build if not there
  1. S LITEM=$S(+$P($G(^IBA(351.9,IBIFN,5,0)),U,4)>0:1,1:0)
  1. Q LITEM
  1. ;
  1. ;
  1. CKFT(IBIFN) ; Check for a form type change by the user
  1. NEW D0,DA,DB,DC,DE,DH,DI,DIC,DIE,DIEL,DIFLD,DIG,DIH
  1. NEW DIK,DIPA,DIV,DK,DL,DM,DP,DQ,DR,X,Y
  1. NEW IBCISNT,IBCISTAT,IBCIREDT,IBCIERR
  1. I '$$CK0() Q ; esg - 7/17/01 - bug fix
  1. ;
  1. ; If it's not there, but it is a hcfa 1500, then add it
  1. I '$D(^IBA(351.9,IBIFN)),'$$CK1(IBIFN) D ST1^IBCIST G CKFTX
  1. ;
  1. ; If it's there, but no longer a hcfa 1500, then delete it.
  1. ; esg - 1/3/2002 - If it has been sent to CM previously, then
  1. ; we need to send it with new send type 7.
  1. I $D(^IBA(351.9,IBIFN)),$$CK1(IBIFN) D
  1. . I $P($G(^IBA(351.9,IBIFN,0)),U,15) S IBCISNT=7 D ST2^IBCIST
  1. . S DIK="^IBA(351.9,",DA=IBIFN D ^DIK
  1. . Q
  1. CKFTX ;
  1. Q
  1. ;
  1. ;
  1. DIAG(IBIFN) ;return array of diagnosis codes for each line item
  1. NEW IBXDATA,IBXARRAY,IBXARRY,IBXERR
  1. NEW IBZDC1,SUB1,LITM,CODES,DNUM,DC,ICDIEN,CT
  1. K ^TMP("IBXSAVE",$J,"DX")
  1. S SUB1=$S($G(IBCIMSG)=1:"IBCIMSG",1:"DISPLAY")
  1. K ^TMP(SUB1,$J,IBIFN,"ICD")
  1. D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
  1. D F^IBCEF("N-DIAGNOSES","IBZDC1",,IBIFN)
  1. ;
  1. ; if IBCIMSG is on, need to count up the line items for the set below
  1. I $G(IBCIMSG) S (CT,LITM)=0 F S LITM=$O(IBXDATA(LITM)) Q:'LITM S CT=CT+1
  1. S LITM=0 F S LITM=$O(IBXDATA(LITM)) Q:'LITM D
  1. .S CODES=$P(IBXDATA(LITM),U,7)
  1. .S DNUM=0 F S DNUM=DNUM+1 Q:$P(CODES,",",DNUM)="" D
  1. ..S DC(DNUM)=$P(CODES,",",DNUM)
  1. ..S ICDIEN=$P(IBZDC1(DC(DNUM)),U,1)
  1. ..S ^TMP(SUB1,$J,IBIFN,"ICD",LITM,DNUM)=$P($$ICD9^IBACSV(ICDIEN),U)
  1. .I $G(IBCIMSG) S ^TMP(SUB1,$J,IBIFN,"ICD",LITM,0)=CT_U_(DNUM-1)
  1. K ^TMP("IBXSAVE",$J,"DX")
  1. Q
  1. ;
  1. ;
  1. EDATP(IBIFN,COMMCHG) ;edit assigned to person (ATP)
  1. ;
  1. ; This procedure reads in the Assigned to person from the user and
  1. ; makes sure that some user gets assigned to the bill (IBIFN). The
  1. ; parameter COMMCHG indicates whether or not the current user
  1. ; modified the ClaimsManager comments in any way.
  1. ;
  1. ; This procedure also determines if a MailMan message should get
  1. ; sent to the new assigned to person and invokes the procedure if
  1. ; it should.
  1. ;
  1. NEW D,D0,DA,DIC,DIE,DR,I,IBCIATPO,IBCIATPN,IBCIDEF,X,Y
  1. NEW IBCIGRP,IBCIGRPN,GRPONLY,CONMSG
  1. S IBCIATPO=$P($G(^IBA(351.9,IBIFN,0)),U,12) ; original ATP
  1. W !!!,?2,"Please enter the person to whom this bill should be assigned.",!
  1. S IBCIDEF=IBCIATPO ; default the current ATP, but ...
  1. I 'IBCIDEF S IBCIDEF=DUZ ; if not there, default the current user
  1. S DA=IBIFN,DIE="^IBA(351.9,"
  1. S DR=".12ASSIGNED TO PERSON//"_$P($G(^VA(200,IBCIDEF,0)),U,1)
  1. D ^DIE
  1. ;
  1. ; Make sure someone got assigned. Stuff in the current user if
  1. ; nobody got assigned. Set a variable indicating the new assigned
  1. ; to person.
  1. ;
  1. I '$P($G(^IBA(351.9,IBIFN,0)),U,12) D
  1. . S DIE="^IBA(351.9,",DA=IBIFN,DR=".12////"_DUZ D ^DIE
  1. . Q
  1. S IBCIATPN=$P($G(^IBA(351.9,IBIFN,0)),U,12) ; new ATP
  1. ;
  1. ; Display a confirmation message to the user
  1. W !!!?2,"Claim ",$P($G(^DGCR(399,IBIFN,0)),U,1)," has been assigned to "
  1. W $P($G(^VA(200,IBCIATPN,0)),U,1),"."
  1. ;
  1. ; Ask the user if they want to send the MailMan message to a specific
  1. ; mail group in addition to the new assigned to person.
  1. ; ESG - 9/4/01
  1. ;
  1. W !!!?2,"If you want to send a MailMan message about this bill assignment"
  1. W !?2,"to a specific Mail Group, then please choose that Mail Group here.",!
  1. S DIC="^XMB(3.8,",DIC(0)="ABEQV",DIC("A")="MAIL GROUP: "
  1. D ^DIC
  1. S (IBCIGRP,IBCIGRPN)=""
  1. I Y>0 S IBCIGRP=+Y,IBCIGRPN=$P(Y,U,2) ; group ien and name
  1. ;
  1. ; Now determine if a MailMan message should get sent out and send it.
  1. ; Don't send a MailMan message to yourself and don't send a message
  1. ; if the assignment has not changed. However, if the user chose a
  1. ; mail group at the above prompt, then always send a MailMan message
  1. ; to that mail group.
  1. ;
  1. ; The GRPONLY variable is true if the assigned to person is the
  1. ; current user OR if the assigned to person is the same as the original
  1. ; assigned to person.
  1. ;
  1. S GRPONLY=(IBCIATPN=DUZ)!(IBCIATPN=IBCIATPO)
  1. I 'IBCIGRP,GRPONLY G EDATPX ; No mailman in this case at all
  1. ;
  1. ; Call the procedure that creates the message
  1. D CAT^IBCIUT6(IBIFN,DUZ,IBCIATPN,IBCIGRP,GRPONLY)
  1. ;
  1. ; The CONMSG array is the confirmation message array so the user
  1. ; knows to whom a message was sent.
  1. I 'GRPONLY S CONMSG(1)=$P($G(^VA(200,IBCIATPN,0)),U,1)
  1. I IBCIGRP S CONMSG(2)=IBCIGRPN
  1. ;
  1. ; Build and display the confirmation message
  1. W !!?2,"A MailMan message has been sent to "
  1. S X=0
  1. F S X=$O(CONMSG(X)) Q:'X W CONMSG(X) I $O(CONMSG(X)) W !?30,"and to "
  1. W "."
  1. ;
  1. EDATPX ;
  1. ; Display a press return to continue message if coming in from
  1. ; the Listman screens
  1. I $D(VALMHDR) W !! S DIR("A")="Press RETURN to continue",DIR(0)="E",DIR("T")=10 D ^DIR K DIR
  1. Q