[613] | 1 | VAFHLPR1 ;ALB/ESD - Create generic HL7 PR1 Segment ;4/4/00
|
---|
| 2 | ;;5.3;Registration;**94,123,160,215,243,606**;Aug 13, 1993;Build 1
|
---|
| 3 | ;06/22/99 ACS - Added CPT modifier API calls and added CPT modifier to the
|
---|
| 4 | ;PR1 segment (sequence 16)
|
---|
| 5 | ;
|
---|
| 6 | ; This function will create VA-specific PR1 segment(s) for a
|
---|
| 7 | ; given outpatient encounter. The PR1 segment is designed to transfer
|
---|
| 8 | ; information relative to various types of procedures performed during
|
---|
| 9 | ; a patient visit.
|
---|
| 10 | ;
|
---|
| 11 | EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFHLECH,VAFARRY) ; Entry point for Ambulatory Care Database Project
|
---|
| 12 | ; - Entry point to return the HL7 PR1 segment
|
---|
| 13 | ;
|
---|
| 14 | ; Input: VAFENC - IEN of the Outpatient Encounter (#409.68) file
|
---|
| 15 | ; VAFSTR - String of fields requested separated by commas
|
---|
| 16 | ; VAFHLQ - Optional HL7 null variable. If not there, use
|
---|
| 17 | ; default HL7 variable
|
---|
| 18 | ; VAFHLFS - Optional HL7 field separator. If not there, use
|
---|
| 19 | ; default HL7 variable
|
---|
| 20 | ; VAFHLECH - HL7 variable containing encoding characters
|
---|
| 21 | ; VAFARRY - Optional user-supplied array name which will hold PR1 segments
|
---|
| 22 | ;
|
---|
| 23 | ; Output: Array of HL7 PR1 segments
|
---|
| 24 | ;
|
---|
| 25 | ;
|
---|
| 26 | N I,J,VAFCPT,VAFIDX,VAFPR,VAFPROC,VAFPRTYP,VAFY,X,PTRVCPT,PROCCNT,PROCLOOP,ICPTVDT
|
---|
| 27 | S (J,VAFIDX)=0
|
---|
| 28 | S VAFARRY=$G(VAFARRY),ICPTVDT=$$SCE^DGSDU(VAFENC,1,0)
|
---|
| 29 | ;
|
---|
| 30 | ; - Variable ICPTVDT gets correct CPT/Modifier descriptor for event date
|
---|
| 31 | ;
|
---|
| 32 | ; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"PROCEDURE")
|
---|
| 33 | S:(VAFARRY="") VAFARRY="^TMP(""VAFHL"",$J,""PROCEDURE"")"
|
---|
| 34 | ;
|
---|
| 35 | ; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables
|
---|
| 36 | S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
|
---|
| 37 | I '$G(VAFENC)!($G(VAFSTR)']"") S @VAFARRY@(1,J)="PR1"_VAFHLFS_1 G ENQ
|
---|
| 38 | S VAFSTR=","_VAFSTR_","
|
---|
| 39 | ;
|
---|
| 40 | ; - Get procedures for encounter
|
---|
| 41 | D GETCPT^SDOE(VAFENC,"VAFPROC")
|
---|
| 42 | ;
|
---|
| 43 | ; - Set procedure array to 0 if no procedures to loop thru once
|
---|
| 44 | I '$G(VAFPROC) S VAFPROC(1)=0
|
---|
| 45 | ;
|
---|
| 46 | ALL ; - All procedures for encounter
|
---|
| 47 | S PTRVCPT=0
|
---|
| 48 | F S PTRVCPT=+$O(VAFPROC(PTRVCPT)) Q:('PTRVCPT) D
|
---|
| 49 | .;S VAFPR=$G(^ICPT(+$G(VAFPROC(PTRVCPT)),0))
|
---|
| 50 | .N CPTINFO
|
---|
| 51 | .S CPTINFO=$$CPT^ICPTCOD(+$G(VAFPROC(PTRVCPT)),,1)
|
---|
| 52 | .Q:CPTINFO'>0
|
---|
| 53 | .S VAFPR=$P(CPTINFO,"^",2,99)
|
---|
| 54 | .S:($P(VAFPR,"^",1)="") $P(VAFPR,"^",1)=VAFHLQ
|
---|
| 55 | .S:($P(VAFPR,"^",2)="") $P(VAFPR,"^",2)=VAFHLQ
|
---|
| 56 | .;
|
---|
| 57 | .; - Build array of HL7 (PR1) segments
|
---|
| 58 | .; Repeated procedures get individual segment
|
---|
| 59 | .S PROCCNT=+$P($G(VAFPROC(PTRVCPT)),"^",16)
|
---|
| 60 | .S:('PROCCNT) PROCCNT=1
|
---|
| 61 | .F PROCLOOP=1:1:PROCCNT D BUILD
|
---|
| 62 | ;
|
---|
| 63 | ENQ Q
|
---|
| 64 | ;
|
---|
| 65 | ;
|
---|
| 66 | BUILD ; - Build array of HL7 (PR1) segments
|
---|
| 67 | S J=0,VAFIDX=VAFIDX+1,VAFY=""
|
---|
| 68 | S VAFCPT="C4" ; Procedure Coding Method = C4 (CPT-4)
|
---|
| 69 | ;
|
---|
| 70 | ; - Build HL7 (PR1) segment fields
|
---|
| 71 | ;
|
---|
| 72 | ; - Sequential number (required field)
|
---|
| 73 | S $P(VAFY,VAFHLFS,1)=VAFIDX
|
---|
| 74 | ;
|
---|
| 75 | I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFCPT)]"":VAFCPT,1:VAFHLQ) ; Procedure Coding Method = CPT-4
|
---|
| 76 | I (VAFSTR[",3,") D
|
---|
| 77 | .;Procedure Code
|
---|
| 78 | .S X=$P(VAFPR,"^",1)
|
---|
| 79 | .;Procedure Description
|
---|
| 80 | .S $P(X,$E(VAFHLECH,1),2)=$P(VAFPR,"^",2)
|
---|
| 81 | .;Procedure Coding Method
|
---|
| 82 | .S $P(X,$E(VAFHLECH,1),3)=VAFCPT
|
---|
| 83 | .;Add to segment
|
---|
| 84 | .S $P(VAFY,VAFHLFS,3)=X
|
---|
| 85 | I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$P(VAFPR,"^",2) ; Procedure Description
|
---|
| 86 | ;
|
---|
| 87 | ; *** Add CPT modifiers to sequence 16 ***
|
---|
| 88 | ; VAFY = PR1 segment
|
---|
| 89 | ; MAXLEN = maximum length of the segment
|
---|
| 90 | ; WRAPCNT = continuation segment count (currently 0)
|
---|
| 91 | ; FSFLAG = field separator flag: 1="^", 0="|"
|
---|
| 92 | ; MODIND = indicates if a modifier has been added to the segment
|
---|
| 93 | ;
|
---|
| 94 | N MAXLEN,WRAPCNT,FSFLAG,MODIND
|
---|
| 95 | S MAXLEN=245,WRAPCNT=0,FSFLAG=1,MODIND=0
|
---|
| 96 | ;
|
---|
| 97 | ;- set up VAFY to have 15 sequences, then concatenate "PR1"
|
---|
| 98 | ; onto front of segment for a total of 16 sequences
|
---|
| 99 | S $P(VAFY,VAFHLFS,15)=""
|
---|
| 100 | S VAFY="PR1"_VAFHLFS_VAFY
|
---|
| 101 | ;
|
---|
| 102 | ;check if modifiers are requested
|
---|
| 103 | I VAFSTR'[",16," G NOMODS
|
---|
| 104 | ;
|
---|
| 105 | ;- spin through CPT array VAFPROC and retrieve modifiers
|
---|
| 106 | ;- set MODIND flag to 1 if modifiers found
|
---|
| 107 | N PTR,MODPTR,MODINFO,MODCODE,MODTEXT,MODMETH,MODSEQ,SEGLEN
|
---|
| 108 | S PTR=0
|
---|
| 109 | F S PTR=+$O(VAFPROC(PTRVCPT,1,PTR)) Q:'PTR D
|
---|
| 110 | . S MODPTR=$G(VAFPROC(PTRVCPT,1,PTR,0))
|
---|
| 111 | . Q:'MODPTR
|
---|
| 112 | . S MODIND=1
|
---|
| 113 | . ;
|
---|
| 114 | . ;- get modifier and coding method
|
---|
| 115 | . S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",,1)
|
---|
| 116 | . Q:MODINFO'>0
|
---|
| 117 | . S MODCODE=$P(MODINFO,"^",2)
|
---|
| 118 | . S MODTEXT=""
|
---|
| 119 | . S MODMETH=$P(MODINFO,"^",5)
|
---|
| 120 | . ;
|
---|
| 121 | . ;- get correct field separator and build sequence
|
---|
| 122 | . S MODSEQ=$S(FSFLAG:VAFHLFS,1:$E(VAFHLECH,2))_MODCODE
|
---|
| 123 | . S MODSEQ=MODSEQ_$E(VAFHLECH,1)_MODTEXT
|
---|
| 124 | . S MODSEQ=MODSEQ_$E(VAFHLECH,1)_MODMETH
|
---|
| 125 | . S FSFLAG=0
|
---|
| 126 | . ;
|
---|
| 127 | . ;- check length of VAFY segment
|
---|
| 128 | . S SEGLEN=$L(VAFY)+$L(MODSEQ)
|
---|
| 129 | . I SEGLEN>MAXLEN G DONE
|
---|
| 130 | . S VAFY=VAFY_MODSEQ
|
---|
| 131 | . Q
|
---|
| 132 | ;
|
---|
| 133 | ;- --Done spinning through the modifiers--
|
---|
| 134 | ;- if modifiers were added to the segment, write out the
|
---|
| 135 | ; last modifier
|
---|
| 136 | DONE S:MODIND @VAFARRY@(VAFIDX,WRAPCNT)=VAFY
|
---|
| 137 | ;
|
---|
| 138 | ;- if no modifiers were added to the segment, write segment with
|
---|
| 139 | ; field separator as an empty place holder
|
---|
| 140 | NOMODS S:'MODIND @VAFARRY@(VAFIDX,WRAPCNT)=VAFY_VAFHLFS
|
---|
| 141 | Q
|
---|