- 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 Jan 18, 2025@03:14:43 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 ;