Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRM7XT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRM7XT.m
r613 r623 1 PXRM7XT ;SLC/JVS HL7 EXTRACT FROM FILE; 06/01/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ;This is the beginning of the extraction from the extract file 4 ; 5 ;VARIABLE LIST 6 ;IEN = IEN OF ENTRY IN EXTRACT FILE 810.3 7 Q 8 SPLIT ;SPLIT MESSAGES 9 ; 10 N ORC2 11 I LINE>100 D 12 .S ORCCNT=ORCCNT+1 13 .D EN^PXRM7M1(.ID) 14 .K ^TMP("HLS",$J) 15 .S ORC2=$G(^TMP("PXRM7HLORC",$J)) 16 .S $P(ORC2,"|",3)="P"_ORCCNT,ORC=ORC2 17 .S LINE=2 18 .I $D(SEE) W !,ORC 19 .S ^TMP("HLS",$J,1)=ORC 20 Q 21 ; 22 EXTRACT(IEN,SEE,ID,MODE) ; 23 N ORCCNT 24 K ERROR,LINE 25 S ORCCNT=1 ;Count of ORC segments or number of messages created 26 S LINE=1 ;Line count for the ^TMP("HL7",$J,LINE) global variable 27 ;-Verify Values 28 I '$D(^PXRMXT(810.3,IEN)) S ERROR(1)="No Such IEN in file 810.3 "_IEN 29 I $D(ERROR) D Q 30 .I $D(SEE)=1 31 ;-Extracting Value of Nodes in file 32 I $D(ERROR) Q 33 D GETS^DIQ(810.3,IEN,"**","EI","^TMP(""PXRM7"",$J)") 34 D ORCSEG 35 ;******Add NTE segment to end of message ******* 36 ;******change 3rd piece of ORC segement to L (last)**** 37 S NTE="NTE||"_LAST_"||" 38 S ^TMP("HLS",$J,LINE)=NTE,LINE=LINE+1 39 I SEE=1 W !,NTE 40 K NTE,LAST 41 S ORC=$G(^TMP("HLS",$J,1)),$P(ORC,"|",3)="F"_ORCCNT,^TMP("HLS",$J,1)=ORC 42 ;*********************************************** 43 ;*******TURN ON BELOW TO TRANSMIT TO AUSTIN ***** 44 D EN^PXRM7M1(.ID) 45 ;*********************************************** 46 K ^TMP("PXRM7",$J) 47 K ^TMP("HLS",$J) 48 K ^TMP("PXRM7HLORC",$J) 49 ;********KILL LEFT OVER ARRAYS AND VARIABLES***** 50 K HL("EID"),HLA("HLS"),PROTIEN,PXRM7,PXRM77,PXRM7ID,PXRM7R,ZMID 51 K DA,DISYS,DISYS,EO,HL("EIDS"),HLECH,HLFS,HLN,HLQ,HLSAN,HLX 52 K IENIEN,IENOBR,IENX,IENY,IENZ,L,LINE,NEXT,QTI,RFS,SEQ 53 K STATION,USI 54 ;************************************************** 55 Q 56 ORCSEG ;CREATE ORC SEGMENTS 57 ;ORDERED IN ORDER OF APPEARANCE IN SEGMENT 58 ;QTI=QUANTITY AND TIMING 59 ;EO=ENTERING ORGANIZATION 60 ;--Below adds extra line feed in front of the message. -- 61 ;--------------------------------------------------- 62 S IENY=IEN_"," 63 ;--------------------------------------------- 64 ;0 PLACER ORDER NUMBER ORC.2.1 65 S $P(ORC,"|",3)="P1" 66 ;--------------------------------------------- 67 ;1 REPORTING PERIOD ORC.7.1.1 68 S QTI(1)=$G(^TMP("PXRM7",$J,810.3,IENY,3,"E")) 69 S $P(QTI,"~",1)=QTI(1) 70 ;--------------------------------------------- 71 ;2 QUARTER ORC.7.3 72 S QTI(3)=$G(^TMP("PXRM7",$J,810.3,IENY,7,"E")) 73 S $P(QTI,"~",3)=QTI(3) 74 ;--------------------------------------------- 75 ;3 BEGINNING DATE ORC.7.4.1 76 S QTI(4)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.02,"I")),"DT") 77 S $P(QTI,"~",4)=QTI(4) 78 ;--------------------------------------------- 79 ;4 ENDING DATE ORC.7.5.1 80 S QTI(5)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.03,"I")),"DT") 81 S $P(QTI,"~",5)=QTI(5) 82 ;--------------------------------------------- 83 ;5 REPORTING YEAR ORC.7.11.2 84 S QTI(11)="&"_$G(^TMP("PXRM7",$J,810.3,IENY,4,"E")) 85 S $P(QTI,"~",11)=QTI(11) 86 ;--------------------------------------------- 87 ;6 EXTRACT DATE ORC.9.1 88 S $P(ORC,"|",10)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.06,"I")),"DT") 89 ;--------------------------------------------- 90 ;7 NAME ORC.17.2 91 S EO(2)=$G(^TMP("PXRM7",$J,810.3,IENY,.01,"E")) 92 S $P(EO,"~",2)=EO(2) 93 ;--------------------------------------------- 94 ;8 REPORT EXTRACT PARAMETER ORC.17.5 95 S EO(5)=$G(^TMP("PXRM7",$J,810.3,IENY,1,"E")) 96 S $P(EO,"~",5)=EO(5) 97 ;--------------------------------------------- 98 ;9 REPORT EXTRACT TYPE ORC.18.2 99 S $P(ORC,"|",19)="~"_$G(^TMP("PXRM7",$J,810.3,IENY,2,"E")) 100 ;--------------------------------------------- 101 ;FINISH POPULATING ORC SEGMENT 102 S $P(ORC,"|",8)=QTI 103 S $P(ORC,"|",18)=EO 104 S $P(ORC,"|",1)="ORC" 105 ;--------------------------------------------- 106 ;SET HL7 TMP ARRAY AND SHOW SEGMENT 107 S ^TMP("HLS",$J,LINE)=ORC,LINE=LINE+1 108 I SEE=1 W !,ORC 109 S ^TMP("PXRM7HLORC",$J)=ORC 110 K ORC 111 OBRSEG ;CREATE OBR SEGMENTS 112 ;N IENOBR,SEQ,USI,QTI,NEXT,STATION 113 ;USI=UNIVERSAL SERVICE ID 114 ;RFS=REASON FOR STUDY 115 ; 116 S NEXT=1,LAST=0 117 S IENOBR=0 F S IENOBR=$O(^PXRMXT(810.3,IEN,3,IENOBR)) Q:IENOBR<1 D 118 .S IENIEN=-1 F S IENIEN=$O(^PXRMXT(810.3,IEN,3,IENOBR,1,IENIEN)) Q:IENIEN="B" D Q:IENIEN="" 119 ..S L=$S(IENIEN=0:1,IENIEN>0:2,IENIEN="":1,1:"") 120 ..;###---Set Sequence Number 121 ..S IENX=IENOBR_","_IEN_"," 122 ..S IENZ=IENIEN_","_IENOBR_","_IEN_"," 123 ..S SEQ=$G(^TMP("PXRM7",$J,810.33,IENX,.01,"E")) 124 ..S OBR(+SEQ_L)="OBR|1|||||||||||||||||||||||||||||||" 125 ..S $P(OBR(+SEQ_L),"|",2)=NEXT,LAST=NEXT,NEXT=NEXT+1 126 ..;-------------------------------------------------- 127 ..;10 COUNT TYPE OBR.4.2 128 ..;R=REMINDER COUNTS F=FINDING COUNTS 129 ..S USI(2)=$S(L=1:"R",L=2:"F",1:"") 130 ..S $P(USI,"~",2)=USI(2) 131 ..;-------------------------------------------------- 132 ..;11 REMINDER OBR.4.5 133 ..S USI(5)=$G(^TMP("PXRM7",$J,810.33,IENX,.02,"E")) 134 ..S $P(USI,"~",5)=USI(5) 135 ..;-------------------------------------------------- 136 ..;12 STATION OBR.3.1 137 ..S STATION=$G(^TMP("PXRM7",$J,810.33,IENX,.03,"I"))_"," 138 ..D GETS^DIQ(4,STATION,"**","E","^TMP(""PXRM7"",$J)") 139 ..S $P(OBR(+SEQ_L),"|",4)=$G(^TMP("PXRM7",$J,4,STATION,99,"E")) 140 ..;-------------------------------------------------- 141 ..;13 PATIENT LIST OBR.31.2 142 ..S RFS(2)=$G(^TMP("PXRM7",$J,810.33,IENX,.04,"E")) 143 ..S $P(RFS,"~",2)=RFS(2) 144 ..;-------------------------------------------------- 145 ..;19 REMINDER TERM OBR.31.1 146 ..S RFS(1)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.02,"E")),1:"") 147 ..S $P(RFS,"~",1)=RFS(1) 148 ..;-------------------------------------------------- 149 ..;20 FINDING TOTAL TYPE OBR.31.4 150 ..S RFS(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.03,"E")),1:"") 151 ..S $P(RFS,"~",4)=RFS(4) 152 ..;-------------------------------------------------- 153 ..;21 GROUP NAME OBR.31.5 154 ..S RFS(5)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.04,"E")),1:"") 155 ..S $P(RFS,"~",5)=RFS(5) 156 ..;-------------------------------------------------- 157 ..;22 REMINDER STATUS OBR.4.4 158 ..S USI(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.05,"I")),1:"") 159 ..S $P(USI,"~",4)=USI(4) 160 ..;------------------------------------------------- 161 ..;FINISH POPULATING OBR SEGMENT 162 ..S $P(OBR(+SEQ_L),"|",5)=USI 163 ..S $P(OBR(+SEQ_L),"|",32)=RFS 164 ..;------------------------------------------------- 165 ..;---Set message in HL7 array 166 ..;I $L($G(OBR(+SEQ_L)))=255 S OBR(+SEQ_L)=OBR(+SEQ_L)_"|||" 167 ..S ^TMP("HLS",$J,LINE)=$G(OBR(+SEQ_L)),LINE=LINE+1 168 ..; 169 ..I SEE=1 W !," ",OBR(+SEQ_L) 170 ..K OBR 171 ..D OBXSEG 172 ..D SPLIT 173 ..I (L=1)&(IENIEN="") Q 174 Q 175 OBXSEG ;CREATE THE OBX SEGMENTS 176 N TERM 177 ;OV=OBSERVATION VALUE 178 S $P(OBX(+SEQ_L),"|",3)="MO" 179 S $P(OBX(+SEQ_L),"|",1)="OBX" 180 ;--------------------------------------------------- 181 ;###---SET SEQUENCE NUMBER 182 S $P(OBX(+SEQ_L),"|",2)=1 183 ;--------------------------------------------------- 184 ;14 TOTAL PATIENTS EVALUATED - REMINDER OBX.5.1 185 I L=1 D 186 .S TERM="TOTAL PATIENTS EVALUATED" 187 .S OV(1)=$G(^TMP("PXRM7",$J,810.33,IENX,2,"E"))_"~"_TERM 188 .S $P(OV,"^",1)=OV(1) 189 ;--------------------------------------------------- 190 ;15 TOTAL PATIENTS APPLICABLE - REMINDER OBX.5.2 191 I L=1 D 192 .S TERM="TOTAL PATIENTS APPLICABLE" 193 .S OV(2)=$G(^TMP("PXRM7",$J,810.33,IENX,3,"E"))_"~"_TERM 194 .S $P(OV,"^",2)=OV(2) 195 ;--------------------------------------------------- 196 ;16 TOTAL PATIENTS NOT APPLICABLE - REMINDER OBX.5.3 197 I L=1 D 198 .S TERM="TOTAL PATIENTS NOT APPLICABLE" 199 .S OV(3)=$G(^TMP("PXRM7",$J,810.33,IENX,4,"E"))_"~"_TERM 200 .S $P(OV,"^",3)=OV(3) 201 ;--------------------------------------------------- 202 ;17 TOTAL PATIENTS DUE - REMINDER OBX.5.4 203 I L=1 D 204 .S TERM="TOTAL PATIENTS DUE" 205 .S OV(4)=$G(^TMP("PXRM7",$J,810.33,IENX,5,"E"))_"~"_TERM 206 .S $P(OV,"^",4)=OV(4) 207 ;--------------------------------------------------- 208 ;18 TOTAL PATIENTS NOT DUE - REMINDER OBX.5.5 209 I L=1 D 210 .S TERM="TOTAL PATIENTS NOT DUE" 211 .S OV(5)=$G(^TMP("PXRM7",$J,810.33,IENX,6,"E"))_"~"_TERM 212 .S $P(OV,"^",5)=OV(5) 213 ;--------------------------------------------------- 214 ;23 TOTAL COUNT - FINDING OBX.5.1 215 I L=2 D 216 .S TERM="TOTAL COUNT" 217 .S OV(1)=$G(^TMP("PXRM7",$J,810.331,IENZ,1,"E"))_"~"_TERM 218 .S $P(OV,"^",1)=OV(1) 219 ;--------------------------------------------------- 220 ;24 APPLICABLE COUNT - FINDING OBX.5.2 221 I L=2 D 222 .S TERM="APPLICABLE COUNT" 223 .S OV(2)=$G(^TMP("PXRM7",$J,810.331,IENZ,2,"E"))_"~"_TERM 224 .S $P(OV,"^",2)=OV(2) 225 ;--------------------------------------------------- 226 ;25 NOT APPLICABLE COUNT- FINDING OBX.5.3 227 I L=2 D 228 .S TERM="NOT APPLICABLE COUNT" 229 .S OV(3)=$G(^TMP("PXRM7",$J,810.331,IENZ,3,"E"))_"~"_TERM 230 .S $P(OV,"^",3)=OV(3) 231 ;--------------------------------------------------- 232 ;26 DUE COUNT - FINDING OBX.5.4 233 I L=2 D 234 .S TERM="DUE COUNT" 235 .S OV(4)=$G(^TMP("PXRM7",$J,810.331,IENZ,4,"E"))_"~"_TERM 236 .S $P(OV,"^",4)=OV(4) 237 ;--------------------------------------------------- 238 ;27 NOT DUE COUNT - FINDING OBX.5.5 239 I L=2 D 240 .S TERM="NOT DUE COUNT" 241 .S OV(5)=$G(^TMP("PXRM7",$J,810.331,IENZ,5,"E"))_"~"_TERM 242 .S $P(OV,"^",5)=OV(5) 243 ;--------------------------------------------------- 244 ;FINISH POPULATING OBX SEGMENT 245 S $P(OBX(+SEQ_L),"|",6)=OV 246 K OV 247 ;--------------------------------------------------- 248 ;###---Set message in HL7 array 249 S ^TMP("HLS",$J,LINE)=$G(OBX(+SEQ_L)),LINE=LINE+1 250 ; 251 I SEE=1 W !," ",OBX(+SEQ_L) 252 K OBX 253 ;--------------------------------------------------- 254 Q 1 PXRM7XT ;SLC/JVS HL7 EXTRACT FROM FILE; 03/21/2002 ;4/11/02 15:26 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ;This is the beginning of the extraction from the extract file 4 ; 5 ;VARIABLE LIST 6 ;IEN = IEN OF ENTRY IN EXTRACT FILE 810.3 7 Q 8 SPLIT ;SPLIT MESSAGES 9 N ORC2 10 I LINE>100 D 11 .S ORCCNT=ORCCNT+1 12 .D EN^PXRM7M1(.ID) 13 .K ^TMP("HLS",$J) 14 .S ORC2=$G(^TMP("PXRM7HLORC",$J)) 15 .S $P(ORC2,"|",3)="P"_ORCCNT,ORC=ORC2 16 .S LINE=2 17 .I $D(SEE) W !,ORC 18 .S ^TMP("HLS",$J,1)=ORC 19 Q 20 ; 21 EXTRACT(IEN,SEE,ID,MODE) ; 22 N ORCCNT 23 K ERROR,LINE 24 S ORCCNT=1 ;Count of ORC segments or number of messages created 25 S LINE=1 ;Line count for the ^TMP("HL7",$J,LINE) global variable 26 ;-Verify Values 27 I '$D(^PXRMXT(810.3,IEN)) S ERROR(1)="No Such IEN in file 810.3 "_IEN 28 I $D(ERROR) D Q 29 .I $D(SEE)=1 30 ;-Extracting Value of Nodes in file 31 I $D(ERROR) Q 32 D GETS^DIQ(810.3,IEN,"**","EI","^TMP(""PXRM7"",$J)") 33 D ORCSEG 34 ;******Add NTE segment to end of message ******* 35 ;******change 3rd piece of ORC segement to L (last)**** 36 S NTE="NTE||"_LAST_"||" 37 S ^TMP("HLS",$J,LINE)=NTE,LINE=LINE+1 38 I SEE=1 W !,NTE 39 K NTE,LAST 40 S ORC=$G(^TMP("HLS",$J,1)),$P(ORC,"|",3)="F"_ORCCNT,^TMP("HLS",$J,1)=ORC 41 ;*********************************************** 42 ;*******TURN ON BELOW TO TRANSMIT TO AUSTIN ***** 43 D EN^PXRM7M1(.ID) 44 ;*********************************************** 45 K ^TMP("PXRM7",$J) 46 K ^TMP("HLS",$J) 47 K ^TMP("PXRM7HLORC",$J) 48 ;********KILL LEFT OVER ARRAYS AND VARIABLES***** 49 K HL("EID"),HLA("HLS"),PROTIEN,PXRM7,PXRM77,PXRM7ID,PXRM7R,ZMID 50 K DA,DISYS,DISYS,EO,HL("EIDS"),HLECH,HLFS,HLN,HLQ,HLSAN,HLX 51 K IENIEN,IENOBR,IENX,IENY,IENZ,L,LINE,NEXT,QTI,RFS,SEQ 52 K STATION,USI 53 ;************************************************** 54 Q 55 ORCSEG ;CREATE ORC SEGMENTS 56 ;ORDERED IN ORDER OF APPEARANCE IN SEGMENT 57 ;QTI=QUANTITY AND TIMING 58 ;EO=ENTERING ORGANIZATION 59 ;--Below adds extra line feed in front of the message. -- 60 ;--------------------------------------------------- 61 S IENY=IEN_"," 62 ;--------------------------------------------- 63 ;0 PLACER ORDER NUMBER ORC.2.1 64 S $P(ORC,"|",3)="P1" 65 ;--------------------------------------------- 66 ;1 REPORTING PERIOD ORC.7.1.1 67 S QTI(1)=$G(^TMP("PXRM7",$J,810.3,IENY,3,"E")) 68 S $P(QTI,"~",1)=QTI(1) 69 ;--------------------------------------------- 70 ;2 QUARTER ORC.7.3 71 S QTI(3)=$G(^TMP("PXRM7",$J,810.3,IENY,7,"E")) 72 S $P(QTI,"~",3)=QTI(3) 73 ;--------------------------------------------- 74 ;3 BEGINNING DATE ORC.7.4.1 75 S QTI(4)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.02,"I")),"DT") 76 S $P(QTI,"~",4)=QTI(4) 77 ;--------------------------------------------- 78 ;4 ENDING DATE ORC.7.5.1 79 S QTI(5)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.03,"I")),"DT") 80 S $P(QTI,"~",5)=QTI(5) 81 ;--------------------------------------------- 82 ;5 REPORTING YEAR ORC.7.11.2 83 S QTI(11)="&"_$G(^TMP("PXRM7",$J,810.3,IENY,4,"E")) 84 S $P(QTI,"~",11)=QTI(11) 85 ;--------------------------------------------- 86 ;6 EXTRACT DATE ORC.9.1 87 S $P(ORC,"|",10)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.06,"I")),"DT") 88 ;--------------------------------------------- 89 ;7 NAME ORC.17.2 90 S EO(2)=$G(^TMP("PXRM7",$J,810.3,IENY,.01,"E")) 91 S $P(EO,"~",2)=EO(2) 92 ;--------------------------------------------- 93 ;8 REPORT EXTRACT PARAMETER ORC.17.5 94 S EO(5)=$G(^TMP("PXRM7",$J,810.3,IENY,1,"E")) 95 S $P(EO,"~",5)=EO(5) 96 ;--------------------------------------------- 97 ;9 REPORT EXTRACT TYPE ORC.18.2 98 S $P(ORC,"|",19)="~"_$G(^TMP("PXRM7",$J,810.3,IENY,2,"E")) 99 ;--------------------------------------------- 100 ;FINISH POPULATING ORC SEGMENT 101 S $P(ORC,"|",8)=QTI 102 S $P(ORC,"|",18)=EO 103 S $P(ORC,"|",1)="ORC" 104 ;--------------------------------------------- 105 ;SET HL7 TMP ARRAY AND SHOW SEGMENT 106 S ^TMP("HLS",$J,LINE)=ORC,LINE=LINE+1 107 I SEE=1 W !,ORC 108 S ^TMP("PXRM7HLORC",$J)=ORC 109 K ORC 110 OBRSEG ;CREATE OBR SEGMENTS 111 ;N IENOBR,SEQ,USI,QTI,NEXT,STATION 112 ;USI=UNIVERSAL SERVICE ID 113 ;RFS=REASON FOR STUDY 114 ; 115 S NEXT=1,LAST=0 116 S IENOBR=0 F S IENOBR=$O(^PXRMXT(810.3,IEN,3,IENOBR)) Q:IENOBR<1 D 117 .S IENIEN=-1 F S IENIEN=$O(^PXRMXT(810.3,IEN,3,IENOBR,1,IENIEN)) Q:IENIEN="B" D Q:IENIEN="" 118 ..S L=$S(IENIEN=0:1,IENIEN>0:2,IENIEN="":1,1:"") 119 ..;###---Set Sequence Number 120 ..S IENX=IENOBR_","_IEN_"," 121 ..S IENZ=IENIEN_","_IENOBR_","_IEN_"," 122 ..S SEQ=$G(^TMP("PXRM7",$J,810.33,IENX,.01,"E")) 123 ..S OBR(+SEQ_L)="OBR|1|||||||||||||||||||||||||||||||" 124 ..S $P(OBR(+SEQ_L),"|",2)=NEXT,LAST=NEXT,NEXT=NEXT+1 125 ..;-------------------------------------------------- 126 ..;10 COUNT TYPE OBR.4.2 127 ..;R=REMINDER COUNTS F=FINDING COUNTS 128 ..S USI(2)=$S(L=1:"R",L=2:"F",1:"") 129 ..S $P(USI,"~",2)=USI(2) 130 ..;-------------------------------------------------- 131 ..;11 REMINDER OBR.4.5 132 ..S USI(5)=$G(^TMP("PXRM7",$J,810.33,IENX,.02,"E")) 133 ..S $P(USI,"~",5)=USI(5) 134 ..;-------------------------------------------------- 135 ..;12 STATION OBR.3.1 136 ..S STATION=$G(^TMP("PXRM7",$J,810.33,IENX,.03,"I"))_"," 137 ..D GETS^DIQ(4,STATION,"**","E","^TMP(""PXRM7"",$J)") 138 ..S $P(OBR(+SEQ_L),"|",4)=$G(^TMP("PXRM7",$J,4,STATION,99,"E")) 139 ..;-------------------------------------------------- 140 ..;13 PATIENT LIST OBR.31.2 141 ..S RFS(2)=$G(^TMP("PXRM7",$J,810.33,IENX,.04,"E")) 142 ..S $P(RFS,"~",2)=RFS(2) 143 ..;-------------------------------------------------- 144 ..;19 REMINDER TERM OBR.31.1 145 ..S RFS(1)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.02,"E")),1:"") 146 ..S $P(RFS,"~",1)=RFS(1) 147 ..;-------------------------------------------------- 148 ..;20 FINDING TOTAL TYPE OBR.31.4 149 ..S RFS(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.03,"E")),1:"") 150 ..S $P(RFS,"~",4)=RFS(4) 151 ..;-------------------------------------------------- 152 ..;21 GROUP NAME OBR.31.5 153 ..S RFS(5)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.04,"E")),1:"") 154 ..S $P(RFS,"~",5)=RFS(5) 155 ..;-------------------------------------------------- 156 ..;22 REMINDER STATUS OBR.4.4 157 ..S USI(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.05,"I")),1:"") 158 ..S $P(USI,"~",4)=USI(4) 159 ..;------------------------------------------------- 160 ..;FINISH POPULATING OBR SEGMENT 161 ..S $P(OBR(+SEQ_L),"|",5)=USI 162 ..S $P(OBR(+SEQ_L),"|",32)=RFS 163 ..;------------------------------------------------- 164 ..;---Set message in HL7 array 165 ..;I $L($G(OBR(+SEQ_L)))=255 S OBR(+SEQ_L)=OBR(+SEQ_L)_"|||" 166 ..S ^TMP("HLS",$J,LINE)=$G(OBR(+SEQ_L)),LINE=LINE+1 167 ..; 168 ..I SEE=1 W !," ",OBR(+SEQ_L) 169 ..K OBR 170 ..D OBXSEG 171 ..D SPLIT 172 ..I (L=1)&(IENIEN="") Q 173 Q 174 OBXSEG ;CREATE THE OBX SEGMENTS 175 N TERM 176 ;OV=OBSERVATION VALUE 177 S $P(OBX(+SEQ_L),"|",3)="MO" 178 S $P(OBX(+SEQ_L),"|",1)="OBX" 179 ;--------------------------------------------------- 180 ;###---SET SEQUENCE NUMBER 181 S $P(OBX(+SEQ_L),"|",2)=1 182 ;--------------------------------------------------- 183 ;14 TOTAL PATIENTS EVALUATED - REMINDER OBX.5.1 184 I L=1 D 185 .S TERM="TOTAL PATIENTS EVALUATED" 186 .S OV(1)=$G(^TMP("PXRM7",$J,810.33,IENX,2,"E"))_"~"_TERM 187 .S $P(OV,"^",1)=OV(1) 188 ;--------------------------------------------------- 189 ;15 TOTAL PATIENTS APPLICABLE - REMINDER OBX.5.2 190 I L=1 D 191 .S TERM="TOTAL PATIENTS APPLICABLE" 192 .S OV(2)=$G(^TMP("PXRM7",$J,810.33,IENX,3,"E"))_"~"_TERM 193 .S $P(OV,"^",2)=OV(2) 194 ;--------------------------------------------------- 195 ;16 TOTAL PATIENTS NOT APPLICABLE - REMINDER OBX.5.3 196 I L=1 D 197 .S TERM="TOTAL PATIENTS NOT APPLICABLE" 198 .S OV(3)=$G(^TMP("PXRM7",$J,810.33,IENX,4,"E"))_"~"_TERM 199 .S $P(OV,"^",3)=OV(3) 200 ;--------------------------------------------------- 201 ;17 TOTAL PATIENTS DUE - REMINDER OBX.5.4 202 I L=1 D 203 .S TERM="TOTAL PATIENTS DUE" 204 .S OV(4)=$G(^TMP("PXRM7",$J,810.33,IENX,5,"E"))_"~"_TERM 205 .S $P(OV,"^",4)=OV(4) 206 ;--------------------------------------------------- 207 ;18 TOTAL PATIENTS NOT DUE - REMINDER OBX.5.5 208 I L=1 D 209 .S TERM="TOTAL PATIENTS NOT DUE" 210 .S OV(5)=$G(^TMP("PXRM7",$J,810.33,IENX,6,"E"))_"~"_TERM 211 .S $P(OV,"^",5)=OV(5) 212 ;--------------------------------------------------- 213 ;23 TOTAL COUNT - FINDING OBX.5.1 214 I L=2 D 215 .S TERM="TOTAL COUNT" 216 .S OV(1)=$G(^TMP("PXRM7",$J,810.331,IENZ,1,"E"))_"~"_TERM 217 .S $P(OV,"^",1)=OV(1) 218 ;--------------------------------------------------- 219 ;24 APPLICABLE COUNT - FINDING OBX.5.2 220 I L=2 D 221 .S TERM="APPLICABLE COUNT" 222 .S OV(2)=$G(^TMP("PXRM7",$J,810.331,IENZ,2,"E"))_"~"_TERM 223 .S $P(OV,"^",2)=OV(2) 224 ;--------------------------------------------------- 225 ;25 NOT APPLICABLE COUNT- FINDING OBX.5.3 226 I L=2 D 227 .S TERM="NOT APPLICABLE COUNT" 228 .S OV(3)=$G(^TMP("PXRM7",$J,810.331,IENZ,3,"E"))_"~"_TERM 229 .S $P(OV,"^",3)=OV(3) 230 ;--------------------------------------------------- 231 ;26 DUE COUNT - FINDING OBX.5.4 232 I L=2 D 233 .S TERM="DUE COUNT" 234 .S OV(4)=$G(^TMP("PXRM7",$J,810.331,IENZ,4,"E"))_"~"_TERM 235 .S $P(OV,"^",4)=OV(4) 236 ;--------------------------------------------------- 237 ;27 NOT DUE COUNT - FINDING OBX.5.5 238 I L=2 D 239 .S TERM="NOT DUE COUNT" 240 .S OV(5)=$G(^TMP("PXRM7",$J,810.331,IENZ,5,"E"))_"~"_TERM 241 .S $P(OV,"^",5)=OV(5) 242 ;--------------------------------------------------- 243 ;FINISH POPULATING OBX SEGMENT 244 S $P(OBX(+SEQ_L),"|",6)=OV 245 K OV 246 ;--------------------------------------------------- 247 ;###---Set message in HL7 array 248 S ^TMP("HLS",$J,LINE)=$G(OBX(+SEQ_L)),LINE=LINE+1 249 ; 250 I SEE=1 W !," ",OBX(+SEQ_L) 251 K OBX 252 ;--------------------------------------------------- 253 Q
Note:
See TracChangeset
for help on using the changeset viewer.
