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

MDCADT.m

Go to the documentation of this file.
  1. MDCADT ;HINES OIFO/DP/BJ/TJ - HL7 Build ADT Axx Messages;10 Aug 2007
  1. ;;1.0;CLINICAL PROCEDURES;**16,12**;Apr 01, 2004;Build 318
  1. ; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; This routine uses the following Integration Agreements (IAs):
  1. ; # 2050 - $$EZBLD^DIALOG() FileMan (supported)
  1. ; # 2887 - $$GETAPP^HLCS2 call HL7 (supported)
  1. ; #10106 - $$HLDATE^HLFNC HL7 (supported)
  1. ; #10070 - ^XMD call MailMan (supported)
  1. ; #10035 - access ^DPT( Registration (supported)
  1. ;
  1. VALID ;HL7 MESSAGE BUILDER
  1. ; Creates HL7 V2.4 "Axx Type" message
  1. ; stolen from GMVVDEF1
  1. ; segments returned will fall into 1 of four categories
  1. ; Case 1 = simple unsubscripted variable e.g. SEG="IN1^Blue Cross.....^^"
  1. ; Case 2 = single segment, 2 or more nodes e.g. SEG="PD1^Smith,John...^^"
  1. ; SEG(1)="3505 94ST^....^^"
  1. ; Case 3 = Multiple segments, 1 node each e.g. SEG(1,0)="NK1^Smith,Mary^2...^^"
  1. ; SEG(2,0)="NK1^Smith,Joey^3...^^"
  1. ; Case 4 = Multiple segments, 1 or more nodes e.g. SEG(1,0)="ZCL^ data ...^^"
  1. ; SEG(1,0,1)="^ more data ...^^"
  1. ; SEG(1,0,2)="^ end of data ...^^"
  1. ; SEG(2,0)="ZCL^ all of segment ^^"
  1. ; SEG(3,0)="ZCL^ another segment ^^"
  1. ; SEG(3,0,1)=" etc., etc. ^^"
  1. ; I $D(SEG)=1 Case 1
  1. ; I $D(SEG)=11 Case 2
  1. ; I $D(SEG)=10 Case 3 or 4
  1. Q
  1. ;
  1. BLDMSG(KEY,VFLAG,OUT,MSHP,MDCEVN) ;
  1. ;
  1. ; Inputs:
  1. ; KEY - IEN of file to create message from
  1. ; VFLAG - "V" for VistA HL7 destination (default)
  1. ; OUT - target ARRAY, passed by reference
  1. ; MSHP - "ADT"
  1. ; MDCEVN - message type, e.g. A04
  1. ;
  1. ; Output: Two part string with parts separated by "^"
  1. ; Part 1: "LM" - output in local array passed in "OUT" parameter
  1. ; "GM" - output in ^TMP("HLS",$J)
  1. ; Part 2: No longer used ;
  1. ;
  1. N MDCMAIL,IENSSAVE,TARGET
  1. N MDCS,EV,MDCERAY,MDCERR,MDCSEG,MDCIEN
  1. ;
  1. S IENSSAVE=$G(IENS)
  1. S MDCIEN=KEY,MDCS=0
  1. K ^TMP("HLS",$J),OUT
  1. ;S ARRAY="^TMP("_"""HLS"""_",$J,MDCS)",TARGET="GM^" ; array is a global
  1. S ARRAY="OUT("_"""HLS"""_",MDCS)",TARGET="LM^" ; array is a local variable
  1. ;
  1. ; Get DATA
  1. M MDCDATA=^MDC(704.005,KEY)
  1. ;
  1. ; Validate Patient Movement Data
  1. ;
  1. I '$D(MDCDATA) D Q TARGET
  1. . S MDCERAY(1)=KEY
  1. . S MDCERR=$$EZBLD^DIALOG(7040020.002,.MDCERAY)
  1. . D ERR(MDCERR)
  1. ;
  1. ; Get and Validate Patient IEN
  1. S DFN=+$P($G(MDCDATA(0)),U)
  1. I '$D(^DPT(DFN,0))!(DFN=0) D Q TARGET
  1. . S MDCERAY(1)=DFN
  1. . S MDCERR=$$EZBLD^DIALOG(7040020.003,.MDCERAY)
  1. . D ERR(MDCERR)
  1. ;
  1. ; Build segments
  1. ;
  1. EVN ; EVN - Event Type with EVN.7.1 - required
  1. D EN^MDCEVN(MDCEVN,.MDCIEN,.MDCSEG,.MDCERR) I $D(MDCERR) D ERR(MDCERR) Q TARGET
  1. I '$D(MDCSEG) D Q TARGET ; missing segment
  1. . S MDCPARM(1)="EVN",MDCPARM(2)=+$G(MDCIEN),MDCPARM(3)=405
  1. . S MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
  1. . D ERR(MDCERR)
  1. D SAVE
  1. ;
  1. PID ; PID - Patient Identification - required
  1. D EN^MDCPID(DFN,.MDCSEG,.MDCERR) I $D(MDCERR) D ERR(MDCERR) Q TARGET
  1. I '$D(MDCSEG) D Q TARGET ; missing segment
  1. . S MDCPARM(1)="PID",MDCPARM(2)=DFN,MDCPARM(3)=2
  1. . S MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
  1. . D ERR(MDCERR)
  1. D SAVE
  1. ;
  1. PV1 ; PV1 - Patient Visit - required or empty
  1. D EN^MDCPV1(.MDCDATA,.MDCSEG,.MDCERR) I $D(MDCERR) D ERR(MDCERR) Q TARGET
  1. I '$D(MDCSEG) D Q TARGET ; missing segment
  1. . S MDCPARM(1)="PV1",MDCPARM(MDCIEN)=DFN,MDCPARM(3)=405
  1. . S MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
  1. . D ERR(MDCERR)
  1. D SAVE
  1. ;
  1. ; Done building segments, clean up and exit
  1. K PARAM,MDCSITE,MDCDATA
  1. Q TARGET
  1. ;
  1. SAVE ;
  1. I $D(MDCSEG)#10 D ; single segment, one node
  1. . S MDCS=MDCS+1
  1. . M @ARRAY=MDCSEG
  1. I $D(MDCSEG)=10 D ; maybe multiple segments, multiple nodes
  1. . N I
  1. . S I=""
  1. . F D Q:I=""
  1. .. S I=$O(MDCSEG(I)) Q:I=""
  1. .. S MDCS=MDCS+1
  1. .. M @ARRAY=MDCSEG(I,0)
  1. K MDCSEG
  1. ; Move local array to global if it's getting too big
  1. I $P(TARGET,U)="LM",$S<16000 D
  1. . K ^TMP("HLS",$J) M ^TMP("HLS",$J)=OUT("HLS") K OUT("HLS")
  1. . S $P(TARGET,U)="GM",ARRAY="^TMP("_"""HLS"""_",$J,MDCS)"
  1. Q
  1. ;
  1. ; Error Processing
  1. ERR(MDCERR) ;
  1. ; Input: MDCERR - Error message.
  1. N IENS,ZTSTOP
  1. S IENS=$G(IENSSAVE,MDCIEN)
  1. D MAILERR
  1. S ZTSTOP=1
  1. K MDCPARM,OUT
  1. Q
  1. ;
  1. ; Mail Message
  1. MAILERR ; mail error notification to g.developers
  1. N RECEIVER,XMDUZ,XMY,XMSUB,XMTEXT,HL7DATE,%
  1. D NOW^%DTC
  1. S HL7DATE=$$HLDATE^HLFNC(%,"TS")
  1. S RECEIVER=$$GETAPP^HLCS2(HL("SAN"))
  1. S RECEIVER="g."_$P(RECEIVER,U)
  1. S XMDUZ=.5
  1. S XMY(RECEIVER)=""
  1. S XMSUB=" CP Flowsheets HL7 Error Message; file# 704.005 IEN ="_KEY_" (ADT Event #"_MDCEVN_")"
  1. S XMTEXT="MDCMAIL("
  1. S MDCMAIL(1)=MDCERR
  1. D ^XMD
  1. Q