- 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
- 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