SCMCHLS ;BPOI/DJB - PCMM HL7 Segment Utils;12/13/99
;;5.3;Scheduling;**177,210,212,293,515,524**;08/13/93;Build 29
;
;Ref rtn: SCDXMSG1
;
;--> Build HL7 segments
BLDEVN ;Build EVN segment
S VAFEVN=$$EN^VAFHLEVN(EVNTHL7,EVNTDATE,VAFSTR,HL("Q"),HL("FS"))
Q
BLDPID ;Build PID segment
;S VAFPID=$$EN^VAFHLPID(DFN,VAFSTR)
S VAFPID=$$EN^VAFCPID(DFN,VAFSTR) ;Use CIRN version
D SETMAR^SCMSVUT0(.VAFPID,HL("Q"),HL("FS"))
Q
BLDZPC ;Build ZPC segment
;djb/bp Patch 210. Sequentially number multiple ZPC segments.
;new code begin
S SCSEQ=$G(SCSEQ)+1 ;Increment ZPC sequence number.
; S VAFZPC=$$ZPC^SCMCHLZ("",ID,DATA,SCSEQ)
S VAFZPC=$$ZPC^SCMCHLZ("",.ID,.DATA,SCSEQ)
;new code end
;old code begin
;S VAFZPC=$$ZPC^SCMCHLZ("",ID,DATA)
;old code end
Q
;
;--> Copy HL7 segments into HL7 message
CPYEVN ;Copy EVN segment
;Add 1 as 3rd subscript so number of subscripts matches ZPC segment
M @XMITARRY@(SUB,SEGNAME,1)=VAFEVN
Q
CPYPID ;Copy PID segment
;Add 1 as 3rd subscript so number of subscripts matches ZPC segment
M @XMITARRY@(SUB,SEGNAME,1)=VAFPID
Q
CPYZPC ;Copy ZPC segment
; PATCH 515 DLL USE ORIG TRIG
; old code = M @XMITARRY@($P(ID,"-",1),"ZPC",ID)=VAFZPC
M @XMITARRY@(SUB,"ZPC",ID)=VAFZPC ; og/sd/524
Q
;
;--> Delete HL7 segment variables
DELEVN ;Delete EVN variable
KILL VAFEVN
Q
DELPID ;Delete PID variable
KILL VAFPID
Q
DELZPC ;Delete ZPC variable
KILL VAFZPC
Q
;
SEGMENTS(EVNTTYPE,SEGARRY) ;Build list of HL7 segments for a given event type
;
; Input: EVNTTYPE - Event type to build list for A08 & A23 are the
; only types currently supported.
; Default=A08
; SEGARRY - Array to place output in (full global reference)
; Defaul=^TMP("SCMC SEGMENTS",$J)
;Output: SEGARRY(Seq,Name)=Fields
; Seq - Sequence number to order segments as they should
; be placed in the HL7 message.
; Name - Name of HL7 segment.
; Fields - List of fields used by PCMM. VAFSTR would be set
; to this value.
; Note: MSH segment is not included
;
;Check input
S EVNTTYPE=$G(EVNTTYPE)
S:(EVNTTYPE'="A23") EVNTTYPE="A08"
S SEGARRY=$G(SEGARRY)
S:(SEGARRY="") SEGARRY="^TMP(""SCMC SEGMENTS"","_$J_")"
;
;Segments used by A08
S @SEGARRY@(1,"EVN")="1,2"
S @SEGARRY@(2,"PID")="1,2,3,4,5,6,7,8,10N,11,12,13,14,16,17,19,22"
S @SEGARRY@(3,"ZPC")="1,2,3,4,5,6,8" ;bp/ar and alb/rpm Patch 212
Q
;
UNWIND(XMITARRY,INSRTPNT) ;Remove all data that was put into transmit array.
;
; Input: XMITARRY - Array containing HL7 message (full global ref).
; Default=^TMP("HLS",$J).
; INSRTPNT - Where to begin deletion from.
; Default=1
;Output: None
;
;Check input
S:$G(XMITARRY)="" XMITARRY="^TMP(""HLS"","_$J_")"
S:$G(INSRTPNT)="" INSRTPNT=1
;
;Remove insertion point from array
KILL @XMITARRY@(INSRTPNT)
;Remove everything from insertion point to end of array
F S INSRTPNT=$O(@XMITARRY@(INSRTPNT)) Q:INSRTPNT="" KILL @XMITARRY@(INSRTPNT)
;Done
Q
COUNT(VALER) ;counts the number of errored encounters found.
;
; Input: VALER - Array containing error messages.
;Output: Number of errors
;
NEW VAR,CNT
S CNT=0
S VAR=""
F S VAR=$O(@VALER@(VAR)) Q:VAR']"" S CNT=CNT+1
Q CNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHLS 3405 printed Apr 09, 2024@21:46:49 Page 2
SCMCHLS ;BPOI/DJB - PCMM HL7 Segment Utils;12/13/99
+1 ;;5.3;Scheduling;**177,210,212,293,515,524**;08/13/93;Build 29
+2 ;
+3 ;Ref rtn: SCDXMSG1
+4 ;
+5 ;--> Build HL7 segments
BLDEVN ;Build EVN segment
+1 SET VAFEVN=$$EN^VAFHLEVN(EVNTHL7,EVNTDATE,VAFSTR,HL("Q"),HL("FS"))
+2 QUIT
BLDPID ;Build PID segment
+1 ;S VAFPID=$$EN^VAFHLPID(DFN,VAFSTR)
+2 ;Use CIRN version
SET VAFPID=$$EN^VAFCPID(DFN,VAFSTR)
+3 DO SETMAR^SCMSVUT0(.VAFPID,HL("Q"),HL("FS"))
+4 QUIT
BLDZPC ;Build ZPC segment
+1 ;djb/bp Patch 210. Sequentially number multiple ZPC segments.
+2 ;new code begin
+3 ;Increment ZPC sequence number.
SET SCSEQ=$GET(SCSEQ)+1
+4 ; S VAFZPC=$$ZPC^SCMCHLZ("",ID,DATA,SCSEQ)
+5 SET VAFZPC=$$ZPC^SCMCHLZ("",.ID,.DATA,SCSEQ)
+6 ;new code end
+7 ;old code begin
+8 ;S VAFZPC=$$ZPC^SCMCHLZ("",ID,DATA)
+9 ;old code end
+10 QUIT
+11 ;
+12 ;--> Copy HL7 segments into HL7 message
CPYEVN ;Copy EVN segment
+1 ;Add 1 as 3rd subscript so number of subscripts matches ZPC segment
+2 MERGE @XMITARRY@(SUB,SEGNAME,1)=VAFEVN
+3 QUIT
CPYPID ;Copy PID segment
+1 ;Add 1 as 3rd subscript so number of subscripts matches ZPC segment
+2 MERGE @XMITARRY@(SUB,SEGNAME,1)=VAFPID
+3 QUIT
CPYZPC ;Copy ZPC segment
+1 ; PATCH 515 DLL USE ORIG TRIG
+2 ; old code = M @XMITARRY@($P(ID,"-",1),"ZPC",ID)=VAFZPC
+3 ; og/sd/524
MERGE @XMITARRY@(SUB,"ZPC",ID)=VAFZPC
+4 QUIT
+5 ;
+6 ;--> Delete HL7 segment variables
DELEVN ;Delete EVN variable
+1 KILL VAFEVN
+2 QUIT
DELPID ;Delete PID variable
+1 KILL VAFPID
+2 QUIT
DELZPC ;Delete ZPC variable
+1 KILL VAFZPC
+2 QUIT
+3 ;
SEGMENTS(EVNTTYPE,SEGARRY) ;Build list of HL7 segments for a given event type
+1 ;
+2 ; Input: EVNTTYPE - Event type to build list for A08 & A23 are the
+3 ; only types currently supported.
+4 ; Default=A08
+5 ; SEGARRY - Array to place output in (full global reference)
+6 ; Defaul=^TMP("SCMC SEGMENTS",$J)
+7 ;Output: SEGARRY(Seq,Name)=Fields
+8 ; Seq - Sequence number to order segments as they should
+9 ; be placed in the HL7 message.
+10 ; Name - Name of HL7 segment.
+11 ; Fields - List of fields used by PCMM. VAFSTR would be set
+12 ; to this value.
+13 ; Note: MSH segment is not included
+14 ;
+15 ;Check input
+16 SET EVNTTYPE=$GET(EVNTTYPE)
+17 if (EVNTTYPE'="A23")
SET EVNTTYPE="A08"
+18 SET SEGARRY=$GET(SEGARRY)
+19 if (SEGARRY="")
SET SEGARRY="^TMP(""SCMC SEGMENTS"","_$JOB_")"
+20 ;
+21 ;Segments used by A08
+22 SET @SEGARRY@(1,"EVN")="1,2"
+23 SET @SEGARRY@(2,"PID")="1,2,3,4,5,6,7,8,10N,11,12,13,14,16,17,19,22"
+24 ;bp/ar and alb/rpm Patch 212
SET @SEGARRY@(3,"ZPC")="1,2,3,4,5,6,8"
+25 QUIT
+26 ;
UNWIND(XMITARRY,INSRTPNT) ;Remove all data that was put into transmit array.
+1 ;
+2 ; Input: XMITARRY - Array containing HL7 message (full global ref).
+3 ; Default=^TMP("HLS",$J).
+4 ; INSRTPNT - Where to begin deletion from.
+5 ; Default=1
+6 ;Output: None
+7 ;
+8 ;Check input
+9 if $GET(XMITARRY)=""
SET XMITARRY="^TMP(""HLS"","_$JOB_")"
+10 if $GET(INSRTPNT)=""
SET INSRTPNT=1
+11 ;
+12 ;Remove insertion point from array
+13 KILL @XMITARRY@(INSRTPNT)
+14 ;Remove everything from insertion point to end of array
+15 FOR
SET INSRTPNT=$ORDER(@XMITARRY@(INSRTPNT))
if INSRTPNT=""
QUIT
KILL @XMITARRY@(INSRTPNT)
+16 ;Done
+17 QUIT
COUNT(VALER) ;counts the number of errored encounters found.
+1 ;
+2 ; Input: VALER - Array containing error messages.
+3 ;Output: Number of errors
+4 ;
+5 NEW VAR,CNT
+6 SET CNT=0
+7 SET VAR=""
+8 FOR
SET VAR=$ORDER(@VALER@(VAR))
if VAR']""
QUIT
SET CNT=CNT+1
+9 QUIT CNT
