VAFHLPR1 ;ALB/ESD - Create generic HL7 PR1 Segment ;4/4/00
;;5.3;Registration;**94,123,160,215,243,606**;Aug 13, 1993
;06/22/99 ACS - Added CPT modifier API calls and added CPT modifier to the
;PR1 segment (sequence 16)
;
; This function will create VA-specific PR1 segment(s) for a
; given outpatient encounter. The PR1 segment is designed to transfer
; information relative to various types of procedures performed during
; a patient visit.
;
EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFHLECH,VAFARRY) ; Entry point for Ambulatory Care Database Project
; - Entry point to return the HL7 PR1 segment
;
; Input: VAFENC - IEN of the Outpatient Encounter (#409.68) file
; VAFSTR - String of fields requested separated by commas
; VAFHLQ - Optional HL7 null variable. If not there, use
; default HL7 variable
; VAFHLFS - Optional HL7 field separator. If not there, use
; default HL7 variable
; VAFHLECH - HL7 variable containing encoding characters
; VAFARRY - Optional user-supplied array name which will hold PR1 segments
;
; Output: Array of HL7 PR1 segments
;
;
N I,J,VAFCPT,VAFIDX,VAFPR,VAFPROC,VAFPRTYP,VAFY,X,PTRVCPT,PROCCNT,PROCLOOP,ICPTVDT
S (J,VAFIDX)=0
S VAFARRY=$G(VAFARRY),ICPTVDT=$$SCE^DGSDU(VAFENC,1,0)
;
; - Variable ICPTVDT gets correct CPT/Modifier descriptor for event date
;
; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"PROCEDURE")
S:(VAFARRY="") VAFARRY="^TMP(""VAFHL"",$J,""PROCEDURE"")"
;
; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables
S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
I '$G(VAFENC)!($G(VAFSTR)']"") S @VAFARRY@(1,J)="PR1"_VAFHLFS_1 G ENQ
S VAFSTR=","_VAFSTR_","
;
; - Get procedures for encounter
D GETCPT^SDOE(VAFENC,"VAFPROC")
;
; - Set procedure array to 0 if no procedures to loop thru once
I '$G(VAFPROC) S VAFPROC(1)=0
;
ALL ; - All procedures for encounter
S PTRVCPT=0
F S PTRVCPT=+$O(VAFPROC(PTRVCPT)) Q:('PTRVCPT) D
.;S VAFPR=$G(^ICPT(+$G(VAFPROC(PTRVCPT)),0))
.N CPTINFO
.S CPTINFO=$$CPT^ICPTCOD(+$G(VAFPROC(PTRVCPT)),,1)
.Q:CPTINFO'>0
.S VAFPR=$P(CPTINFO,"^",2,99)
.S:($P(VAFPR,"^",1)="") $P(VAFPR,"^",1)=VAFHLQ
.S:($P(VAFPR,"^",2)="") $P(VAFPR,"^",2)=VAFHLQ
.;
.; - Build array of HL7 (PR1) segments
.; Repeated procedures get individual segment
.S PROCCNT=+$P($G(VAFPROC(PTRVCPT)),"^",16)
.S:('PROCCNT) PROCCNT=1
.F PROCLOOP=1:1:PROCCNT D BUILD
;
ENQ Q
;
;
BUILD ; - Build array of HL7 (PR1) segments
S J=0,VAFIDX=VAFIDX+1,VAFY=""
S VAFCPT="C4" ; Procedure Coding Method = C4 (CPT-4)
;
; - Build HL7 (PR1) segment fields
;
; - Sequential number (required field)
S $P(VAFY,VAFHLFS,1)=VAFIDX
;
I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFCPT)]"":VAFCPT,1:VAFHLQ) ; Procedure Coding Method = CPT-4
I (VAFSTR[",3,") D
.;Procedure Code
.S X=$P(VAFPR,"^",1)
.;Procedure Description
.S $P(X,$E(VAFHLECH,1),2)=$P(VAFPR,"^",2)
.;Procedure Coding Method
.S $P(X,$E(VAFHLECH,1),3)=VAFCPT
.;Add to segment
.S $P(VAFY,VAFHLFS,3)=X
I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$P(VAFPR,"^",2) ; Procedure Description
;
; *** Add CPT modifiers to sequence 16 ***
; VAFY = PR1 segment
; MAXLEN = maximum length of the segment
; WRAPCNT = continuation segment count (currently 0)
; FSFLAG = field separator flag: 1="^", 0="|"
; MODIND = indicates if a modifier has been added to the segment
;
N MAXLEN,WRAPCNT,FSFLAG,MODIND
S MAXLEN=245,WRAPCNT=0,FSFLAG=1,MODIND=0
;
;- set up VAFY to have 15 sequences, then concatenate "PR1"
; onto front of segment for a total of 16 sequences
S $P(VAFY,VAFHLFS,15)=""
S VAFY="PR1"_VAFHLFS_VAFY
;
;check if modifiers are requested
I VAFSTR'[",16," G NOMODS
;
;- spin through CPT array VAFPROC and retrieve modifiers
;- set MODIND flag to 1 if modifiers found
N PTR,MODPTR,MODINFO,MODCODE,MODTEXT,MODMETH,MODSEQ,SEGLEN
S PTR=0
F S PTR=+$O(VAFPROC(PTRVCPT,1,PTR)) Q:'PTR D
. S MODPTR=$G(VAFPROC(PTRVCPT,1,PTR,0))
. Q:'MODPTR
. S MODIND=1
. ;
. ;- get modifier and coding method
. S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",,1)
. Q:MODINFO'>0
. S MODCODE=$P(MODINFO,"^",2)
. S MODTEXT=""
. S MODMETH=$P(MODINFO,"^",5)
. ;
. ;- get correct field separator and build sequence
. S MODSEQ=$S(FSFLAG:VAFHLFS,1:$E(VAFHLECH,2))_MODCODE
. S MODSEQ=MODSEQ_$E(VAFHLECH,1)_MODTEXT
. S MODSEQ=MODSEQ_$E(VAFHLECH,1)_MODMETH
. S FSFLAG=0
. ;
. ;- check length of VAFY segment
. S SEGLEN=$L(VAFY)+$L(MODSEQ)
. I SEGLEN>MAXLEN G DONE
. S VAFY=VAFY_MODSEQ
. Q
;
;- --Done spinning through the modifiers--
;- if modifiers were added to the segment, write out the
; last modifier
DONE S:MODIND @VAFARRY@(VAFIDX,WRAPCNT)=VAFY
;
;- if no modifiers were added to the segment, write segment with
; field separator as an empty place holder
NOMODS S:'MODIND @VAFARRY@(VAFIDX,WRAPCNT)=VAFY_VAFHLFS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLPR1 5065 printed Dec 13, 2024@03:03:09 Page 2
VAFHLPR1 ;ALB/ESD - Create generic HL7 PR1 Segment ;4/4/00
+1 ;;5.3;Registration;**94,123,160,215,243,606**;Aug 13, 1993
+2 ;06/22/99 ACS - Added CPT modifier API calls and added CPT modifier to the
+3 ;PR1 segment (sequence 16)
+4 ;
+5 ; This function will create VA-specific PR1 segment(s) for a
+6 ; given outpatient encounter. The PR1 segment is designed to transfer
+7 ; information relative to various types of procedures performed during
+8 ; a patient visit.
+9 ;
EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFHLECH,VAFARRY) ; Entry point for Ambulatory Care Database Project
+1 ; - Entry point to return the HL7 PR1 segment
+2 ;
+3 ; Input: VAFENC - IEN of the Outpatient Encounter (#409.68) file
+4 ; VAFSTR - String of fields requested separated by commas
+5 ; VAFHLQ - Optional HL7 null variable. If not there, use
+6 ; default HL7 variable
+7 ; VAFHLFS - Optional HL7 field separator. If not there, use
+8 ; default HL7 variable
+9 ; VAFHLECH - HL7 variable containing encoding characters
+10 ; VAFARRY - Optional user-supplied array name which will hold PR1 segments
+11 ;
+12 ; Output: Array of HL7 PR1 segments
+13 ;
+14 ;
+15 NEW I,J,VAFCPT,VAFIDX,VAFPR,VAFPROC,VAFPRTYP,VAFY,X,PTRVCPT,PROCCNT,PROCLOOP,ICPTVDT
+16 SET (J,VAFIDX)=0
+17 SET VAFARRY=$GET(VAFARRY)
SET ICPTVDT=$$SCE^DGSDU(VAFENC,1,0)
+18 ;
+19 ; - Variable ICPTVDT gets correct CPT/Modifier descriptor for event date
+20 ;
+21 ; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"PROCEDURE")
+22 if (VAFARRY="")
SET VAFARRY="^TMP(""VAFHL"",$J,""PROCEDURE"")"
+23 ;
+24 ; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables
+25 SET VAFHLQ=$SELECT($DATA(VAFHLQ):VAFHLQ,1:$GET(HLQ))
SET VAFHLFS=$SELECT($DATA(VAFHLFS):VAFHLFS,1:$GET(HLFS))
+26 IF '$GET(VAFENC)!($GET(VAFSTR)']"")
SET @VAFARRY@(1,J)="PR1"_VAFHLFS_1
GOTO ENQ
+27 SET VAFSTR=","_VAFSTR_","
+28 ;
+29 ; - Get procedures for encounter
+30 DO GETCPT^SDOE(VAFENC,"VAFPROC")
+31 ;
+32 ; - Set procedure array to 0 if no procedures to loop thru once
+33 IF '$GET(VAFPROC)
SET VAFPROC(1)=0
+34 ;
ALL ; - All procedures for encounter
+1 SET PTRVCPT=0
+2 FOR
SET PTRVCPT=+$ORDER(VAFPROC(PTRVCPT))
if ('PTRVCPT)
QUIT
Begin DoDot:1
+3 ;S VAFPR=$G(^ICPT(+$G(VAFPROC(PTRVCPT)),0))
+4 NEW CPTINFO
+5 SET CPTINFO=$$CPT^ICPTCOD(+$GET(VAFPROC(PTRVCPT)),,1)
+6 if CPTINFO'>0
QUIT
+7 SET VAFPR=$PIECE(CPTINFO,"^",2,99)
+8 if ($PIECE(VAFPR,"^",1)="")
SET $PIECE(VAFPR,"^",1)=VAFHLQ
+9 if ($PIECE(VAFPR,"^",2)="")
SET $PIECE(VAFPR,"^",2)=VAFHLQ
+10 ;
+11 ; - Build array of HL7 (PR1) segments
+12 ; Repeated procedures get individual segment
+13 SET PROCCNT=+$PIECE($GET(VAFPROC(PTRVCPT)),"^",16)
+14 if ('PROCCNT)
SET PROCCNT=1
+15 FOR PROCLOOP=1:1:PROCCNT
DO BUILD
End DoDot:1
+16 ;
ENQ QUIT
+1 ;
+2 ;
BUILD ; - Build array of HL7 (PR1) segments
+1 SET J=0
SET VAFIDX=VAFIDX+1
SET VAFY=""
+2 ; Procedure Coding Method = C4 (CPT-4)
SET VAFCPT="C4"
+3 ;
+4 ; - Build HL7 (PR1) segment fields
+5 ;
+6 ; - Sequential number (required field)
+7 SET $PIECE(VAFY,VAFHLFS,1)=VAFIDX
+8 ;
+9 ; Procedure Coding Method = CPT-4
IF VAFSTR[",2,"
SET $PIECE(VAFY,VAFHLFS,2)=$SELECT($GET(VAFCPT)]"":VAFCPT,1:VAFHLQ)
+10 IF (VAFSTR[",3,")
Begin DoDot:1
+11 ;Procedure Code
+12 SET X=$PIECE(VAFPR,"^",1)
+13 ;Procedure Description
+14 SET $PIECE(X,$EXTRACT(VAFHLECH,1),2)=$PIECE(VAFPR,"^",2)
+15 ;Procedure Coding Method
+16 SET $PIECE(X,$EXTRACT(VAFHLECH,1),3)=VAFCPT
+17 ;Add to segment
+18 SET $PIECE(VAFY,VAFHLFS,3)=X
End DoDot:1
+19 ; Procedure Description
IF VAFSTR[",4,"
SET $PIECE(VAFY,VAFHLFS,4)=$PIECE(VAFPR,"^",2)
+20 ;
+21 ; *** Add CPT modifiers to sequence 16 ***
+22 ; VAFY = PR1 segment
+23 ; MAXLEN = maximum length of the segment
+24 ; WRAPCNT = continuation segment count (currently 0)
+25 ; FSFLAG = field separator flag: 1="^", 0="|"
+26 ; MODIND = indicates if a modifier has been added to the segment
+27 ;
+28 NEW MAXLEN,WRAPCNT,FSFLAG,MODIND
+29 SET MAXLEN=245
SET WRAPCNT=0
SET FSFLAG=1
SET MODIND=0
+30 ;
+31 ;- set up VAFY to have 15 sequences, then concatenate "PR1"
+32 ; onto front of segment for a total of 16 sequences
+33 SET $PIECE(VAFY,VAFHLFS,15)=""
+34 SET VAFY="PR1"_VAFHLFS_VAFY
+35 ;
+36 ;check if modifiers are requested
+37 IF VAFSTR'[",16,"
GOTO NOMODS
+38 ;
+39 ;- spin through CPT array VAFPROC and retrieve modifiers
+40 ;- set MODIND flag to 1 if modifiers found
+41 NEW PTR,MODPTR,MODINFO,MODCODE,MODTEXT,MODMETH,MODSEQ,SEGLEN
+42 SET PTR=0
+43 FOR
SET PTR=+$ORDER(VAFPROC(PTRVCPT,1,PTR))
if 'PTR
QUIT
Begin DoDot:1
+44 SET MODPTR=$GET(VAFPROC(PTRVCPT,1,PTR,0))
+45 if 'MODPTR
QUIT
+46 SET MODIND=1
+47 ;
+48 ;- get modifier and coding method
+49 SET MODINFO=$$MOD^ICPTMOD(MODPTR,"I",,1)
+50 if MODINFO'>0
QUIT
+51 SET MODCODE=$PIECE(MODINFO,"^",2)
+52 SET MODTEXT=""
+53 SET MODMETH=$PIECE(MODINFO,"^",5)
+54 ;
+55 ;- get correct field separator and build sequence
+56 SET MODSEQ=$SELECT(FSFLAG:VAFHLFS,1:$EXTRACT(VAFHLECH,2))_MODCODE
+57 SET MODSEQ=MODSEQ_$EXTRACT(VAFHLECH,1)_MODTEXT
+58 SET MODSEQ=MODSEQ_$EXTRACT(VAFHLECH,1)_MODMETH
+59 SET FSFLAG=0
+60 ;
+61 ;- check length of VAFY segment
+62 SET SEGLEN=$LENGTH(VAFY)+$LENGTH(MODSEQ)
+63 IF SEGLEN>MAXLEN
GOTO DONE
+64 SET VAFY=VAFY_MODSEQ
+65 QUIT
End DoDot:1
+66 ;
+67 ;- --Done spinning through the modifiers--
+68 ;- if modifiers were added to the segment, write out the
+69 ; last modifier
DONE if MODIND
SET @VAFARRY@(VAFIDX,WRAPCNT)=VAFY
+1 ;
+2 ;- if no modifiers were added to the segment, write segment with
+3 ; field separator as an empty place holder
NOMODS if 'MODIND
SET @VAFARRY@(VAFIDX,WRAPCNT)=VAFY_VAFHLFS
+1 QUIT
