133 lines
5.1 KiB
Mathematica
133 lines
5.1 KiB
Mathematica
VAFCMS03 ;BPFO/JRP - GENERAL ADT-A08 MESSAGE SENDER ; 22 Jan 2002 10:32 AM
|
|
;;5.3;Registration;**494**;Aug 13, 1993
|
|
;
|
|
BULKA08(ARRAY,EVNTPROT,USER,OUTARR) ;Build/send ADT-A08 messages
|
|
;Input : ARRAY - List of patients to send (full global reference)
|
|
; ARRAY(x) = yyy
|
|
; x is pointer to Patient file (#2)
|
|
; yyy can be anything (it's ignored)
|
|
; EVNTPROT - HL7 event protocol to post message to (name or ptr)
|
|
; USER - User causing message generation (DUZ or name)
|
|
; Defaults to current DUZ
|
|
; OUTARR - Array to return message IDs in (full global ref)
|
|
; HLL("LINKS") - Refer to HL7 Dev Guide for definition
|
|
; Use of this array is optional
|
|
;Output : OUTARR - Array containing assigned message IDs or error text
|
|
; OUTARR(x) = HL7 message ID
|
|
; OUTARR(x) = 0^ErrorText
|
|
; x is pointer to Patient file
|
|
;Notes : OUTARR will be initialized (KILLed) on input
|
|
; : OUTARR will be not be returned if USER evaluates to a number
|
|
; and that number is not a valid DUZ
|
|
; : OUTARR will not be returned on bad input
|
|
; : It is assumed that EVNTPROT is defined to have a message
|
|
; type of 'ADT' and event type of 'A08'
|
|
;
|
|
;Check input
|
|
Q:'$D(OUTARR)
|
|
K @OUTARR
|
|
Q:$G(ARRAY)=""
|
|
Q:'$D(EVNTPROT)
|
|
I '$D(USER) S USER=+$G(DUZ) S:'USER USER=""
|
|
I USER S USER=$$GET1^DIQ(200,(USER_","),.01) D CLEAN^DILF
|
|
Q:USER=""
|
|
;Declare variables
|
|
N DFN,MSGID,COUNT,STOP
|
|
;Loop through list of patients
|
|
S DFN=0
|
|
S STOP=0
|
|
F COUNT=1:1 S DFN=+$O(@ARRAY@(DFN)) Q:'DFN D Q:STOP
|
|
.;Build/send ADT-A08 message
|
|
.S @OUTARR@(DFN)=$$SNDA08(DFN,EVNTPROT,USER)
|
|
.;Check for request to stop every 100th patient (allows for queuing)
|
|
.I '(COUNT#100) S STOP=$$S^%ZTLOAD(COUNT_"th DFN = "_DFN)
|
|
Q
|
|
;
|
|
SNDA08(DFN,EVNTPROT,USER) ;Build/send ADT-A08 message for patient
|
|
;Input : DFN - Pointer to Patient file (#2)
|
|
; EVNTPROT - HL7 event protocol to post message to (name or ptr)
|
|
; USER - User causing message generation (DUZ or name)
|
|
; Defaults to current DUZ
|
|
; HLL("LINKS") - Refer to HL7 Dev Guide for definition
|
|
; Use of this array is optional
|
|
;Output : MsgID - HL7 message ID
|
|
; 0^Text - Error
|
|
;Notes : An error will be returned if USER evaluates to a number and
|
|
; that number is not a valid DUZ
|
|
; : It is assumed that EVNTPROT is defined to have a message
|
|
; type of 'ADT' and event type of 'A08'
|
|
;
|
|
;Check input
|
|
S DFN=+$G(DFN)
|
|
I '$D(^DPT(DFN,0)) Q "0^Did not pass valid DFN"
|
|
I '$D(EVNTPROT) Q "0^Did not pass reference to HL7 event protocol"
|
|
I '$D(USER) S USER=+$G(DUZ) S:'USER USER=""
|
|
I USER S USER=$$GET1^DIQ(200,(USER_","),.01) D CLEAN^DILF
|
|
I USER="" Q "0^Did not pass reference to user causing event"
|
|
;Declare variables
|
|
N VARPTR,PIVOTNUM,PIVOTPTR,INFOARR,MSGARR,TMP,RESULT
|
|
;Create entry in ADT/HL7 PIVOT file
|
|
S VARPTR=DFN_";DPT("
|
|
S PIVOTNUM=+$$PIVNW^VAFHPIVT(DFN,$P(DT,"."),4,VARPTR)
|
|
I (PIVOTNUM<0) Q "0^Unable to create/find entry in ADT/HL7 PIVOT file"
|
|
;Convert pivot number to pointer
|
|
S PIVOTPTR=+$O(^VAT(391.71,"D",PIVOTNUM,0))
|
|
I ('PIVOTPTR) Q "0^Unable to create/find entry in ADT/HL7 PIVOT file"
|
|
;Set variables needed to build HL7 message
|
|
S INFOARR=$NA(^TMP("DG53494",$J,"INFO"))
|
|
S MSGARR=$NA(^TMP("HLS",$J))
|
|
K @INFOARR,@MSGARR
|
|
S @INFOARR@("PIVOT")=PIVOTPTR
|
|
S @INFOARR@("EVENT-NUM")=PIVOTNUM
|
|
S @INFOARR@("VAR-PTR")=VARPTR
|
|
S @INFOARR@("SERVER PROTOCOL")=EVNTPROT
|
|
S @INFOARR@("REASON",1)=""
|
|
S @INFOARR@("USER")=USER
|
|
S @INFOARR@("DFN")=DFN
|
|
S @INFOARR@("EVENT")="A08"
|
|
S @INFOARR@("DATE")=$$NOW^XLFDT()
|
|
;Build message
|
|
S TMP=$$BLDMSG^VAFCMSG1(DFN,"A08",$$NOW^XLFDT(),INFOARR,MSGARR)
|
|
I (TMP<1) K @INFOARR,@MSGARR Q "0^"_$P(TMP,"^",2)
|
|
;Send message
|
|
D GENERATE^HLMA(EVNTPROT,"GM",1,.RESULT)
|
|
;Store message ID (or error text) in pivot file
|
|
S TMP=$S($P(RESULT,"^",2):$P(RESULT,"^",3),1:+RESULT)
|
|
D FILERM^VAFCUTL(PIVOTPTR,TMP)
|
|
;Done
|
|
K @INFOARR,@MSGARR
|
|
I '$P(RESULT,"^",2) S RESULT=+RESULT
|
|
I $P(RESULT,"^",2) S RESULT="0^"_$P(RESULT,"^",3)
|
|
Q RESULT
|
|
;
|
|
TASK ;Entry point for TaskMan to do bulk send
|
|
;Input : ARRAY - List of patients to send (full global reference)
|
|
; ARRAY(x) = yyy
|
|
; x is pointer to Patient file (#2)
|
|
; yyy can be anything (it's ignored)
|
|
; EVNTPROT - Pointer to event protocol
|
|
; DUZ - User that caused name changes
|
|
;Notes : Contents of ARRAY will be deleted upon completion
|
|
;
|
|
;Make sure partition contains input
|
|
Q:'$D(ARRAY)
|
|
Q:'$D(EVNTPROT)
|
|
Q:'$D(DUZ)
|
|
;Declare variables
|
|
N IENS,ITEM,SUBS,OUT
|
|
;Make sure event protocol has subscribers
|
|
S IENS=","_EVNTPROT_","
|
|
D LIST^DIC(101.01,IENS,.01,"I",,,,,,,"ITEM")
|
|
D LIST^DIC(101.0775,IENS,.01,"I",,,,,,,"SUBS")
|
|
D CLEAN^DILF
|
|
;No subscribers - delete contents of ARRAY and quit
|
|
I ('$G(ITEM("DILIST",0)))&('$G(SUBS("DILIST",0))) D Q
|
|
.K @ARRAY
|
|
;Send messages
|
|
K MULT,IENS
|
|
S OUT=$NA(^TMP("VAFCMS03",$J))
|
|
D BULKA08(ARRAY,EVNTPROT,DUZ,OUT)
|
|
K @ARRAY,@OUT
|
|
S ZTREQ="@"
|
|
Q
|