- IBTRHLU ;ALB/JWS - Receive and store 278 Response message ;05-JUN-2014
- ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;
- SPAR ; **Segment Parsing
- ;
- ; This tag will parse the current segment referenced by the HCT index
- ; and place the results in the IBSEG array.
- ;
- ; Input Variables
- ; HCT
- ;
- ; Output Variables
- ; IBSEG (ARRAY of fields in segment)
- ;
- N II,IJ,IK,IM,IS,ISBEG,ISCT,ISDATA,ISEND,ISPEC,LSDATA,NPC
- ;
- ;Reset IBSEG
- K IBSEG
- ;
- S ISCT="",II=-1,IS=0
- F S ISCT=$O(^TMP($J,"IBTRHLI",HCT,ISCT)) Q:ISCT="" D
- . S IS=IS+1
- . S ISDATA(IS)=$G(^TMP($J,"IBTRHLI",HCT,ISCT))
- . I $O(^TMP($J,"IBTRHLI",HCT,ISCT))="" S ISDATA(IS)=ISDATA(IS)_HLFS
- . S ISPEC(IS)=$L(ISDATA(IS),HLFS)
- . Q
- S IM=0,LSDATA=""
- LP ;**
- S IM=IM+1 Q:IM>IS
- S LSDATA=LSDATA_ISDATA(IM),NPC=ISPEC(IM)
- F IJ=1:1:NPC-1 D
- . S II=II+1,IBSEG(II)=$$CLNSTR($P(LSDATA,HLFS,IJ),$E(HL("ECH"),1,2)_$E(HL("ECH"),4),$E(HL("ECH")))
- . I II=0,IBSEG(0)="MSH" S II=II+1,IBSEG(1)="|"
- S LSDATA=$P(LSDATA,HLFS,NPC)
- G LP
- CLNSTR(STRING,CHARS,SUBSEP) ;** Remove extra trailing components and subcomponents in the HL7 seg
- N NUMPEC,PEC,RTSTRING
- S RTSTRING=$$RTRIMCH(STRING,CHARS)
- ; Now we have string w/o trailing chars, remove from subs
- S NUMPEC=$L(RTSTRING,SUBSEP)
- F PEC=1:1:NUMPEC S $P(RTSTRING,SUBSEP,PEC)=$$RTRIMCH($P(RTSTRING,SUBSEP,PEC),CHARS)
- Q RTSTRING
- ;
- RTRIMCH(STR,CHRS) ;** Remove the trailing chars from string
- N R,L
- S L=1,CHRS=$G(CHRS," ")
- F R=$L(STR):-1:1 Q:CHRS'[$E(STR,R)
- I L=R,(CHRS[$E(STR)) S STR=""
- Q $E(STR,L,R)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRHLU 1630 printed Apr 23, 2025@18:43:07 Page 2
- IBTRHLU ;ALB/JWS - Receive and store 278 Response message ;05-JUN-2014
- +1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;
- SPAR ; **Segment Parsing
- +1 ;
- +2 ; This tag will parse the current segment referenced by the HCT index
- +3 ; and place the results in the IBSEG array.
- +4 ;
- +5 ; Input Variables
- +6 ; HCT
- +7 ;
- +8 ; Output Variables
- +9 ; IBSEG (ARRAY of fields in segment)
- +10 ;
- +11 NEW II,IJ,IK,IM,IS,ISBEG,ISCT,ISDATA,ISEND,ISPEC,LSDATA,NPC
- +12 ;
- +13 ;Reset IBSEG
- +14 KILL IBSEG
- +15 ;
- +16 SET ISCT=""
- SET II=-1
- SET IS=0
- +17 FOR
- SET ISCT=$ORDER(^TMP($JOB,"IBTRHLI",HCT,ISCT))
- if ISCT=""
- QUIT
- Begin DoDot:1
- +18 SET IS=IS+1
- +19 SET ISDATA(IS)=$GET(^TMP($JOB,"IBTRHLI",HCT,ISCT))
- +20 IF $ORDER(^TMP($JOB,"IBTRHLI",HCT,ISCT))=""
- SET ISDATA(IS)=ISDATA(IS)_HLFS
- +21 SET ISPEC(IS)=$LENGTH(ISDATA(IS),HLFS)
- +22 QUIT
- End DoDot:1
- +23 SET IM=0
- SET LSDATA=""
- LP ;**
- +1 SET IM=IM+1
- if IM>IS
- QUIT
- +2 SET LSDATA=LSDATA_ISDATA(IM)
- SET NPC=ISPEC(IM)
- +3 FOR IJ=1:1:NPC-1
- Begin DoDot:1
- +4 SET II=II+1
- SET IBSEG(II)=$$CLNSTR($PIECE(LSDATA,HLFS,IJ),$EXTRACT(HL("ECH"),1,2)_$EXTRACT(HL("ECH"),4),$EXTRACT(HL("ECH")))
- +5 IF II=0
- IF IBSEG(0)="MSH"
- SET II=II+1
- SET IBSEG(1)="|"
- End DoDot:1
- +6 SET LSDATA=$PIECE(LSDATA,HLFS,NPC)
- +7 GOTO LP
- CLNSTR(STRING,CHARS,SUBSEP) ;** Remove extra trailing components and subcomponents in the HL7 seg
- +1 NEW NUMPEC,PEC,RTSTRING
- +2 SET RTSTRING=$$RTRIMCH(STRING,CHARS)
- +3 ; Now we have string w/o trailing chars, remove from subs
- +4 SET NUMPEC=$LENGTH(RTSTRING,SUBSEP)
- +5 FOR PEC=1:1:NUMPEC
- SET $PIECE(RTSTRING,SUBSEP,PEC)=$$RTRIMCH($PIECE(RTSTRING,SUBSEP,PEC),CHARS)
- +6 QUIT RTSTRING
- +7 ;
- RTRIMCH(STR,CHRS) ;** Remove the trailing chars from string
- +1 NEW R,L
- +2 SET L=1
- SET CHRS=$GET(CHRS," ")
- +3 FOR R=$LENGTH(STR):-1:1
- if CHRS'[$EXTRACT(STR,R)
- QUIT
- +4 IF L=R
- IF (CHRS[$EXTRACT(STR))
- SET STR=""
- +5 QUIT $EXTRACT(STR,L,R)
- +6 ;
