MAGDHW0 ;WOIFO/PMK - Capture Consult/Request data ; 28 Mar 2006 9:07 AM
;;3.0;IMAGING;**10,86,49**;Mar 19, 2002;Build 2033;Apr 07, 2011
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
;
;
Q
;
INIT ;
; simulate call to INT^HLFNC2
N I
S HL("CC")="US"
S HL("ECH")="^~\&"
S HL("ETN")=""
S HL("FS")="|"
S HL("MTN")="ORM"
S HL("PID")="D"
S HL("Q")=""
S HL("SAF")=^DD("SITE",1)
S HL("SAN")="MAGD-SCH"
S HL("VER")="2.3.1"
S DEL=HL("FS")
F I=1:1:$L(HL("ECH")) S @("DEL"_(I+1))=$E(HL("ECH"),I)
S U="^"
Q
;
FINDSEG(ARRAY,SEGMENT,I,X) ; find a specific HL7 segment in an array
; input -- ARRAY ---- an HL7 array
; input -- SEGMENT -- three-letter HL7 segment identifier
; input -- I -------- index of the found segment (or null)
; output - I -------- index of the found segment (or null)
; output - X -------- string of fields sans segment identifier
; return - HIT ------ flag indicating segment found
;
N HIT
S HIT=0
F S I=$O(ARRAY(I)) Q:I="" I $P(ARRAY(I),DEL)=SEGMENT D Q
. S X=$P(ARRAY(I),DEL,2,99999) ; strip off the segment name
. S HIT=1
. Q
Q HIT
;
SAVESEG(I,X) ; save updated segment
S $P(HL7(I),DEL,2,999)=X
Q
;
ADDSEG(X) ; add a new segment to the end if the message
S HL7($O(HL7(""),-1)+1)=X
Q
;
OUTPUT ; output the message to ^MAGDHL7
N DIC,DIE,D0,DA,DR,I,J,K,X,Y,Z
S X=FMDATE,DIC="^MAGDHL7(2006.5,",DIC(0)="LZ" D FILE^DICN S D0=+Y
S DIE=DIC,DR=".03///^S X=FMDATETM",DA=D0 D ^DIE ; capture time
S $P(^MAGDHL7(2006.5,D0,0),"^",2)="ORM" ; all are ORM
S I="HL7",J=0 F S I=$Q(@I) Q:I="" D
. S X=@I,Y=$P(X,DEL)
. F K=2:1:$L(X,DEL) D ; copy the lines to the ^MAGDHL7 global
. . S Z=$P(X,DEL,K)
. . I ($L(Y)+$L(Z))>200 D ; keep lines short for the global
. . . ; output one line of a spanned record
. . . S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y,Y=""
. . . Q
. . S Y=Y_DEL_$P(X,DEL,K)
. . Q
. S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y
. Q
; The next line must be last, since WAIT^MAGDHRS1
; uses this node to determine that the entry is complete.
S ^MAGDHL7(2006.5,D0,1,0)="^^"_J_"^"_J_"^"_FMDATETM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHW0 3077 printed Apr 09, 2024@21:08:37 Page 2
MAGDHW0 ;WOIFO/PMK - Capture Consult/Request data ; 28 Mar 2006 9:07 AM
+1 ;;3.0;IMAGING;**10,86,49**;Mar 19, 2002;Build 2033;Apr 07, 2011
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;
+18 ;
+19 QUIT
+20 ;
INIT ;
+1 ; simulate call to INT^HLFNC2
+2 NEW I
+3 SET HL("CC")="US"
+4 SET HL("ECH")="^~\&"
+5 SET HL("ETN")=""
+6 SET HL("FS")="|"
+7 SET HL("MTN")="ORM"
+8 SET HL("PID")="D"
+9 SET HL("Q")=""
+10 SET HL("SAF")=^DD("SITE",1)
+11 SET HL("SAN")="MAGD-SCH"
+12 SET HL("VER")="2.3.1"
+13 SET DEL=HL("FS")
+14 FOR I=1:1:$LENGTH(HL("ECH"))
SET @("DEL"_(I+1))=$EXTRACT(HL("ECH"),I)
+15 SET U="^"
+16 QUIT
+17 ;
FINDSEG(ARRAY,SEGMENT,I,X) ; find a specific HL7 segment in an array
+1 ; input -- ARRAY ---- an HL7 array
+2 ; input -- SEGMENT -- three-letter HL7 segment identifier
+3 ; input -- I -------- index of the found segment (or null)
+4 ; output - I -------- index of the found segment (or null)
+5 ; output - X -------- string of fields sans segment identifier
+6 ; return - HIT ------ flag indicating segment found
+7 ;
+8 NEW HIT
+9 SET HIT=0
+10 FOR
SET I=$ORDER(ARRAY(I))
if I=""
QUIT
IF $PIECE(ARRAY(I),DEL)=SEGMENT
Begin DoDot:1
+11 ; strip off the segment name
SET X=$PIECE(ARRAY(I),DEL,2,99999)
+12 SET HIT=1
+13 QUIT
End DoDot:1
QUIT
+14 QUIT HIT
+15 ;
SAVESEG(I,X) ; save updated segment
+1 SET $PIECE(HL7(I),DEL,2,999)=X
+2 QUIT
+3 ;
ADDSEG(X) ; add a new segment to the end if the message
+1 SET HL7($ORDER(HL7(""),-1)+1)=X
+2 QUIT
+3 ;
OUTPUT ; output the message to ^MAGDHL7
+1 NEW DIC,DIE,D0,DA,DR,I,J,K,X,Y,Z
+2 SET X=FMDATE
SET DIC="^MAGDHL7(2006.5,"
SET DIC(0)="LZ"
DO FILE^DICN
SET D0=+Y
+3 ; capture time
SET DIE=DIC
SET DR=".03///^S X=FMDATETM"
SET DA=D0
DO ^DIE
+4 ; all are ORM
SET $PIECE(^MAGDHL7(2006.5,D0,0),"^",2)="ORM"
+5 SET I="HL7"
SET J=0
FOR
SET I=$QUERY(@I)
if I=""
QUIT
Begin DoDot:1
+6 SET X=@I
SET Y=$PIECE(X,DEL)
+7 ; copy the lines to the ^MAGDHL7 global
FOR K=2:1:$LENGTH(X,DEL)
Begin DoDot:2
+8 SET Z=$PIECE(X,DEL,K)
+9 ; keep lines short for the global
IF ($LENGTH(Y)+$LENGTH(Z))>200
Begin DoDot:3
+10 ; output one line of a spanned record
+11 SET J=J+1
SET ^MAGDHL7(2006.5,D0,1,J,0)=Y
SET Y=""
+12 QUIT
End DoDot:3
+13 SET Y=Y_DEL_$PIECE(X,DEL,K)
+14 QUIT
End DoDot:2
+15 SET J=J+1
SET ^MAGDHL7(2006.5,D0,1,J,0)=Y
+16 QUIT
End DoDot:1
+17 ; The next line must be last, since WAIT^MAGDHRS1
+18 ; uses this node to determine that the entry is complete.
+19 SET ^MAGDHL7(2006.5,D0,1,0)="^^"_J_"^"_J_"^"_FMDATETM
+20 QUIT
