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

MAGDHW0.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. INIT ;
  1.  ; simulate call to INT^HLFNC2
  1.  N I
  1.  S HL("CC")="US"
  1.  S HL("ECH")="^~\&"
  1.  S HL("ETN")=""
  1.  S HL("FS")="|"
  1.  S HL("MTN")="ORM"
  1.  S HL("PID")="D"
  1.  S HL("Q")=""
  1.  S HL("SAF")=^DD("SITE",1)
  1.  S HL("SAN")="MAGD-SCH"
  1.  S HL("VER")="2.3.1"
  1.  S DEL=HL("FS")
  1.  F I=1:1:$L(HL("ECH")) S @("DEL"_(I+1))=$E(HL("ECH"),I)
  1.  S U="^"
  1.  Q
  1.  ;
  1. FINDSEG(ARRAY,SEGMENT,I,X) ; find a specific HL7 segment in an array
  1.  ; input -- ARRAY ---- an HL7 array
  1.  ; input -- SEGMENT -- three-letter HL7 segment identifier 
  1.  ; input -- I -------- index of the found segment (or null)
  1.  ; output - I -------- index of the found segment (or null)
  1.  ; output - X -------- string of fields sans segment identifier
  1.  ; return - HIT ------ flag indicating segment found 
  1.  ;
  1.  N HIT
  1.  S HIT=0
  1.  F  S I=$O(ARRAY(I)) Q:I=""  I $P(ARRAY(I),DEL)=SEGMENT D  Q
  1.  . S X=$P(ARRAY(I),DEL,2,99999) ; strip off the segment name
  1.  . S HIT=1
  1.  . Q
  1.  Q HIT
  1.  ;
  1. SAVESEG(I,X) ; save updated segment
  1.  S $P(HL7(I),DEL,2,999)=X
  1.  Q
  1.  ;
  1. ADDSEG(X) ; add a new segment to the end if the message
  1.  S HL7($O(HL7(""),-1)+1)=X
  1.  Q
  1.  ;
  1. OUTPUT ; output the message to ^MAGDHL7
  1.  N DIC,DIE,D0,DA,DR,I,J,K,X,Y,Z
  1.  S X=FMDATE,DIC="^MAGDHL7(2006.5,",DIC(0)="LZ" D FILE^DICN S D0=+Y
  1.  S DIE=DIC,DR=".03///^S X=FMDATETM",DA=D0 D ^DIE ; capture time
  1.  S $P(^MAGDHL7(2006.5,D0,0),"^",2)="ORM" ; all are ORM
  1.  S I="HL7",J=0 F  S I=$Q(@I) Q:I=""  D
  1.  . S X=@I,Y=$P(X,DEL)
  1.  . F K=2:1:$L(X,DEL) D  ; copy the lines to the ^MAGDHL7 global
  1.  . . S Z=$P(X,DEL,K)
  1.  . . I ($L(Y)+$L(Z))>200 D  ; keep lines short for the global
  1.  . . . ; output one line of a spanned record
  1.  . . . S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y,Y=""
  1.  . . . Q
  1.  . . S Y=Y_DEL_$P(X,DEL,K)
  1.  . . Q
  1.  . S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y
  1.  . Q
  1.  ; The next line must be last, since WAIT^MAGDHRS1
  1.  ; uses this node to determine that the entry is complete.
  1.  S ^MAGDHL7(2006.5,D0,1,0)="^^"_J_"^"_J_"^"_FMDATETM
  1.  Q