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