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
VAFCMS03 ;BPFO/JRP - GENERAL ADT-A08 MESSAGE SENDER ; 22 Jan 2002 10:32 AM
+1 ;;5.3;Registration;**494**;Aug 13, 1993
+2 ;
BULKA08(ARRAY,EVNTPROT,USER,OUTARR) ;Build/send ADT-A08 messages
+1 ;Input : ARRAY - List of patients to send (full global reference)
+2 ; ARRAY(x) = yyy
+3 ; x is pointer to Patient file (#2)
+4 ; yyy can be anything (it's ignored)
+5 ; EVNTPROT - HL7 event protocol to post message to (name or ptr)
+6 ; USER - User causing message generation (DUZ or name)
+7 ; Defaults to current DUZ
+8 ; OUTARR - Array to return message IDs in (full global ref)
+9 ; HLL("LINKS") - Refer to HL7 Dev Guide for definition
+10 ; Use of this array is optional
+11 ;Output : OUTARR - Array containing assigned message IDs or error text
+12 ; OUTARR(x) = HL7 message ID
+13 ; OUTARR(x) = 0^ErrorText
+14 ; x is pointer to Patient file
+15 ;Notes : OUTARR will be initialized (KILLed) on input
+16 ; : OUTARR will be not be returned if USER evaluates to a number
+17 ; and that number is not a valid DUZ
+18 ; : OUTARR will not be returned on bad input
+19 ; : It is assumed that EVNTPROT is defined to have a message
+20 ; type of 'ADT' and event type of 'A08'
+21 ;
+22 ;Check input
+23 IF '$DATA(OUTARR)
QUIT
+24 KILL @OUTARR
+25 IF $GET(ARRAY)=""
QUIT
+26 IF '$DATA(EVNTPROT)
QUIT
+27 IF '$DATA(USER)
SET USER=+$GET(DUZ)
IF 'USER
SET USER=""
+28 IF USER
SET USER=$$GET1^DIQ(200,(USER_","),.01)
DO CLEAN^DILF
+29 IF USER=""
QUIT
+30 ;Declare variables
+31 NEW DFN,MSGID,COUNT,STOP
+32 ;Loop through list of patients
+33 SET DFN=0
+34 SET STOP=0
+35 FOR COUNT=1:1
SET DFN=+$ORDER(@ARRAY@(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+36 ;Build/send ADT-A08 message
+37 SET @OUTARR@(DFN)=$$SNDA08(DFN,EVNTPROT,USER)
+38 ;Check for request to stop every 100th patient (allows for queuing)
+39 IF '(COUNT#100)
SET STOP=$$S^%ZTLOAD(COUNT_"th DFN = "_DFN)
End DoDot:1
IF STOP
QUIT
+40 QUIT
+41 ;
SNDA08(DFN,EVNTPROT,USER) ;Build/send ADT-A08 message for patient
+1 ;Input : DFN - Pointer to Patient file (#2)
+2 ; EVNTPROT - HL7 event protocol to post message to (name or ptr)
+3 ; USER - User causing message generation (DUZ or name)
+4 ; Defaults to current DUZ
+5 ; HLL("LINKS") - Refer to HL7 Dev Guide for definition
+6 ; Use of this array is optional
+7 ;Output : MsgID - HL7 message ID
+8 ; 0^Text - Error
+9 ;Notes : An error will be returned if USER evaluates to a number and
+10 ; that number is not a valid DUZ
+11 ; : It is assumed that EVNTPROT is defined to have a message
+12 ; type of 'ADT' and event type of 'A08'
+13 ;
+14 ;Check input
+15 SET DFN=+$GET(DFN)
+16 IF '$DATA(^DPT(DFN,0))
QUIT "0^Did not pass valid DFN"
+17 IF '$DATA(EVNTPROT)
QUIT "0^Did not pass reference to HL7 event protocol"
+18 IF '$DATA(USER)
SET USER=+$GET(DUZ)
IF 'USER
SET USER=""
+19 IF USER
SET USER=$$GET1^DIQ(200,(USER_","),.01)
DO CLEAN^DILF
+20 IF USER=""
QUIT "0^Did not pass reference to user causing event"
+21 ;Declare variables
+22 NEW VARPTR,PIVOTNUM,PIVOTPTR,INFOARR,MSGARR,TMP,RESULT
+23 ;Create entry in ADT/HL7 PIVOT file
+24 SET VARPTR=DFN_";DPT("
+25 SET PIVOTNUM=+$$PIVNW^VAFHPIVT(DFN,$PIECE(DT,"."),4,VARPTR)
+26 IF (PIVOTNUM<0)
QUIT "0^Unable to create/find entry in ADT/HL7 PIVOT file"
+27 ;Convert pivot number to pointer
+28 SET PIVOTPTR=+$ORDER(^VAT(391.71,"D",PIVOTNUM,0))
+29 IF ('PIVOTPTR)
QUIT "0^Unable to create/find entry in ADT/HL7 PIVOT file"
+30 ;Set variables needed to build HL7 message
+31 SET INFOARR=$NAME(^TMP("DG53494",$JOB,"INFO"))
+32 SET MSGARR=$NAME(^TMP("HLS",$JOB))
+33 KILL @INFOARR,@MSGARR
+34 SET @INFOARR@("PIVOT")=PIVOTPTR
+35 SET @INFOARR@("EVENT-NUM")=PIVOTNUM
+36 SET @INFOARR@("VAR-PTR")=VARPTR
+37 SET @INFOARR@("SERVER PROTOCOL")=EVNTPROT
+38 SET @INFOARR@("REASON",1)=""
+39 SET @INFOARR@("USER")=USER
+40 SET @INFOARR@("DFN")=DFN
+41 SET @INFOARR@("EVENT")="A08"
+42 SET @INFOARR@("DATE")=$$NOW^XLFDT()
+43 ;Build message
+44 SET TMP=$$BLDMSG^VAFCMSG1(DFN,"A08",$$NOW^XLFDT(),INFOARR,MSGARR)
+45 IF (TMP<1)
KILL @INFOARR,@MSGARR
QUIT "0^"_$PIECE(TMP,"^",2)
+46 ;Send message
+47 DO GENERATE^HLMA(EVNTPROT,"GM",1,.RESULT)
+48 ;Store message ID (or error text) in pivot file
+49 SET TMP=$SELECT($PIECE(RESULT,"^",2):$PIECE(RESULT,"^",3),1:+RESULT)
+50 DO FILERM^VAFCUTL(PIVOTPTR,TMP)
+51 ;Done
+52 KILL @INFOARR,@MSGARR
+53 IF '$PIECE(RESULT,"^",2)
SET RESULT=+RESULT
+54 IF $PIECE(RESULT,"^",2)
SET RESULT="0^"_$PIECE(RESULT,"^",3)
+55 QUIT RESULT
+56 ;
TASK ;Entry point for TaskMan to do bulk send
+1 ;Input : ARRAY - List of patients to send (full global reference)
+2 ; ARRAY(x) = yyy
+3 ; x is pointer to Patient file (#2)
+4 ; yyy can be anything (it's ignored)
+5 ; EVNTPROT - Pointer to event protocol
+6 ; DUZ - User that caused name changes
+7 ;Notes : Contents of ARRAY will be deleted upon completion
+8 ;
+9 ;Make sure partition contains input
+10 IF '$DATA(ARRAY)
QUIT
+11 IF '$DATA(EVNTPROT)
QUIT
+12 IF '$DATA(DUZ)
QUIT
+13 ;Declare variables
+14 NEW IENS,ITEM,SUBS,OUT
+15 ;Make sure event protocol has subscribers
+16 SET IENS=","_EVNTPROT_","
+17 DO LIST^DIC(101.01,IENS,.01,"I",,,,,,,"ITEM")
+18 DO LIST^DIC(101.0775,IENS,.01,"I",,,,,,,"SUBS")
+19 DO CLEAN^DILF
+20 ;No subscribers - delete contents of ARRAY and quit
+21 IF ('$GET(ITEM("DILIST",0)))&('$GET(SUBS("DILIST",0)))
Begin DoDot:1
+22 KILL @ARRAY
End DoDot:1
QUIT
+23 ;Send messages
+24 KILL MULT,IENS
+25 SET OUT=$NAME(^TMP("VAFCMS03",$JOB))
+26 DO BULKA08(ARRAY,EVNTPROT,DUZ,OUT)
+27 KILL @ARRAY,@OUT
+28 SET ZTREQ="@"
+29 QUIT
