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

IBCIUT5.m

Go to the documentation of this file.
  1. IBCIUT5 ;DSI/ESG - UTILITIES FOR CLAIMSMANAGER INTERFACE ;9-MAR-2001
  1. ;;2.0;INTEGRATED BILLING;**161,210**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; Can't call from the top
  1. Q
  1. ;
  1. OPENUSE() ;
  1. ; Function to open and use an available tcp/ip port on the
  1. ; ClaimsManager server. This function returns 1 if a port was
  1. ; successfully locked, opened, and is being used. Otherwise, this
  1. ; function returns 0. No variables need to be set up before the
  1. ; call. Variable IBCISOCK is returned if a port has been opened.
  1. ; IBCISOCK will not be returned if this utility fails. IBCISOCK
  1. ; is the port number that is being used.
  1. ;
  1. ; IO* variables are also returned from the Kernel utility.
  1. ;
  1. NEW IBCIIP,POP,PORTLOOK,PORTS,Y
  1. ;
  1. ; Get the IP address of the ClaimsManager server.
  1. ; IP address stored in variable IBCIIP.
  1. ; IB SITE PARAMETERS file (#350.9), field# 50.05
  1. ;
  1. S IBCIIP=$P($G(^IBE(350.9,1,50)),U,5) I IBCIIP="" S Y=0 G OUXIT
  1. ;
  1. ; Build an array of valid and available tcp/ip port numbers
  1. ; Array name: PORTS
  1. ;
  1. M PORTS=^IBE(350.9,1,50.06,"B") I '$D(PORTS) S Y=0 G OUXIT
  1. ;
  1. S PORTLOOK=0,POP=1 ; POP=1 ==> failure | POP=0 ==> success!
  1. AGAIN ;
  1. S IBCISOCK=""
  1. F S IBCISOCK=$O(PORTS(IBCISOCK)) Q:IBCISOCK="" D Q:'POP
  1. . L +^IBCITCP(IBCISOCK):0 E S POP=1 Q
  1. . D CALL^%ZISTCP(IBCIIP,IBCISOCK,1) I POP L -^IBCITCP(IBCISOCK) Q
  1. . Q
  1. I 'POP S Y=1 G OUXIT
  1. S PORTLOOK=PORTLOOK+1 I PORTLOOK<6 HANG .5 G AGAIN
  1. S Y=0 KILL IBCISOCK
  1. OUXIT ;
  1. Q Y
  1. ;
  1. ;
  1. CODER(IBIFN) ; Returns the inpatient/outpatient coder of this bill
  1. ;
  1. ; Input into this function
  1. ; IBIFN - ien of the bill/claims file (#399)
  1. ;
  1. ; Output from this function
  1. ; A string with the following 3 pieces:
  1. ; [1] "O" or "I" (outpatient/inpatient indicator)
  1. ; [2] coder's ien in the new person file (#200)
  1. ; [3] coder's name
  1. ;
  1. NEW Y,IBD0,OIFLG,PTF,PTF0,CDIEN,CDNM,D1
  1. NEW DFN,IBDU,BEGDATE,ENDDATE,ENCDT,LSTEDT,IEN,SCE
  1. ;
  1. S Y="",IBIFN=+$G(IBIFN)
  1. S IBD0=$G(^DGCR(399,IBIFN,0))
  1. I IBD0="" G CODERX
  1. S OIFLG="O" ; default outpatient
  1. I $$INPAT^IBCEF(IBIFN) S OIFLG="I" ; check for inpatient
  1. S $P(Y,U,1)=OIFLG ; at least return the flag
  1. ;
  1. ; *** Inpatient Bill Processing ***
  1. ; Use the PTF file (#45)
  1. ;
  1. I OIFLG="I" D G CODERX
  1. . S PTF=+$P(IBD0,U,8) ; PTF entry number
  1. . S PTF0=$G(^DGPT(PTF,0)) Q:PTF0="" ; check for valid pointer
  1. . S CDIEN=+$P(PTF0,U,7) ; closed out by field
  1. . S CDNM=$P($G(^VA(200,CDIEN,0)),U,1) ; try to get the name
  1. . I CDNM="" D
  1. .. S D1=$O(^DGPT(PTF,1,99999999),-1) Q:'D1
  1. .. S CDIEN=+$P($G(^DGPT(PTF,1,D1,0)),U,1) ; coding clerk field
  1. .. S CDNM=$P($G(^VA(200,CDIEN,0)),U,1) ; try to get the name
  1. .. Q
  1. . S $P(Y,U,2,3)=CDIEN_U_CDNM ; save the data
  1. . Q
  1. ;
  1. ; *** Outpatient Bill Processing ***
  1. ; Use the Outpatient Encounter file (#409.68)
  1. ;
  1. S DFN=$P(IBD0,U,2) ; patient ien
  1. S IBDU=$G(^DGCR(399,IBIFN,"U")) ; "U" node
  1. S BEGDATE=$P(IBDU,U,1) ; statement covers from
  1. S ENDDATE=$P(IBDU,U,2) ; statement covers to
  1. ;
  1. ; If there's a problem with either of these dates, use the event date
  1. I 'BEGDATE!'ENDDATE S (BEGDATE,ENDDATE)=$P(IBD0,U,3)
  1. KILL ^TMP($J,"IBCICODER") ; kill scratch global
  1. S ENCDT=$O(^SCE("ADFN",DFN,BEGDATE),-1) ; get the starting date
  1. F S ENCDT=$O(^SCE("ADFN",DFN,ENCDT)) Q:'ENCDT!($P(ENCDT,".",1)>ENDDATE) D
  1. . S IEN=0
  1. . F S IEN=$O(^SCE("ADFN",DFN,ENCDT,IEN)) Q:'IEN D
  1. .. S SCE=$G(^SCE(IEN,"USER"))
  1. .. I '$P(SCE,U,1) Q ; edited last by
  1. .. I '$P(SCE,U,2) Q ; date/time last edited
  1. .. S ^TMP($J,"IBCICODER",$P(SCE,U,2),IEN)=$P(SCE,U,1)
  1. .. Q
  1. . Q
  1. ;
  1. I '$D(^TMP($J,"IBCICODER")) G CODERX ; get out if no hits
  1. S LSTEDT=$O(^TMP($J,"IBCICODER",""),-1) ; most recent date
  1. S IEN=$O(^TMP($J,"IBCICODER",LSTEDT,""),-1) ; most recent ien
  1. S CDIEN=^TMP($J,"IBCICODER",LSTEDT,IEN) ; edited last by field
  1. S CDNM=$P($G(^VA(200,CDIEN,0)),U,1) ; try to get the name
  1. KILL ^TMP($J,"IBCICODER") ; clean up scratch global
  1. S $P(Y,U,2,3)=CDIEN_U_CDNM ; save the data
  1. CODERX ;
  1. Q Y
  1. ;
  1. ;
  1. BILLER(IBIFN) ; Returns the entered/edited by person for this bill
  1. ;
  1. ; Input into this function
  1. ; IBIFN - ien of the bill/claims file (#399)
  1. ;
  1. ; Output from this function
  1. ; A string with the following 2 pieces:
  1. ; [1] biller's ien in the new person file (#200)
  1. ; [2] biller's name
  1. ;
  1. NEW Y
  1. S IBIFN=+$G(IBIFN)
  1. S Y=+$P($G(^DGCR(399,IBIFN,"S")),U,2)
  1. ;
  1. ; if the POSTMASTER is identified as the biller, then try in file 351.9
  1. I Y=.5 D
  1. . S Y=+$P($G(^IBA(351.9,IBIFN,0)),U,5) ; last sent to CM by
  1. . I 'Y S Y=+$P($G(^IBA(351.9,IBIFN,0)),U,9) ; last edited by
  1. . I 'Y S Y=.5 ; postmaster default
  1. . Q
  1. ;
  1. S $P(Y,U,2)=$P($G(^VA(200,Y,0)),U,1)
  1. BILLERX ;
  1. Q Y
  1. ;
  1. CMTINFO(IBIFN) ; Comment Information; Username, date/time stamp display
  1. ;
  1. ; Returns a line of text in the following format
  1. ; "Comment entered by [username] on [date/time]"
  1. ;
  1. ; Returns "" if no comments or no pointers
  1. ;
  1. NEW Y,IB0,WHEN,USER
  1. S Y="",IBIFN=+$G(IBIFN)
  1. I '$D(^IBA(351.9,IBIFN,2)) G CMTINX
  1. S IB0=$G(^IBA(351.9,IBIFN,0))
  1. S WHEN=$$EXTERNAL^DILFD(351.9,.13,"",$P(IB0,U,13))
  1. S USER=$$EXTERNAL^DILFD(351.9,.14,"",$P(IB0,U,14))
  1. I WHEN="",USER="" G CMTINX
  1. S Y="Comments last edited by "_USER_" on "_WHEN
  1. CMTINX ;
  1. Q Y
  1. ;
  1. TD(IBIFN) ; Terminal digit
  1. ;
  1. ; Input = IBIFN
  1. ; Output = A pieced string
  1. ; [1] terminal digit of SSN
  1. ; [2] SSN
  1. ;
  1. NEW Y,DFN,SSN,TD
  1. S IBIFN=+$G(IBIFN)
  1. S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2)
  1. S SSN=$P($G(^DPT(DFN,0)),U,9)
  1. S TD="999999999"
  1. I $L(SSN)'<9 S TD=$E(SSN,8,9)_$E(SSN,6,7)_$E(SSN,4,5)_$E(SSN,1,3)
  1. S Y=TD_U_SSN
  1. TDX ;
  1. Q Y
  1. ;
  1. GETMOD(Z) ; Build a comma delimited string of modifier codes
  1. ;
  1. ; Input: a comma delimited string of modifier ien's
  1. ; Output: a comma delimited string of external modifiers
  1. ;
  1. NEW IBMOD,I,IEN,MOD
  1. S IBMOD=""
  1. I Z="" G GETMODX
  1. F I=1:1:$L(Z,",") S IEN=$P(Z,",",I) D
  1. . I IEN="" Q
  1. . S MOD=$$MOD^ICPTMOD(IEN,"I")
  1. . I MOD<1 Q
  1. . I IBMOD="" S IBMOD=$P(MOD,U,2)
  1. . E S IBMOD=IBMOD_","_$P(MOD,U,2)
  1. . Q
  1. GETMODX ;
  1. Q IBMOD
  1. ;
  1. DASN(IBIFN) ; Delete the assigned to person field in 351.9
  1. NEW DIE,DA,DR,%,D,D0,DI,DIC,DQ,X
  1. S DIE="^IBA(351.9,",DA=IBIFN,DR=".12///@"
  1. D ^DIE
  1. DASNX ;
  1. Q
  1. ;
  1. ;
  1. ENV() ; This function will return either a "T" for test claim or a "L" for
  1. ; live claim. This is the message type of the claim in the Ingenix
  1. ; interface specs. This value will be determined based on the value
  1. ; of IBCISNT and also which VistA environment we are currently in.
  1. ;
  1. NEW MSGTYP,MNETNAME,TNM
  1. S TNM=".TEST.MIR.TST.MIRROR.TRAIN." ; various test names
  1. S MSGTYP="T" ; assume Test claim
  1. I $G(IBCISNT)=3 G ENVX ; test send to CM
  1. ;
  1. ; Check the node name and make sure it exists and is not a test name
  1. S MNETNAME=$G(^XMB("NETNAME"))
  1. I MNETNAME="" G ENVX
  1. I $F(TNM,"."_$P(MNETNAME,".",1)_".") G ENVX
  1. ;
  1. S MSGTYP="L" ; Otherwise it's a Live claim
  1. ENVX ;
  1. Q MSGTYP
  1. ;