source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLPR1.m@ 1394

Last change on this file since 1394 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1VAFHLPR1 ;ALB/ESD - Create generic HL7 PR1 Segment ;4/4/00
2 ;;5.3;Registration;**94,123,160,215,243,606**;Aug 13, 1993
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 ;
11EN(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 ;
46ALL ; - 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 ;
63ENQ Q
64 ;
65 ;
66BUILD ; - 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
136DONE 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
140NOMODS S:'MODIND @VAFARRY@(VAFIDX,WRAPCNT)=VAFY_VAFHLFS
141 Q
Note: See TracBrowser for help on using the repository browser.