source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQADM22.m@ 1742

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1VAQADM22 ;ALB/JRP - MESSAGE ADMINISTRATION;20-MAY-93
2 ;;1.5;PATIENT DATA EXCHANGE;**10**;NOV 17, 1993
3AUTO(TRAN) ;AUTOMATIC PROCESSING OF REQUESTS
4 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
5 ;OUTPUT : 0 - Request processed
6 ; -1^Error_Text - Error
7 ;
8 ;CHECK INPUT
9 S TRAN=+$G(TRAN)
10 Q:(('TRAN)!('$D(^VAT(394.61,TRAN)))) "-1^Valid transaction not passed"
11 ;DECLARE VARIABLES
12 N DOMAIN,SSN,TMP,AUTOPROC,NAME,XMITARR,LIMITARR,MAXARR,RELEASED
13 S XMITARR="^TMP(""VAQ-XMIT"","_$J_")"
14 S LIMITARR="^TMP(""VAQ-AUTOCHK"",""REQLIMITS"","_$J_")"
15 S MAXARR="^TMP(""VAQ-AUTOCHK"",""OVERLIMITS"","_$J_")"
16 S RELEASED=0
17 K @XMITARR,@LIMITARR,@MAXARR
18 ;GET REQUESTING DOMAIN
19 S DOMAIN=$P($G(^VAT(394.61,TRAN,"RQST2")),"^",2)
20 ;GET PATIENT'S NAME & SSN
21 S TMP=$G(^VAT(394.61,TRAN,"QRY"))
22 S NAME=$P(TMP,"^",1)
23 S SSN=$P(TMP,"^",2)
24 ;CHECK FOR SENSITIVE PATIENT & DOMAIN IN RELEASE GROUP
25 S:(SSN'="") AUTOPROC=$$RES^VAQUTL99(DOMAIN,SSN)
26 S:(SSN="") AUTOPROC=$$RES^VAQUTL99(DOMAIN,NAME)
27 I +AUTOPROC=-2 S $P(AUTOPROC,"^",2)="Exact match on name/ssn/dob not found, process manually for potential matches"
28 ;GET TIME & OCCURRENCE LIMITS OF REQUESTED SEGMENTS
29 S TMP=$$BLDSEGS(TRAN,LIMITARR)
30 ;CHECK TIME & OCCURRENCE LIMITS OF REQUESTED SEGMENTS
31 I (TMP) D
32 .S TMP=$$MAXCHCK^VAQADM23(LIMITARR,MAXARR)
33 .;ALL LIMITS OK
34 .Q:('TMP)
35 .;SOME LIMITS DIDN'T PASS (DON'T OVERRIDE OTHER CHECKS IF THEY FAILED)
36 .S:((+AUTOPROC)>0) AUTOPROC="-20^Maximum time & occurrence limits exceeded by "_TMP_" segment"_$S((TMP>1):"s",1:"")
37 ;RELEASE INFORMATION (RELEASE=-1 ON ERROR)
38 I ((+AUTOPROC)>0) D
39 .S RELEASED=-1
40 .;FILE PATIENT POINTER
41 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.03,("`"_$P(AUTOPROC,"^",2)))
42 .Q:(TMP)
43 .;FILE RELEASE STATUS
44 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.05,"VAQ-RSLT")
45 .Q:(TMP)
46 .;FILE CURRENT STATUS
47 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.02,"VAQ-AUTO")
48 .Q:(TMP)
49 .;RESET PURGE FLAG
50 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,90,"NO")
51 .;FILE AUTHORIZER INFORMATION
52 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,50,"NOW")
53 .Q:(TMP)
54 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,51,"PDX Server")
55 .Q:(TMP)
56 .;QUEUE TRANSMISSION
57 .S @XMITARR@(TRAN)=""
58 .S TMP=$$GENTASK^VAQADM5(XMITARR)
59 .S:(TMP>0) RELEASED=1
60 .K @XMITARR
61 ;DON'T RELEASE INFORMATION
62 I ((+AUTOPROC)<0) D
63 .;CHANGE RELEASE STATUS TO ACKNOWLEDGED
64 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.05,"VAQ-RQACK")
65 .;CHANGE STATUS TO REQUIRES PROCESSING
66 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.02,"VAQ-PROC")
67 .;RESET PURGE FLAG
68 .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,90,"NO")
69 .;SEND ACK
70 .K @XMITARR
71 .S @XMITARR@(TRAN)=""
72 .S TMP=$$GENTASK^VAQADM5(XMITARR)
73 .K @XMITARR
74 ;SEND BULLETIN
75 S TMP=$P(AUTOPROC,"^",2)
76 S:(RELEASED<0) TMP="Unable to queue transmission of results"
77 S:((RELEASED<0)!('RELEASED)) TMP=$$PROCESS^VAQBUL02(TRAN,TMP,MAXARR)
78 K @LIMITARR,@MAXARR,@XMITARR
79 Q 0
80 ;
81BLDSEGS(TRANPTR,OUTARR) ;BUILD ARRAY OF SEGMENTS FOR A TRANSACTION
82 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
83 ; OUTARR - Output array (full global reference)
84 ; OUTARR(Pointer)=Time^Occur
85 ;OUTPUT : X - Number of segments placed into OUTARR
86 ;NOTES : This call is used to build the input for $$MAXCHCK^VAQADM23
87 ; : It is the responsibility of the programmer to ensure
88 ; that OUTARR is killed before and after this call
89 ;
90 ;CHECK INPUT
91 S TRANPTR=+$G(TRANPTR)
92 Q:('TRANPTR) 0
93 Q:('$D(^VAT(394.61,TRANPTR))) 0
94 Q:($G(OUTARR)="") 0
95 ;DECLARE VARIABLES
96 N TMP,POINTER,REQTIM,REQOCC,COUNT,NODE
97 ;LOOP THROUGH ALL SEGMENTS IN TRANSACTION
98 S NODE=0
99 S COUNT=0
100 F S NODE=+$O(^VAT(394.61,TRANPTR,"SEG",NODE)) Q:('NODE) D
101 .;GET REQUESTED TIME & OCCURRENCE LIMITS
102 .S TMP=$G(^VAT(394.61,TRANPTR,"SEG",NODE,0))
103 .Q:(TMP="")
104 .S POINTER=$P(TMP,"^",1)
105 .;NOT A VALID POINTER - IGNORE
106 .Q:('$D(^VAT(394.71,POINTER,0)))
107 .S REQTIM=$P(TMP,"^",2)
108 .S REQOCC=$P(TMP,"^",3)
109 .;PLACE INTO OUTPUT ARRAY & INCREMENT COUNT
110 .S @OUTARR@(POINTER)=(REQTIM_"^"_REQOCC)
111 .S COUNT=COUNT+1
112 ;RETURN NUMBER OF SEGMENTS IN TRANSACTION
113 Q COUNT
Note: See TracBrowser for help on using the repository browser.