source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQBUL02.m@ 681

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1VAQBUL02 ;ALB/JRP - BULLETINS;20-MAY-93
2 ;;1.5;PATIENT DATA EXCHANGE;**9,16,20**;NOV 17, 1993
3PROCESS(TRANPTR,REASON,ARRAY1) ;SEND REQUIRES PROCESSING BULLETIN
4 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
5 ; REASON - Why transaction requires processing
6 ; ARRAY1 - Array of pointers to VAQ - DATA SEGMENT that
7 ; were contained in the request but over the maximium
8 ; time & occurrence limit allowed for automatic
9 ; processing (full global ref)
10 ; ARRAY1(Pointer)=MaxTime^MaxOccur^ReqTime^ReqOccur
11 ;OUTPUT : 0 - Bulletin sent
12 ; -1^Error_Text - Bulletin not sent
13 ;NOTES : If segments were not checked against maximum limits, still
14 ; pass an array reference for ARRAY1. If ARRAY1 doesn't exist
15 ; the information will not be used.
16 ;
17 ;CHECK INPUT
18 S TRANPTR=+$G(TRANPTR)
19 Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass valid transaction"
20 S REASON=$G(REASON)
21 S ARRAY1=$G(ARRAY1)
22 ;DECLARE VARIABLES
23 N TRANNUM,TMP,NAME,PID,DOB,DOMAIN,X,LINE,USER,SITE,XMY,TMPARR
24 N SEGPTR,SEGABB,MAXTIM,MAXOCC,TIME,OCCUR,SSN,Y,ERROR
25 S TMPARR="^TMP(""VAQ-BUL"","_$J_")"
26 K @TMPARR
27 S TRANNUM=+$G(^VAT(394.61,TRANPTR,0))
28 S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
29 S NAME=$P(TMP,"^",1)
30 S SSN=$P(TMP,"^",2)
31 S DOB=$P(TMP,"^",3)
32 S PID=$P(TMP,"^",4)
33 S:(NAME="") NAME="Not listed"
34 S:(PID="") PID=SSN
35 S DOB=$$DOBFMT^VAQUTL99(DOB,0)
36 S:(DOB="") DOB="Not listed"
37 S USER=$P($G(^VAT(394.61,TRANPTR,"RQST1")),"^",2)
38 S:(USER="") USER="Unknown"
39 S TMP=$G(^VAT(394.61,TRANPTR,"RQST2"))
40 S SITE=$P(TMP,"^",1)
41 S DOMAIN=$P(TMP,"^",2)
42 S:(SITE="") SITE="Could not be determined"
43 S:(DOMAIN="") DOMAIN="Could not be determined"
44 ;BUILD TEXT OF MESSAGE
45 S LINE=1
46 S TMP="The following PDX Request requires manual processing ..."
47 S @TMPARR@(LINE,0)=TMP
48 S LINE=LINE+1
49 S TMP=""
50 S @TMPARR@(LINE,0)=TMP
51 S LINE=LINE+1
52 S TMP=" Transaction number: "_TRANNUM
53 S @TMPARR@(LINE,0)=TMP
54 S LINE=LINE+1
55 S TMP=" Name: "_NAME
56 S @TMPARR@(LINE,0)=TMP
57 S LINE=LINE+1
58 S TMP=" PID: "_PID
59 S @TMPARR@(LINE,0)=TMP
60 S LINE=LINE+1
61 S TMP=" DOB: "_DOB
62 S @TMPARR@(LINE,0)=TMP
63 S LINE=LINE+1
64 S TMP=""
65 S @TMPARR@(LINE,0)=TMP
66 S LINE=LINE+1
67 S TMP=" Requested by: "_USER
68 S @TMPARR@(LINE,0)=TMP
69 S LINE=LINE+1
70 S TMP=" Site: "_SITE
71 S @TMPARR@(LINE,0)=TMP
72 S LINE=LINE+1
73 S TMP=" Domain: "_DOMAIN
74 S @TMPARR@(LINE,0)=TMP
75 S LINE=LINE+1
76 S TMP=""
77 S @TMPARR@(LINE,0)=TMP
78 S LINE=LINE+1
79 S TMP=" Reason for manual processing:"
80 S @TMPARR@(LINE,0)=TMP
81 S LINE=LINE+1
82 S TMP=" "_REASON
83 S @TMPARR@(LINE,0)=TMP
84 S LINE=LINE+1
85 S TMP=""
86 S @TMPARR@(LINE,0)=TMP
87 S LINE=LINE+1
88 ;PRINT SEGMENTS EXCEEDING MAXIMUM LIMITS (IF PASSED)
89 I (ARRAY1'="") I (+$O(@ARRAY1@(""))) D
90 .S TMP=" Segments that were over the allowable time & occurrence limits:"
91 .S @TMPARR@(LINE,0)=TMP
92 .S LINE=LINE+1
93 .S TMP=""
94 .S @TMPARR@(LINE,0)=TMP
95 .S LINE=LINE+1
96 .S TMP=" Requested Maximum Requested Maximum"
97 .S @TMPARR@(LINE,0)=TMP
98 .S LINE=LINE+1
99 .S TMP=" Segment Time Time Occurrence Occurrence"
100 .S @TMPARR@(LINE,0)=TMP
101 .S LINE=LINE+1
102 .S TMP=" ------- --------- ------- ---------- ----------"
103 .S @TMPARR@(LINE,0)=TMP
104 .S LINE=LINE+1
105 .S SEGPTR=""
106 .F S SEGPTR=+$O(@ARRAY1@(SEGPTR)) Q:('SEGPTR) D
107 ..S SEGABB=$P($G(^VAT(394.71,SEGPTR,0)),"^",2)
108 ..Q:(SEGABB="")
109 ..S TMP=$G(@ARRAY1@(SEGPTR))
110 ..S MAXTIM=$P(TMP,"^",1)
111 ..S:(MAXTIM="") MAXTIM="NA"
112 ..S:(MAXTIM="@") MAXTIM="-"
113 ..S MAXOCC=$P(TMP,"^",2)
114 ..S:(MAXOCC="") MAXOCC="NA"
115 ..S:(MAXOCC="@") MAXOCC="-"
116 ..S TIME=$P(TMP,"^",3)
117 ..S:(MAXTIM="NA") TIME="NA"
118 ..S:(TIME="") TIME="-"
119 ..S OCCUR=$P(TMP,"^",4)
120 ..S:(MAXOCC="NA") OCCUR="NA"
121 ..S:((OCCUR="")!(OCCUR=0)) OCCUR="-"
122 ..S TMP=""
123 ..S TMP=$$INSERT^VAQUTL1(SEGABB,TMP,3)
124 ..S TMP=$$INSERT^VAQUTL1(TIME,TMP,16)
125 ..S TMP=$$INSERT^VAQUTL1(MAXTIM,TMP,29)
126 ..S TMP=$$INSERT^VAQUTL1(OCCUR,TMP,42)
127 ..S TMP=$$INSERT^VAQUTL1(MAXOCC,TMP,56)
128 ..S @TMPARR@(LINE,0)=TMP
129 ..S LINE=LINE+1
130 ;SEND TO PROCESSING GROUP
131 S XMY("G.VAQ MANUAL PROCESSING")=""
132 ;SEND TO SECURITY OFFICER IF LOCAL PATIENT IS SENSITIVE
133 S:((+$$RES^VAQUTL99(DOMAIN,SSN))=-4) TMP=$$LOADXMY^DGSEC()
134 S:((+$$RES^VAQUTL99(DOMAIN,NAME))=-4) TMP=$$LOADXMY^DGSEC()
135 ;SEND BULLETIN
136 S TMP="Process PDX Request for "_NAME
137 S X="PDX"
138 S Y="Patient Data eXchange"
139 S ERROR=+$$SENDBULL^VAQBUL(TMP,X,Y,TMPARR)
140 K @TMPARR
141 Q:(ERROR<0) "-1^Unable to generate and send bulletin"
142 Q 0
Note: See TracBrowser for help on using the repository browser.