Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRM7XT

PXRM7XT.m

Go to the documentation of this file.
  1. PXRM7XT ;SLC/JVS HL7 EXTRACT FROM FILE; 06/01/2007
  1. ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
  1. ;This is the beginning of the extraction from the extract file
  1. ;
  1. ;VARIABLE LIST
  1. ;IEN = IEN OF ENTRY IN EXTRACT FILE 810.3
  1. Q
  1. SPLIT ;SPLIT MESSAGES
  1. ;
  1. N ORC2
  1. I LINE>100 D
  1. .S ORCCNT=ORCCNT+1
  1. .D EN^PXRM7M1(.ID)
  1. .K ^TMP("HLS",$J)
  1. .S ORC2=$G(^TMP("PXRM7HLORC",$J))
  1. .S $P(ORC2,"|",3)="P"_ORCCNT,ORC=ORC2
  1. .S LINE=2
  1. .I $D(SEE) W !,ORC
  1. .S ^TMP("HLS",$J,1)=ORC
  1. Q
  1. ;
  1. EXTRACT(IEN,SEE,ID,MODE) ;
  1. N ORCCNT
  1. K ERROR,LINE
  1. S ORCCNT=1 ;Count of ORC segments or number of messages created
  1. S LINE=1 ;Line count for the ^TMP("HL7",$J,LINE) global variable
  1. ;-Verify Values
  1. I '$D(^PXRMXT(810.3,IEN)) S ERROR(1)="No Such IEN in file 810.3 "_IEN
  1. I $D(ERROR) D Q
  1. .I $D(SEE)=1
  1. ;-Extracting Value of Nodes in file
  1. I $D(ERROR) Q
  1. D GETS^DIQ(810.3,IEN,"**","EI","^TMP(""PXRM7"",$J)")
  1. D ORCSEG
  1. ;******Add NTE segment to end of message *******
  1. ;******change 3rd piece of ORC segement to L (last)****
  1. S NTE="NTE||"_LAST_"||"
  1. S ^TMP("HLS",$J,LINE)=NTE,LINE=LINE+1
  1. I SEE=1 W !,NTE
  1. K NTE,LAST
  1. S ORC=$G(^TMP("HLS",$J,1)),$P(ORC,"|",3)="F"_ORCCNT,^TMP("HLS",$J,1)=ORC
  1. ;***********************************************
  1. ;*******TURN ON BELOW TO TRANSMIT TO AUSTIN *****
  1. D EN^PXRM7M1(.ID)
  1. ;***********************************************
  1. K ^TMP("PXRM7",$J)
  1. K ^TMP("HLS",$J)
  1. K ^TMP("PXRM7HLORC",$J)
  1. ;********KILL LEFT OVER ARRAYS AND VARIABLES*****
  1. K HL("EID"),HLA("HLS"),PROTIEN,PXRM7,PXRM77,PXRM7ID,PXRM7R,ZMID
  1. K DA,DISYS,DISYS,EO,HL("EIDS"),HLECH,HLFS,HLN,HLQ,HLSAN,HLX
  1. K IENIEN,IENOBR,IENX,IENY,IENZ,L,LINE,NEXT,QTI,RFS,SEQ
  1. K STATION,USI
  1. ;**************************************************
  1. Q
  1. ORCSEG ;CREATE ORC SEGMENTS
  1. ;ORDERED IN ORDER OF APPEARANCE IN SEGMENT
  1. ;QTI=QUANTITY AND TIMING
  1. ;EO=ENTERING ORGANIZATION
  1. ;--Below adds extra line feed in front of the message. --
  1. ;---------------------------------------------------
  1. S IENY=IEN_","
  1. ;---------------------------------------------
  1. ;0 PLACER ORDER NUMBER ORC.2.1
  1. S $P(ORC,"|",3)="P1"
  1. ;---------------------------------------------
  1. ;1 REPORTING PERIOD ORC.7.1.1
  1. S QTI(1)=$G(^TMP("PXRM7",$J,810.3,IENY,3,"E"))
  1. S $P(QTI,"~",1)=QTI(1)
  1. ;---------------------------------------------
  1. ;2 QUARTER ORC.7.3
  1. S QTI(3)=$G(^TMP("PXRM7",$J,810.3,IENY,7,"E"))
  1. S $P(QTI,"~",3)=QTI(3)
  1. ;---------------------------------------------
  1. ;3 BEGINNING DATE ORC.7.4.1
  1. S QTI(4)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.02,"I")),"DT")
  1. S $P(QTI,"~",4)=QTI(4)
  1. ;---------------------------------------------
  1. ;4 ENDING DATE ORC.7.5.1
  1. S QTI(5)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.03,"I")),"DT")
  1. S $P(QTI,"~",5)=QTI(5)
  1. ;---------------------------------------------
  1. ;5 REPORTING YEAR ORC.7.11.2
  1. S QTI(11)="&"_$G(^TMP("PXRM7",$J,810.3,IENY,4,"E"))
  1. S $P(QTI,"~",11)=QTI(11)
  1. ;---------------------------------------------
  1. ;6 EXTRACT DATE ORC.9.1
  1. S $P(ORC,"|",10)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.06,"I")),"DT")
  1. ;---------------------------------------------
  1. ;7 NAME ORC.17.2
  1. S EO(2)=$G(^TMP("PXRM7",$J,810.3,IENY,.01,"E"))
  1. S $P(EO,"~",2)=EO(2)
  1. ;---------------------------------------------
  1. ;8 REPORT EXTRACT PARAMETER ORC.17.5
  1. S EO(5)=$G(^TMP("PXRM7",$J,810.3,IENY,1,"E"))
  1. S $P(EO,"~",5)=EO(5)
  1. ;---------------------------------------------
  1. ;9 REPORT EXTRACT TYPE ORC.18.2
  1. S $P(ORC,"|",19)="~"_$G(^TMP("PXRM7",$J,810.3,IENY,2,"E"))
  1. ;---------------------------------------------
  1. ;FINISH POPULATING ORC SEGMENT
  1. S $P(ORC,"|",8)=QTI
  1. S $P(ORC,"|",18)=EO
  1. S $P(ORC,"|",1)="ORC"
  1. ;---------------------------------------------
  1. ;SET HL7 TMP ARRAY AND SHOW SEGMENT
  1. S ^TMP("HLS",$J,LINE)=ORC,LINE=LINE+1
  1. I SEE=1 W !,ORC
  1. S ^TMP("PXRM7HLORC",$J)=ORC
  1. K ORC
  1. OBRSEG ;CREATE OBR SEGMENTS
  1. ;N IENOBR,SEQ,USI,QTI,NEXT,STATION
  1. ;USI=UNIVERSAL SERVICE ID
  1. ;RFS=REASON FOR STUDY
  1. ;
  1. S NEXT=1,LAST=0
  1. S IENOBR=0 F S IENOBR=$O(^PXRMXT(810.3,IEN,3,IENOBR)) Q:IENOBR<1 D
  1. .S IENIEN=-1 F S IENIEN=$O(^PXRMXT(810.3,IEN,3,IENOBR,1,IENIEN)) Q:IENIEN="B" D Q:IENIEN=""
  1. ..S L=$S(IENIEN=0:1,IENIEN>0:2,IENIEN="":1,1:"")
  1. ..;###---Set Sequence Number
  1. ..S IENX=IENOBR_","_IEN_","
  1. ..S IENZ=IENIEN_","_IENOBR_","_IEN_","
  1. ..S SEQ=$G(^TMP("PXRM7",$J,810.33,IENX,.01,"E"))
  1. ..S OBR(+SEQ_L)="OBR|1|||||||||||||||||||||||||||||||"
  1. ..S $P(OBR(+SEQ_L),"|",2)=NEXT,LAST=NEXT,NEXT=NEXT+1
  1. ..;--------------------------------------------------
  1. ..;10 COUNT TYPE OBR.4.2
  1. ..;R=REMINDER COUNTS F=FINDING COUNTS
  1. ..S USI(2)=$S(L=1:"R",L=2:"F",1:"")
  1. ..S $P(USI,"~",2)=USI(2)
  1. ..;--------------------------------------------------
  1. ..;11 REMINDER OBR.4.5
  1. ..S USI(5)=$G(^TMP("PXRM7",$J,810.33,IENX,.02,"E"))
  1. ..S $P(USI,"~",5)=USI(5)
  1. ..;--------------------------------------------------
  1. ..;12 STATION OBR.3.1
  1. ..S STATION=$G(^TMP("PXRM7",$J,810.33,IENX,.03,"I"))_","
  1. ..D GETS^DIQ(4,STATION,"**","E","^TMP(""PXRM7"",$J)")
  1. ..S $P(OBR(+SEQ_L),"|",4)=$G(^TMP("PXRM7",$J,4,STATION,99,"E"))
  1. ..;--------------------------------------------------
  1. ..;13 PATIENT LIST OBR.31.2
  1. ..S RFS(2)=$G(^TMP("PXRM7",$J,810.33,IENX,.04,"E"))
  1. ..S $P(RFS,"~",2)=RFS(2)
  1. ..;--------------------------------------------------
  1. ..;19 REMINDER TERM OBR.31.1
  1. ..S RFS(1)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.02,"E")),1:"")
  1. ..S $P(RFS,"~",1)=RFS(1)
  1. ..;--------------------------------------------------
  1. ..;20 FINDING TOTAL TYPE OBR.31.4
  1. ..S RFS(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.03,"E")),1:"")
  1. ..S $P(RFS,"~",4)=RFS(4)
  1. ..;--------------------------------------------------
  1. ..;21 GROUP NAME OBR.31.5
  1. ..S RFS(5)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.04,"E")),1:"")
  1. ..S $P(RFS,"~",5)=RFS(5)
  1. ..;--------------------------------------------------
  1. ..;22 REMINDER STATUS OBR.4.4
  1. ..S USI(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.05,"I")),1:"")
  1. ..S $P(USI,"~",4)=USI(4)
  1. ..;-------------------------------------------------
  1. ..;FINISH POPULATING OBR SEGMENT
  1. ..S $P(OBR(+SEQ_L),"|",5)=USI
  1. ..S $P(OBR(+SEQ_L),"|",32)=RFS
  1. ..;-------------------------------------------------
  1. ..;---Set message in HL7 array
  1. ..;I $L($G(OBR(+SEQ_L)))=255 S OBR(+SEQ_L)=OBR(+SEQ_L)_"|||"
  1. ..S ^TMP("HLS",$J,LINE)=$G(OBR(+SEQ_L)),LINE=LINE+1
  1. ..;
  1. ..I SEE=1 W !," ",OBR(+SEQ_L)
  1. ..K OBR
  1. ..D OBXSEG
  1. ..D SPLIT
  1. ..I (L=1)&(IENIEN="") Q
  1. Q
  1. OBXSEG ;CREATE THE OBX SEGMENTS
  1. N TERM
  1. ;OV=OBSERVATION VALUE
  1. S $P(OBX(+SEQ_L),"|",3)="MO"
  1. S $P(OBX(+SEQ_L),"|",1)="OBX"
  1. ;---------------------------------------------------
  1. ;###---SET SEQUENCE NUMBER
  1. S $P(OBX(+SEQ_L),"|",2)=1
  1. ;---------------------------------------------------
  1. ;14 TOTAL PATIENTS EVALUATED - REMINDER OBX.5.1
  1. I L=1 D
  1. .S TERM="TOTAL PATIENTS EVALUATED"
  1. .S OV(1)=$G(^TMP("PXRM7",$J,810.33,IENX,2,"E"))_"~"_TERM
  1. .S $P(OV,"^",1)=OV(1)
  1. ;---------------------------------------------------
  1. ;15 TOTAL PATIENTS APPLICABLE - REMINDER OBX.5.2
  1. I L=1 D
  1. .S TERM="TOTAL PATIENTS APPLICABLE"
  1. .S OV(2)=$G(^TMP("PXRM7",$J,810.33,IENX,3,"E"))_"~"_TERM
  1. .S $P(OV,"^",2)=OV(2)
  1. ;---------------------------------------------------
  1. ;16 TOTAL PATIENTS NOT APPLICABLE - REMINDER OBX.5.3
  1. I L=1 D
  1. .S TERM="TOTAL PATIENTS NOT APPLICABLE"
  1. .S OV(3)=$G(^TMP("PXRM7",$J,810.33,IENX,4,"E"))_"~"_TERM
  1. .S $P(OV,"^",3)=OV(3)
  1. ;---------------------------------------------------
  1. ;17 TOTAL PATIENTS DUE - REMINDER OBX.5.4
  1. I L=1 D
  1. .S TERM="TOTAL PATIENTS DUE"
  1. .S OV(4)=$G(^TMP("PXRM7",$J,810.33,IENX,5,"E"))_"~"_TERM
  1. .S $P(OV,"^",4)=OV(4)
  1. ;---------------------------------------------------
  1. ;18 TOTAL PATIENTS NOT DUE - REMINDER OBX.5.5
  1. I L=1 D
  1. .S TERM="TOTAL PATIENTS NOT DUE"
  1. .S OV(5)=$G(^TMP("PXRM7",$J,810.33,IENX,6,"E"))_"~"_TERM
  1. .S $P(OV,"^",5)=OV(5)
  1. ;---------------------------------------------------
  1. ;23 TOTAL COUNT - FINDING OBX.5.1
  1. I L=2 D
  1. .S TERM="TOTAL COUNT"
  1. .S OV(1)=$G(^TMP("PXRM7",$J,810.331,IENZ,1,"E"))_"~"_TERM
  1. .S $P(OV,"^",1)=OV(1)
  1. ;---------------------------------------------------
  1. ;24 APPLICABLE COUNT - FINDING OBX.5.2
  1. I L=2 D
  1. .S TERM="APPLICABLE COUNT"
  1. .S OV(2)=$G(^TMP("PXRM7",$J,810.331,IENZ,2,"E"))_"~"_TERM
  1. .S $P(OV,"^",2)=OV(2)
  1. ;---------------------------------------------------
  1. ;25 NOT APPLICABLE COUNT- FINDING OBX.5.3
  1. I L=2 D
  1. .S TERM="NOT APPLICABLE COUNT"
  1. .S OV(3)=$G(^TMP("PXRM7",$J,810.331,IENZ,3,"E"))_"~"_TERM
  1. .S $P(OV,"^",3)=OV(3)
  1. ;---------------------------------------------------
  1. ;26 DUE COUNT - FINDING OBX.5.4
  1. I L=2 D
  1. .S TERM="DUE COUNT"
  1. .S OV(4)=$G(^TMP("PXRM7",$J,810.331,IENZ,4,"E"))_"~"_TERM
  1. .S $P(OV,"^",4)=OV(4)
  1. ;---------------------------------------------------
  1. ;27 NOT DUE COUNT - FINDING OBX.5.5
  1. I L=2 D
  1. .S TERM="NOT DUE COUNT"
  1. .S OV(5)=$G(^TMP("PXRM7",$J,810.331,IENZ,5,"E"))_"~"_TERM
  1. .S $P(OV,"^",5)=OV(5)
  1. ;---------------------------------------------------
  1. ;FINISH POPULATING OBX SEGMENT
  1. S $P(OBX(+SEQ_L),"|",6)=OV
  1. K OV
  1. ;---------------------------------------------------
  1. ;###---Set message in HL7 array
  1. S ^TMP("HLS",$J,LINE)=$G(OBX(+SEQ_L)),LINE=LINE+1
  1. ;
  1. I SEE=1 W !," ",OBX(+SEQ_L)
  1. K OBX
  1. ;---------------------------------------------------
  1. Q