source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCMS03.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1VAFCMS03 ;BPFO/JRP - GENERAL ADT-A08 MESSAGE SENDER ; 22 Jan 2002 10:32 AM
2 ;;5.3;Registration;**494**;Aug 13, 1993
3 ;
4BULKA08(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 ;
46SNDA08(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 ;
103TASK ;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
Note: See TracBrowser for help on using the repository browser.