PXRM7XT ;SLC/JVS HL7 EXTRACT FROM FILE; 06/01/2007
;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
;This is the beginning of the extraction from the extract file
;
;VARIABLE LIST
;IEN = IEN OF ENTRY IN EXTRACT FILE 810.3
Q
SPLIT ;SPLIT MESSAGES
;
N ORC2
I LINE>100 D
.S ORCCNT=ORCCNT+1
.D EN^PXRM7M1(.ID)
.K ^TMP("HLS",$J)
.S ORC2=$G(^TMP("PXRM7HLORC",$J))
.S $P(ORC2,"|",3)="P"_ORCCNT,ORC=ORC2
.S LINE=2
.I $D(SEE) W !,ORC
.S ^TMP("HLS",$J,1)=ORC
Q
;
N ORCCNT
K ERROR,LINE
S ORCCNT=1 ;Count of ORC segments or number of messages created
S LINE=1 ;Line count for the ^TMP("HL7",$J,LINE) global variable
;-Verify Values
I '$D(^PXRMXT(810.3,IEN)) S ERROR(1)="No Such IEN in file 810.3 "_IEN
I $D(ERROR) D Q
.I $D(SEE)=1
;-Extracting Value of Nodes in file
I $D(ERROR) Q
D GETS^DIQ(810.3,IEN,"**","EI","^TMP(""PXRM7"",$J)")
D ORCSEG
;******Add NTE segment to end of message *******
;******change 3rd piece of ORC segement to L (last)****
S NTE="NTE||"_LAST_"||"
S ^TMP("HLS",$J,LINE)=NTE,LINE=LINE+1
I SEE=1 W !,NTE
K NTE,LAST
S ORC=$G(^TMP("HLS",$J,1)),$P(ORC,"|",3)="F"_ORCCNT,^TMP("HLS",$J,1)=ORC
;***********************************************
;*******TURN ON BELOW TO TRANSMIT TO AUSTIN *****
D EN^PXRM7M1(.ID)
;***********************************************
K ^TMP("PXRM7",$J)
K ^TMP("HLS",$J)
K ^TMP("PXRM7HLORC",$J)
;********KILL LEFT OVER ARRAYS AND VARIABLES*****
K HL("EID"),HLA("HLS"),PROTIEN,PXRM7,PXRM77,PXRM7ID,PXRM7R,ZMID
K DA,DISYS,DISYS,EO,HL("EIDS"),HLECH,HLFS,HLN,HLQ,HLSAN,HLX
K IENIEN,IENOBR,IENX,IENY,IENZ,L,LINE,NEXT,QTI,RFS,SEQ
K STATION,USI
;**************************************************
Q
ORCSEG ;CREATE ORC SEGMENTS
;ORDERED IN ORDER OF APPEARANCE IN SEGMENT
;QTI=QUANTITY AND TIMING
;EO=ENTERING ORGANIZATION
;--Below adds extra line feed in front of the message. --
;---------------------------------------------------
S IENY=IEN_","
;---------------------------------------------
;0 PLACER ORDER NUMBER ORC.2.1
S $P(ORC,"|",3)="P1"
;---------------------------------------------
;1 REPORTING PERIOD ORC.7.1.1
S QTI(1)=$G(^TMP("PXRM7",$J,810.3,IENY,3,"E"))
S $P(QTI,"~",1)=QTI(1)
;---------------------------------------------
;2 QUARTER ORC.7.3
S QTI(3)=$G(^TMP("PXRM7",$J,810.3,IENY,7,"E"))
S $P(QTI,"~",3)=QTI(3)
;---------------------------------------------
;3 BEGINNING DATE ORC.7.4.1
S QTI(4)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.02,"I")),"DT")
S $P(QTI,"~",4)=QTI(4)
;---------------------------------------------
;4 ENDING DATE ORC.7.5.1
S QTI(5)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.03,"I")),"DT")
S $P(QTI,"~",5)=QTI(5)
;---------------------------------------------
;5 REPORTING YEAR ORC.7.11.2
S QTI(11)="&"_$G(^TMP("PXRM7",$J,810.3,IENY,4,"E"))
S $P(QTI,"~",11)=QTI(11)
;---------------------------------------------
;6 EXTRACT DATE ORC.9.1
S $P(ORC,"|",10)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.06,"I")),"DT")
;---------------------------------------------
;7 NAME ORC.17.2
S EO(2)=$G(^TMP("PXRM7",$J,810.3,IENY,.01,"E"))
S $P(EO,"~",2)=EO(2)
;---------------------------------------------
;8 REPORT EXTRACT PARAMETER ORC.17.5
S EO(5)=$G(^TMP("PXRM7",$J,810.3,IENY,1,"E"))
S $P(EO,"~",5)=EO(5)
;---------------------------------------------
;9 REPORT EXTRACT TYPE ORC.18.2
S $P(ORC,"|",19)="~"_$G(^TMP("PXRM7",$J,810.3,IENY,2,"E"))
;---------------------------------------------
;FINISH POPULATING ORC SEGMENT
S $P(ORC,"|",8)=QTI
S $P(ORC,"|",18)=EO
S $P(ORC,"|",1)="ORC"
;---------------------------------------------
;SET HL7 TMP ARRAY AND SHOW SEGMENT
S ^TMP("HLS",$J,LINE)=ORC,LINE=LINE+1
I SEE=1 W !,ORC
S ^TMP("PXRM7HLORC",$J)=ORC
K ORC
OBRSEG ;CREATE OBR SEGMENTS
;N IENOBR,SEQ,USI,QTI,NEXT,STATION
;USI=UNIVERSAL SERVICE ID
;RFS=REASON FOR STUDY
;
S NEXT=1,LAST=0
S IENOBR=0 F S IENOBR=$O(^PXRMXT(810.3,IEN,3,IENOBR)) Q:IENOBR<1 D
.S IENIEN=-1 F S IENIEN=$O(^PXRMXT(810.3,IEN,3,IENOBR,1,IENIEN)) Q:IENIEN="B" D Q:IENIEN=""
..S L=$S(IENIEN=0:1,IENIEN>0:2,IENIEN="":1,1:"")
..;###---Set Sequence Number
..S IENX=IENOBR_","_IEN_","
..S IENZ=IENIEN_","_IENOBR_","_IEN_","
..S SEQ=$G(^TMP("PXRM7",$J,810.33,IENX,.01,"E"))
..S OBR(+SEQ_L)="OBR|1|||||||||||||||||||||||||||||||"
..S $P(OBR(+SEQ_L),"|",2)=NEXT,LAST=NEXT,NEXT=NEXT+1
..;--------------------------------------------------
..;10 COUNT TYPE OBR.4.2
..;R=REMINDER COUNTS F=FINDING COUNTS
..S USI(2)=$S(L=1:"R",L=2:"F",1:"")
..S $P(USI,"~",2)=USI(2)
..;--------------------------------------------------
..;11 REMINDER OBR.4.5
..S USI(5)=$G(^TMP("PXRM7",$J,810.33,IENX,.02,"E"))
..S $P(USI,"~",5)=USI(5)
..;--------------------------------------------------
..;12 STATION OBR.3.1
..S STATION=$G(^TMP("PXRM7",$J,810.33,IENX,.03,"I"))_","
..D GETS^DIQ(4,STATION,"**","E","^TMP(""PXRM7"",$J)")
..S $P(OBR(+SEQ_L),"|",4)=$G(^TMP("PXRM7",$J,4,STATION,99,"E"))
..;--------------------------------------------------
..;13 PATIENT LIST OBR.31.2
..S RFS(2)=$G(^TMP("PXRM7",$J,810.33,IENX,.04,"E"))
..S $P(RFS,"~",2)=RFS(2)
..;--------------------------------------------------
..;19 REMINDER TERM OBR.31.1
..S RFS(1)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.02,"E")),1:"")
..S $P(RFS,"~",1)=RFS(1)
..;--------------------------------------------------
..;20 FINDING TOTAL TYPE OBR.31.4
..S RFS(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.03,"E")),1:"")
..S $P(RFS,"~",4)=RFS(4)
..;--------------------------------------------------
..;21 GROUP NAME OBR.31.5
..S RFS(5)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.04,"E")),1:"")
..S $P(RFS,"~",5)=RFS(5)
..;--------------------------------------------------
..;22 REMINDER STATUS OBR.4.4
..S USI(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.05,"I")),1:"")
..S $P(USI,"~",4)=USI(4)
..;-------------------------------------------------
..;FINISH POPULATING OBR SEGMENT
..S $P(OBR(+SEQ_L),"|",5)=USI
..S $P(OBR(+SEQ_L),"|",32)=RFS
..;-------------------------------------------------
..;---Set message in HL7 array
..;I $L($G(OBR(+SEQ_L)))=255 S OBR(+SEQ_L)=OBR(+SEQ_L)_"|||"
..S ^TMP("HLS",$J,LINE)=$G(OBR(+SEQ_L)),LINE=LINE+1
..;
..I SEE=1 W !," ",OBR(+SEQ_L)
..K OBR
..D OBXSEG
..D SPLIT
..I (L=1)&(IENIEN="") Q
Q
OBXSEG ;CREATE THE OBX SEGMENTS
N TERM
;OV=OBSERVATION VALUE
S $P(OBX(+SEQ_L),"|",3)="MO"
S $P(OBX(+SEQ_L),"|",1)="OBX"
;---------------------------------------------------
;###---SET SEQUENCE NUMBER
S $P(OBX(+SEQ_L),"|",2)=1
;---------------------------------------------------
;14 TOTAL PATIENTS EVALUATED - REMINDER OBX.5.1
I L=1 D
.S TERM="TOTAL PATIENTS EVALUATED"
.S OV(1)=$G(^TMP("PXRM7",$J,810.33,IENX,2,"E"))_"~"_TERM
.S $P(OV,"^",1)=OV(1)
;---------------------------------------------------
;15 TOTAL PATIENTS APPLICABLE - REMINDER OBX.5.2
I L=1 D
.S TERM="TOTAL PATIENTS APPLICABLE"
.S OV(2)=$G(^TMP("PXRM7",$J,810.33,IENX,3,"E"))_"~"_TERM
.S $P(OV,"^",2)=OV(2)
;---------------------------------------------------
;16 TOTAL PATIENTS NOT APPLICABLE - REMINDER OBX.5.3
I L=1 D
.S TERM="TOTAL PATIENTS NOT APPLICABLE"
.S OV(3)=$G(^TMP("PXRM7",$J,810.33,IENX,4,"E"))_"~"_TERM
.S $P(OV,"^",3)=OV(3)
;---------------------------------------------------
;17 TOTAL PATIENTS DUE - REMINDER OBX.5.4
I L=1 D
.S TERM="TOTAL PATIENTS DUE"
.S OV(4)=$G(^TMP("PXRM7",$J,810.33,IENX,5,"E"))_"~"_TERM
.S $P(OV,"^",4)=OV(4)
;---------------------------------------------------
;18 TOTAL PATIENTS NOT DUE - REMINDER OBX.5.5
I L=1 D
.S TERM="TOTAL PATIENTS NOT DUE"
.S OV(5)=$G(^TMP("PXRM7",$J,810.33,IENX,6,"E"))_"~"_TERM
.S $P(OV,"^",5)=OV(5)
;---------------------------------------------------
;23 TOTAL COUNT - FINDING OBX.5.1
I L=2 D
.S TERM="TOTAL COUNT"
.S OV(1)=$G(^TMP("PXRM7",$J,810.331,IENZ,1,"E"))_"~"_TERM
.S $P(OV,"^",1)=OV(1)
;---------------------------------------------------
;24 APPLICABLE COUNT - FINDING OBX.5.2
I L=2 D
.S TERM="APPLICABLE COUNT"
.S OV(2)=$G(^TMP("PXRM7",$J,810.331,IENZ,2,"E"))_"~"_TERM
.S $P(OV,"^",2)=OV(2)
;---------------------------------------------------
;25 NOT APPLICABLE COUNT- FINDING OBX.5.3
I L=2 D
.S TERM="NOT APPLICABLE COUNT"
.S OV(3)=$G(^TMP("PXRM7",$J,810.331,IENZ,3,"E"))_"~"_TERM
.S $P(OV,"^",3)=OV(3)
;---------------------------------------------------
;26 DUE COUNT - FINDING OBX.5.4
I L=2 D
.S TERM="DUE COUNT"
.S OV(4)=$G(^TMP("PXRM7",$J,810.331,IENZ,4,"E"))_"~"_TERM
.S $P(OV,"^",4)=OV(4)
;---------------------------------------------------
;27 NOT DUE COUNT - FINDING OBX.5.5
I L=2 D
.S TERM="NOT DUE COUNT"
.S OV(5)=$G(^TMP("PXRM7",$J,810.331,IENZ,5,"E"))_"~"_TERM
.S $P(OV,"^",5)=OV(5)
;---------------------------------------------------
;FINISH POPULATING OBX SEGMENT
S $P(OBX(+SEQ_L),"|",6)=OV
K OV
;---------------------------------------------------
;###---Set message in HL7 array
S ^TMP("HLS",$J,LINE)=$G(OBX(+SEQ_L)),LINE=LINE+1
;
I SEE=1 W !," ",OBX(+SEQ_L)
K OBX
;---------------------------------------------------
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRM7XT 9595 printed Oct 16, 2024@17:43:45 Page 2
PXRM7XT ;SLC/JVS HL7 EXTRACT FROM FILE; 06/01/2007
+1 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+2 ;This is the beginning of the extraction from the extract file
+3 ;
+4 ;VARIABLE LIST
+5 ;IEN = IEN OF ENTRY IN EXTRACT FILE 810.3
+6 QUIT
SPLIT ;SPLIT MESSAGES
+1 ;
+2 NEW ORC2
+3 IF LINE>100
Begin DoDot:1
+4 SET ORCCNT=ORCCNT+1
+5 DO EN^PXRM7M1(.ID)
+6 KILL ^TMP("HLS",$JOB)
+7 SET ORC2=$GET(^TMP("PXRM7HLORC",$JOB))
+8 SET $PIECE(ORC2,"|",3)="P"_ORCCNT
SET ORC=ORC2
+9 SET LINE=2
+10 IF $DATA(SEE)
WRITE !,ORC
+11 SET ^TMP("HLS",$JOB,1)=ORC
End DoDot:1
+12 QUIT
+13 ;
+1 NEW ORCCNT
+2 KILL ERROR,LINE
+3 ;Count of ORC segments or number of messages created
SET ORCCNT=1
+4 ;Line count for the ^TMP("HL7",$J,LINE) global variable
SET LINE=1
+5 ;-Verify Values
+6 IF '$DATA(^PXRMXT(810.3,IEN))
SET ERROR(1)="No Such IEN in file 810.3 "_IEN
+7 IF $DATA(ERROR)
Begin DoDot:1
+8 IF $DATA(SEE)=1
End DoDot:1
QUIT
+9 ;-Extracting Value of Nodes in file
+10 IF $DATA(ERROR)
QUIT
+11 DO GETS^DIQ(810.3,IEN,"**","EI","^TMP(""PXRM7"",$J)")
+12 DO ORCSEG
+13 ;******Add NTE segment to end of message *******
+14 ;******change 3rd piece of ORC segement to L (last)****
+15 SET NTE="NTE||"_LAST_"||"
+16 SET ^TMP("HLS",$JOB,LINE)=NTE
SET LINE=LINE+1
+17 IF SEE=1
WRITE !,NTE
+18 KILL NTE,LAST
+19 SET ORC=$GET(^TMP("HLS",$JOB,1))
SET $PIECE(ORC,"|",3)="F"_ORCCNT
SET ^TMP("HLS",$JOB,1)=ORC
+20 ;***********************************************
+21 ;*******TURN ON BELOW TO TRANSMIT TO AUSTIN *****
+22 DO EN^PXRM7M1(.ID)
+23 ;***********************************************
+24 KILL ^TMP("PXRM7",$JOB)
+25 KILL ^TMP("HLS",$JOB)
+26 KILL ^TMP("PXRM7HLORC",$JOB)
+27 ;********KILL LEFT OVER ARRAYS AND VARIABLES*****
+28 KILL HL("EID"),HLA("HLS"),PROTIEN,PXRM7,PXRM77,PXRM7ID,PXRM7R,ZMID
+29 KILL DA,DISYS,DISYS,EO,HL("EIDS"),HLECH,HLFS,HLN,HLQ,HLSAN,HLX
+30 KILL IENIEN,IENOBR,IENX,IENY,IENZ,L,LINE,NEXT,QTI,RFS,SEQ
+31 KILL STATION,USI
+32 ;**************************************************
+33 QUIT
ORCSEG ;CREATE ORC SEGMENTS
+1 ;ORDERED IN ORDER OF APPEARANCE IN SEGMENT
+2 ;QTI=QUANTITY AND TIMING
+3 ;EO=ENTERING ORGANIZATION
+4 ;--Below adds extra line feed in front of the message. --
+5 ;---------------------------------------------------
+6 SET IENY=IEN_","
+7 ;---------------------------------------------
+8 ;0 PLACER ORDER NUMBER ORC.2.1
+9 SET $PIECE(ORC,"|",3)="P1"
+10 ;---------------------------------------------
+11 ;1 REPORTING PERIOD ORC.7.1.1
+12 SET QTI(1)=$GET(^TMP("PXRM7",$JOB,810.3,IENY,3,"E"))
+13 SET $PIECE(QTI,"~",1)=QTI(1)
+14 ;---------------------------------------------
+15 ;2 QUARTER ORC.7.3
+16 SET QTI(3)=$GET(^TMP("PXRM7",$JOB,810.3,IENY,7,"E"))
+17 SET $PIECE(QTI,"~",3)=QTI(3)
+18 ;---------------------------------------------
+19 ;3 BEGINNING DATE ORC.7.4.1
+20 SET QTI(4)=$$HLDATE^HLFNC($GET(^TMP("PXRM7",$JOB,810.3,IENY,.02,"I")),"DT")
+21 SET $PIECE(QTI,"~",4)=QTI(4)
+22 ;---------------------------------------------
+23 ;4 ENDING DATE ORC.7.5.1
+24 SET QTI(5)=$$HLDATE^HLFNC($GET(^TMP("PXRM7",$JOB,810.3,IENY,.03,"I")),"DT")
+25 SET $PIECE(QTI,"~",5)=QTI(5)
+26 ;---------------------------------------------
+27 ;5 REPORTING YEAR ORC.7.11.2
+28 SET QTI(11)="&"_$GET(^TMP("PXRM7",$JOB,810.3,IENY,4,"E"))
+29 SET $PIECE(QTI,"~",11)=QTI(11)
+30 ;---------------------------------------------
+31 ;6 EXTRACT DATE ORC.9.1
+32 SET $PIECE(ORC,"|",10)=$$HLDATE^HLFNC($GET(^TMP("PXRM7",$JOB,810.3,IENY,.06,"I")),"DT")
+33 ;---------------------------------------------
+34 ;7 NAME ORC.17.2
+35 SET EO(2)=$GET(^TMP("PXRM7",$JOB,810.3,IENY,.01,"E"))
+36 SET $PIECE(EO,"~",2)=EO(2)
+37 ;---------------------------------------------
+38 ;8 REPORT EXTRACT PARAMETER ORC.17.5
+39 SET EO(5)=$GET(^TMP("PXRM7",$JOB,810.3,IENY,1,"E"))
+40 SET $PIECE(EO,"~",5)=EO(5)
+41 ;---------------------------------------------
+42 ;9 REPORT EXTRACT TYPE ORC.18.2
+43 SET $PIECE(ORC,"|",19)="~"_$GET(^TMP("PXRM7",$JOB,810.3,IENY,2,"E"))
+44 ;---------------------------------------------
+45 ;FINISH POPULATING ORC SEGMENT
+46 SET $PIECE(ORC,"|",8)=QTI
+47 SET $PIECE(ORC,"|",18)=EO
+48 SET $PIECE(ORC,"|",1)="ORC"
+49 ;---------------------------------------------
+50 ;SET HL7 TMP ARRAY AND SHOW SEGMENT
+51 SET ^TMP("HLS",$JOB,LINE)=ORC
SET LINE=LINE+1
+52 IF SEE=1
WRITE !,ORC
+53 SET ^TMP("PXRM7HLORC",$JOB)=ORC
+54 KILL ORC
OBRSEG ;CREATE OBR SEGMENTS
+1 ;N IENOBR,SEQ,USI,QTI,NEXT,STATION
+2 ;USI=UNIVERSAL SERVICE ID
+3 ;RFS=REASON FOR STUDY
+4 ;
+5 SET NEXT=1
SET LAST=0
+6 SET IENOBR=0
FOR
SET IENOBR=$ORDER(^PXRMXT(810.3,IEN,3,IENOBR))
if IENOBR<1
QUIT
Begin DoDot:1
+7 SET IENIEN=-1
FOR
SET IENIEN=$ORDER(^PXRMXT(810.3,IEN,3,IENOBR,1,IENIEN))
if IENIEN="B"
QUIT
Begin DoDot:2
+8 SET L=$SELECT(IENIEN=0:1,IENIEN>0:2,IENIEN="":1,1:"")
+9 ;###---Set Sequence Number
+10 SET IENX=IENOBR_","_IEN_","
+11 SET IENZ=IENIEN_","_IENOBR_","_IEN_","
+12 SET SEQ=$GET(^TMP("PXRM7",$JOB,810.33,IENX,.01,"E"))
+13 SET OBR(+SEQ_L)="OBR|1|||||||||||||||||||||||||||||||"
+14 SET $PIECE(OBR(+SEQ_L),"|",2)=NEXT
SET LAST=NEXT
SET NEXT=NEXT+1
+15 ;--------------------------------------------------
+16 ;10 COUNT TYPE OBR.4.2
+17 ;R=REMINDER COUNTS F=FINDING COUNTS
+18 SET USI(2)=$SELECT(L=1:"R",L=2:"F",1:"")
+19 SET $PIECE(USI,"~",2)=USI(2)
+20 ;--------------------------------------------------
+21 ;11 REMINDER OBR.4.5
+22 SET USI(5)=$GET(^TMP("PXRM7",$JOB,810.33,IENX,.02,"E"))
+23 SET $PIECE(USI,"~",5)=USI(5)
+24 ;--------------------------------------------------
+25 ;12 STATION OBR.3.1
+26 SET STATION=$GET(^TMP("PXRM7",$JOB,810.33,IENX,.03,"I"))_","
+27 DO GETS^DIQ(4,STATION,"**","E","^TMP(""PXRM7"",$J)")
+28 SET $PIECE(OBR(+SEQ_L),"|",4)=$GET(^TMP("PXRM7",$JOB,4,STATION,99,"E"))
+29 ;--------------------------------------------------
+30 ;13 PATIENT LIST OBR.31.2
+31 SET RFS(2)=$GET(^TMP("PXRM7",$JOB,810.33,IENX,.04,"E"))
+32 SET $PIECE(RFS,"~",2)=RFS(2)
+33 ;--------------------------------------------------
+34 ;19 REMINDER TERM OBR.31.1
+35 SET RFS(1)=$SELECT(L=2:$GET(^TMP("PXRM7",$JOB,810.331,IENZ,.02,"E")),1:"")
+36 SET $PIECE(RFS,"~",1)=RFS(1)
+37 ;--------------------------------------------------
+38 ;20 FINDING TOTAL TYPE OBR.31.4
+39 SET RFS(4)=$SELECT(L=2:$GET(^TMP("PXRM7",$JOB,810.331,IENZ,.03,"E")),1:"")
+40 SET $PIECE(RFS,"~",4)=RFS(4)
+41 ;--------------------------------------------------
+42 ;21 GROUP NAME OBR.31.5
+43 SET RFS(5)=$SELECT(L=2:$GET(^TMP("PXRM7",$JOB,810.331,IENZ,.04,"E")),1:"")
+44 SET $PIECE(RFS,"~",5)=RFS(5)
+45 ;--------------------------------------------------
+46 ;22 REMINDER STATUS OBR.4.4
+47 SET USI(4)=$SELECT(L=2:$GET(^TMP("PXRM7",$JOB,810.331,IENZ,.05,"I")),1:"")
+48 SET $PIECE(USI,"~",4)=USI(4)
+49 ;-------------------------------------------------
+50 ;FINISH POPULATING OBR SEGMENT
+51 SET $PIECE(OBR(+SEQ_L),"|",5)=USI
+52 SET $PIECE(OBR(+SEQ_L),"|",32)=RFS
+53 ;-------------------------------------------------
+54 ;---Set message in HL7 array
+55 ;I $L($G(OBR(+SEQ_L)))=255 S OBR(+SEQ_L)=OBR(+SEQ_L)_"|||"
+56 SET ^TMP("HLS",$JOB,LINE)=$GET(OBR(+SEQ_L))
SET LINE=LINE+1
+57 ;
+58 IF SEE=1
WRITE !," ",OBR(+SEQ_L)
+59 KILL OBR
+60 DO OBXSEG
+61 DO SPLIT
+62 IF (L=1)&(IENIEN="")
QUIT
End DoDot:2
if IENIEN=""
QUIT
End DoDot:1
+63 QUIT
OBXSEG ;CREATE THE OBX SEGMENTS
+1 NEW TERM
+2 ;OV=OBSERVATION VALUE
+3 SET $PIECE(OBX(+SEQ_L),"|",3)="MO"
+4 SET $PIECE(OBX(+SEQ_L),"|",1)="OBX"
+5 ;---------------------------------------------------
+6 ;###---SET SEQUENCE NUMBER
+7 SET $PIECE(OBX(+SEQ_L),"|",2)=1
+8 ;---------------------------------------------------
+9 ;14 TOTAL PATIENTS EVALUATED - REMINDER OBX.5.1
+10 IF L=1
Begin DoDot:1
+11 SET TERM="TOTAL PATIENTS EVALUATED"
+12 SET OV(1)=$GET(^TMP("PXRM7",$JOB,810.33,IENX,2,"E"))_"~"_TERM
+13 SET $PIECE(OV,"^",1)=OV(1)
End DoDot:1
+14 ;---------------------------------------------------
+15 ;15 TOTAL PATIENTS APPLICABLE - REMINDER OBX.5.2
+16 IF L=1
Begin DoDot:1
+17 SET TERM="TOTAL PATIENTS APPLICABLE"
+18 SET OV(2)=$GET(^TMP("PXRM7",$JOB,810.33,IENX,3,"E"))_"~"_TERM
+19 SET $PIECE(OV,"^",2)=OV(2)
End DoDot:1
+20 ;---------------------------------------------------
+21 ;16 TOTAL PATIENTS NOT APPLICABLE - REMINDER OBX.5.3
+22 IF L=1
Begin DoDot:1
+23 SET TERM="TOTAL PATIENTS NOT APPLICABLE"
+24 SET OV(3)=$GET(^TMP("PXRM7",$JOB,810.33,IENX,4,"E"))_"~"_TERM
+25 SET $PIECE(OV,"^",3)=OV(3)
End DoDot:1
+26 ;---------------------------------------------------
+27 ;17 TOTAL PATIENTS DUE - REMINDER OBX.5.4
+28 IF L=1
Begin DoDot:1
+29 SET TERM="TOTAL PATIENTS DUE"
+30 SET OV(4)=$GET(^TMP("PXRM7",$JOB,810.33,IENX,5,"E"))_"~"_TERM
+31 SET $PIECE(OV,"^",4)=OV(4)
End DoDot:1
+32 ;---------------------------------------------------
+33 ;18 TOTAL PATIENTS NOT DUE - REMINDER OBX.5.5
+34 IF L=1
Begin DoDot:1
+35 SET TERM="TOTAL PATIENTS NOT DUE"
+36 SET OV(5)=$GET(^TMP("PXRM7",$JOB,810.33,IENX,6,"E"))_"~"_TERM
+37 SET $PIECE(OV,"^",5)=OV(5)
End DoDot:1
+38 ;---------------------------------------------------
+39 ;23 TOTAL COUNT - FINDING OBX.5.1
+40 IF L=2
Begin DoDot:1
+41 SET TERM="TOTAL COUNT"
+42 SET OV(1)=$GET(^TMP("PXRM7",$JOB,810.331,IENZ,1,"E"))_"~"_TERM
+43 SET $PIECE(OV,"^",1)=OV(1)
End DoDot:1
+44 ;---------------------------------------------------
+45 ;24 APPLICABLE COUNT - FINDING OBX.5.2
+46 IF L=2
Begin DoDot:1
+47 SET TERM="APPLICABLE COUNT"
+48 SET OV(2)=$GET(^TMP("PXRM7",$JOB,810.331,IENZ,2,"E"))_"~"_TERM
+49 SET $PIECE(OV,"^",2)=OV(2)
End DoDot:1
+50 ;---------------------------------------------------
+51 ;25 NOT APPLICABLE COUNT- FINDING OBX.5.3
+52 IF L=2
Begin DoDot:1
+53 SET TERM="NOT APPLICABLE COUNT"
+54 SET OV(3)=$GET(^TMP("PXRM7",$JOB,810.331,IENZ,3,"E"))_"~"_TERM
+55 SET $PIECE(OV,"^",3)=OV(3)
End DoDot:1
+56 ;---------------------------------------------------
+57 ;26 DUE COUNT - FINDING OBX.5.4
+58 IF L=2
Begin DoDot:1
+59 SET TERM="DUE COUNT"
+60 SET OV(4)=$GET(^TMP("PXRM7",$JOB,810.331,IENZ,4,"E"))_"~"_TERM
+61 SET $PIECE(OV,"^",4)=OV(4)
End DoDot:1
+62 ;---------------------------------------------------
+63 ;27 NOT DUE COUNT - FINDING OBX.5.5
+64 IF L=2
Begin DoDot:1
+65 SET TERM="NOT DUE COUNT"
+66 SET OV(5)=$GET(^TMP("PXRM7",$JOB,810.331,IENZ,5,"E"))_"~"_TERM
+67 SET $PIECE(OV,"^",5)=OV(5)
End DoDot:1
+68 ;---------------------------------------------------
+69 ;FINISH POPULATING OBX SEGMENT
+70 SET $PIECE(OBX(+SEQ_L),"|",6)=OV
+71 KILL OV
+72 ;---------------------------------------------------
+73 ;###---Set message in HL7 array
+74 SET ^TMP("HLS",$JOB,LINE)=$GET(OBX(+SEQ_L))
SET LINE=LINE+1
+75 ;
+76 IF SEE=1
WRITE !," ",OBX(+SEQ_L)
+77 KILL OBX
+78 ;---------------------------------------------------
+79 QUIT
