[613] | 1 | VAFCMS03 ;BPFO/JRP - GENERAL ADT-A08 MESSAGE SENDER ; 22 Jan 2002 10:32 AM
|
---|
| 2 | ;;5.3;Registration;**494**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | BULKA08(ARRAY,EVNTPROT,USER,OUTARR) ;Build/send ADT-A08 messages
|
---|
| 5 | ;Input : ARRAY - List of patients to send (full global reference)
|
---|
| 6 | ; ARRAY(x) = yyy
|
---|
| 7 | ; x is pointer to Patient file (#2)
|
---|
| 8 | ; yyy can be anything (it's ignored)
|
---|
| 9 | ; EVNTPROT - HL7 event protocol to post message to (name or ptr)
|
---|
| 10 | ; USER - User causing message generation (DUZ or name)
|
---|
| 11 | ; Defaults to current DUZ
|
---|
| 12 | ; OUTARR - Array to return message IDs in (full global ref)
|
---|
| 13 | ; HLL("LINKS") - Refer to HL7 Dev Guide for definition
|
---|
| 14 | ; Use of this array is optional
|
---|
| 15 | ;Output : OUTARR - Array containing assigned message IDs or error text
|
---|
| 16 | ; OUTARR(x) = HL7 message ID
|
---|
| 17 | ; OUTARR(x) = 0^ErrorText
|
---|
| 18 | ; x is pointer to Patient file
|
---|
| 19 | ;Notes : OUTARR will be initialized (KILLed) on input
|
---|
| 20 | ; : OUTARR will be not be returned if USER evaluates to a number
|
---|
| 21 | ; and that number is not a valid DUZ
|
---|
| 22 | ; : OUTARR will not be returned on bad input
|
---|
| 23 | ; : It is assumed that EVNTPROT is defined to have a message
|
---|
| 24 | ; type of 'ADT' and event type of 'A08'
|
---|
| 25 | ;
|
---|
| 26 | ;Check input
|
---|
| 27 | Q:'$D(OUTARR)
|
---|
| 28 | K @OUTARR
|
---|
| 29 | Q:$G(ARRAY)=""
|
---|
| 30 | Q:'$D(EVNTPROT)
|
---|
| 31 | I '$D(USER) S USER=+$G(DUZ) S:'USER USER=""
|
---|
| 32 | I USER S USER=$$GET1^DIQ(200,(USER_","),.01) D CLEAN^DILF
|
---|
| 33 | Q:USER=""
|
---|
| 34 | ;Declare variables
|
---|
| 35 | N DFN,MSGID,COUNT,STOP
|
---|
| 36 | ;Loop through list of patients
|
---|
| 37 | S DFN=0
|
---|
| 38 | S STOP=0
|
---|
| 39 | F COUNT=1:1 S DFN=+$O(@ARRAY@(DFN)) Q:'DFN D Q:STOP
|
---|
| 40 | .;Build/send ADT-A08 message
|
---|
| 41 | .S @OUTARR@(DFN)=$$SNDA08(DFN,EVNTPROT,USER)
|
---|
| 42 | .;Check for request to stop every 100th patient (allows for queuing)
|
---|
| 43 | .I '(COUNT#100) S STOP=$$S^%ZTLOAD(COUNT_"th DFN = "_DFN)
|
---|
| 44 | Q
|
---|
| 45 | ;
|
---|
| 46 | SNDA08(DFN,EVNTPROT,USER) ;Build/send ADT-A08 message for patient
|
---|
| 47 | ;Input : DFN - Pointer to Patient file (#2)
|
---|
| 48 | ; EVNTPROT - HL7 event protocol to post message to (name or ptr)
|
---|
| 49 | ; USER - User causing message generation (DUZ or name)
|
---|
| 50 | ; Defaults to current DUZ
|
---|
| 51 | ; HLL("LINKS") - Refer to HL7 Dev Guide for definition
|
---|
| 52 | ; Use of this array is optional
|
---|
| 53 | ;Output : MsgID - HL7 message ID
|
---|
| 54 | ; 0^Text - Error
|
---|
| 55 | ;Notes : An error will be returned if USER evaluates to a number and
|
---|
| 56 | ; that number is not a valid DUZ
|
---|
| 57 | ; : It is assumed that EVNTPROT is defined to have a message
|
---|
| 58 | ; type of 'ADT' and event type of 'A08'
|
---|
| 59 | ;
|
---|
| 60 | ;Check input
|
---|
| 61 | S DFN=+$G(DFN)
|
---|
| 62 | I '$D(^DPT(DFN,0)) Q "0^Did not pass valid DFN"
|
---|
| 63 | I '$D(EVNTPROT) Q "0^Did not pass reference to HL7 event protocol"
|
---|
| 64 | I '$D(USER) S USER=+$G(DUZ) S:'USER USER=""
|
---|
| 65 | I USER S USER=$$GET1^DIQ(200,(USER_","),.01) D CLEAN^DILF
|
---|
| 66 | I USER="" Q "0^Did not pass reference to user causing event"
|
---|
| 67 | ;Declare variables
|
---|
| 68 | N VARPTR,PIVOTNUM,PIVOTPTR,INFOARR,MSGARR,TMP,RESULT
|
---|
| 69 | ;Create entry in ADT/HL7 PIVOT file
|
---|
| 70 | S VARPTR=DFN_";DPT("
|
---|
| 71 | S PIVOTNUM=+$$PIVNW^VAFHPIVT(DFN,$P(DT,"."),4,VARPTR)
|
---|
| 72 | I (PIVOTNUM<0) Q "0^Unable to create/find entry in ADT/HL7 PIVOT file"
|
---|
| 73 | ;Convert pivot number to pointer
|
---|
| 74 | S PIVOTPTR=+$O(^VAT(391.71,"D",PIVOTNUM,0))
|
---|
| 75 | I ('PIVOTPTR) Q "0^Unable to create/find entry in ADT/HL7 PIVOT file"
|
---|
| 76 | ;Set variables needed to build HL7 message
|
---|
| 77 | S INFOARR=$NA(^TMP("DG53494",$J,"INFO"))
|
---|
| 78 | S MSGARR=$NA(^TMP("HLS",$J))
|
---|
| 79 | K @INFOARR,@MSGARR
|
---|
| 80 | S @INFOARR@("PIVOT")=PIVOTPTR
|
---|
| 81 | S @INFOARR@("EVENT-NUM")=PIVOTNUM
|
---|
| 82 | S @INFOARR@("VAR-PTR")=VARPTR
|
---|
| 83 | S @INFOARR@("SERVER PROTOCOL")=EVNTPROT
|
---|
| 84 | S @INFOARR@("REASON",1)=""
|
---|
| 85 | S @INFOARR@("USER")=USER
|
---|
| 86 | S @INFOARR@("DFN")=DFN
|
---|
| 87 | S @INFOARR@("EVENT")="A08"
|
---|
| 88 | S @INFOARR@("DATE")=$$NOW^XLFDT()
|
---|
| 89 | ;Build message
|
---|
| 90 | S TMP=$$BLDMSG^VAFCMSG1(DFN,"A08",$$NOW^XLFDT(),INFOARR,MSGARR)
|
---|
| 91 | I (TMP<1) K @INFOARR,@MSGARR Q "0^"_$P(TMP,"^",2)
|
---|
| 92 | ;Send message
|
---|
| 93 | D GENERATE^HLMA(EVNTPROT,"GM",1,.RESULT)
|
---|
| 94 | ;Store message ID (or error text) in pivot file
|
---|
| 95 | S TMP=$S($P(RESULT,"^",2):$P(RESULT,"^",3),1:+RESULT)
|
---|
| 96 | D FILERM^VAFCUTL(PIVOTPTR,TMP)
|
---|
| 97 | ;Done
|
---|
| 98 | K @INFOARR,@MSGARR
|
---|
| 99 | I '$P(RESULT,"^",2) S RESULT=+RESULT
|
---|
| 100 | I $P(RESULT,"^",2) S RESULT="0^"_$P(RESULT,"^",3)
|
---|
| 101 | Q RESULT
|
---|
| 102 | ;
|
---|
| 103 | TASK ;Entry point for TaskMan to do bulk send
|
---|
| 104 | ;Input : ARRAY - List of patients to send (full global reference)
|
---|
| 105 | ; ARRAY(x) = yyy
|
---|
| 106 | ; x is pointer to Patient file (#2)
|
---|
| 107 | ; yyy can be anything (it's ignored)
|
---|
| 108 | ; EVNTPROT - Pointer to event protocol
|
---|
| 109 | ; DUZ - User that caused name changes
|
---|
| 110 | ;Notes : Contents of ARRAY will be deleted upon completion
|
---|
| 111 | ;
|
---|
| 112 | ;Make sure partition contains input
|
---|
| 113 | Q:'$D(ARRAY)
|
---|
| 114 | Q:'$D(EVNTPROT)
|
---|
| 115 | Q:'$D(DUZ)
|
---|
| 116 | ;Declare variables
|
---|
| 117 | N IENS,ITEM,SUBS,OUT
|
---|
| 118 | ;Make sure event protocol has subscribers
|
---|
| 119 | S IENS=","_EVNTPROT_","
|
---|
| 120 | D LIST^DIC(101.01,IENS,.01,"I",,,,,,,"ITEM")
|
---|
| 121 | D LIST^DIC(101.0775,IENS,.01,"I",,,,,,,"SUBS")
|
---|
| 122 | D CLEAN^DILF
|
---|
| 123 | ;No subscribers - delete contents of ARRAY and quit
|
---|
| 124 | I ('$G(ITEM("DILIST",0)))&('$G(SUBS("DILIST",0))) D Q
|
---|
| 125 | .K @ARRAY
|
---|
| 126 | ;Send messages
|
---|
| 127 | K MULT,IENS
|
---|
| 128 | S OUT=$NA(^TMP("VAFCMS03",$J))
|
---|
| 129 | D BULKA08(ARRAY,EVNTPROT,DUZ,OUT)
|
---|
| 130 | K @ARRAY,@OUT
|
---|
| 131 | S ZTREQ="@"
|
---|
| 132 | Q
|
---|