source: WorldVistAEHR/trunk/r/NETWORK_HEALTH_EXCHANGE-AFJX/AFJXALRT.m@ 619

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

initial load of WorldVistAEHR

File size: 7.0 KB
Line 
1AFJXALRT ;FO-OAKLAND/GMB-PROCESS INFO AND ALERT USER ;3/17/99 13:42
2 ;;5.1;Network Health Exchange;**6,15,17,23,31,32**;Jan 23, 1996
3 ; Totally rewritten 11/2001. (Previously FJ/CWS.)
4 ; ENTER - Invoked by server option AFJXSERVER
5 ;
6 ; DBIAs:
7 ; 1092 - Call DSD^ZISPL and DSDOC^ZISPL1 (Kernel)
8 ; 3587 - Read fields 2 and 9 of file 3.51 (Kernel)
9 ; 3774 - Read field .04 of file 142.99 (Health Summary)
10 ; 3779 - Search file 4.2, read field 1 (MailMan)
11ENTER ;
12 N XMZ,XMSER
13 D:'$$CLOSED(XQSND) PROCESS(XQMSG) ; Ignore if sending site is closed.
14 S XMSER="S.AFJXSERVER",XMZ=XQMSG D REMSBMSG^XMA1C
15 Q
16CLOSED(AXFROM) ; Returns 1 if sending site is closed; 0 otherwise.
17 I AXFROM'["@" Q 0
18 N AXDOMIEN
19 S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",$P($P(AXFROM,"@",2),">",1),"B^C")
20 Q:'AXDOMIEN 0
21 Q $$GET1^DIQ(4.2,AXDOMIEN_",",1)["C"
22PROCESS(AXRQXMZ) ; Process data incoming
23 N AXPID,AXSENSIT,AXDFN,AXDOMIEN,AXABORT,AXSPDOC,AXSPDATA,AXTI
24 N AXRQREC,AXRQSSN,AXRQDUZ,AXRQNAME,AXRQWHEN,AXRQSITE,AXRQTYPE,AXRQFROM
25 D INIT
26 I 'AXABORT D
27 . D GATHER
28 . D TRANSFER
29 D FINISH
30 Q
31INIT ;
32 S (AXABORT,AXTI)=0
33 K ^TMP("AFJX",$J)
34 D ^%ZISC ; Make sure all devices are closed
35 S AXRQREC=$G(^XMB(3.9,AXRQXMZ,2,1,0))
36 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=AXRQREC
37 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)="***CONFIDENTIAL Patient Data from "_^XMB("NETNAME")_"*** "_$$FMTE^XLFDT(DT,"2Z")
38 S AXRQSSN=$P(AXRQREC,U,1) ; Patient SSN
39 S AXRQDUZ=$P(AXRQREC,U,2) ; Requestor's DUZ
40 S AXRQNAME=$P(AXRQREC,U,3) ; Requestor's name
41 S AXRQWHEN=$P(AXRQREC,U,4) ; Date/Time request was made
42 S AXRQSITE=$P(AXRQREC,U,5) ; Requestor's site
43 S AXRQTYPE=$P(AXRQREC,U,6) ; Type of request
44 S AXRQFROM=AXRQNAME_"@"_AXRQSITE
45 S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXRQSITE,"B^C")
46 I 'AXDOMIEN D FAIL("Site not found in DOMAIN file: "_AXRQSITE) Q
47 I 'AXRQSSN D FAIL("SSN not supplied.") Q
48 S AXDFN=$$FIND1^DIC(2,"","X",AXRQSSN,"SSN")
49 I 'AXDFN D FAIL("SSN not found in PATIENT file: "_AXRQSSN) Q
50 D PERSON(AXDFN) Q:AXABORT
51 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=AXPID("INFO")
52 D CHKSEGS Q:AXABORT
53 D OPENDEV Q:AXABORT
54 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
55 S AXSENSIT=+$P($G(^DGSL(38.1,AXDFN,0)),U,2)
56 Q
57GATHER ; Gather the requested data on the patient (it is sent to spool)
58 N AXDAYS,AXABBR,AXSEG,AXCHK
59 U IO
60 D @AXRQTYPE ; One of "TOTAL", "PHARM", "NHBP", or "BRIEF"
61 D CLOSDEV
62 Q
63TRANSFER ; Transfer the spool data to the temp global
64 D SPL2TMP^AFJXTRF
65 D DSDOC^ZISPL(AXSPDOC),DSD^ZISPL(AXSPDATA) ; Delete spool doc and data
66 Q
67FINISH ; Send the data and clean up.
68 S AXTI=$O(^TMP("AFJX",$J,""),-1)
69 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
70 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=$$CJ^XLFSTR("End of CONFIDENTIAL Patient Data from "_^XMB("NETNAME"),79,"*")
71 D SEND
72 K ^TMP("AFJX",$J)
73 I $G(AXSENSIT),'AXABORT D SENSIT
74 D AUDIT
75 Q
76SEND ; Send the data to the requestor
77 N XMZ,XMSUB,XMY,XMTEXT
78 S XMSUB="Reply for <"_AXRQTYPE_"> "_$E($P($G(AXPID("NAME"),"*UNKNOWN*"),",",1),1,15)_" "_AXRQSSN_" "_^XMB("NETNAME")
79 S XMY("NETWORK,HEALTH EXCHANGE@"_AXRQSITE)=""
80 S XMY("S.AFJXNHDONE@"_AXRQSITE)=""
81 S XMTEXT="^TMP(""AFJX"",$J,"
82 D ^XMD
83 Q
84PERSON(DFN) ; Get personal demographic info about the patient
85 N VA,VADM,VAERR
86 D DEM^VADPT
87 S AXPID("NAME")=VADM(1) ; Name - last,first
88 S AXPID("SSN")=$P(VADM(2),U) ; SSN - nnnnnnnnn
89 S AXPID("S-S-N")=VA("PID") ; SSN - nnn-nn-nnnn
90 S AXPID("DOB")=$$FMTE^XLFDT(+VADM(3),"5Z") ; Date of birth - mm/dd/yyyy
91 S AXPID("INFO")=$$LJ^XLFSTR(AXPID("NAME")_" "_AXPID("S-S-N"),55)_" DOB: "_AXPID("DOB")
92 Q
93OPENDEV ; Set IOP to a unique name to avoid duplicates
94 N AXSPDEV
95 S AXSPDEV=$$GET1^DIQ(142.99,"1,",.04)
96 I AXSPDEV']"" D FAIL("Can't get spool device name from file 142.99") Q
97 S (IOP,AXSPDEV)=AXSPDEV_";NHE"_AXDFN_"-"_$P($H,",",2)
98 S %ZIS=0
99 D ^%ZIS Q:'POP
100 D ^%ZISC
101 D FAIL("Can't open spool device: "_AXSPDEV)
102 Q
103CLOSDEV ; Close the spooler device and get device info
104 ; AXSPDOC = IEN in file 3.51 of the Spool Document
105 ; AXSPDATA = IEN in file 3.519 of the Spool Data
106 S AXSPDOC=IO("SPOOL")
107 D ^%ZISC
108 F Q:$$GET1^DIQ(3.51,AXSPDOC_",",2,"I")="r" H 5 ; Wait until "ready"
109 S AXSPDATA=$$GET1^DIQ(3.51,AXSPDOC_",",9,"I")
110 Q
111CHKSEGS ; Check to see if all components exist before proceeding
112 N AXSEG,AXABBR,AXCHK
113 S AXCHK=1
114 D @AXRQTYPE ; "TOTAL", "PHARM", "NHBP", or "BRIEF"
115 Q:'$D(AXCHK("NF"))
116 D FAIL("Can't find segment(s) in file 142.1: "_$E(AXCHK("NF"),2,999))
117 Q
118BRIEF ; MED12 - EXTRACT 12 MONTHS OF ALL SEGMENTS
119 S AXDAYS=365
120TOTAL ; EXTRACT ALL SEGMENTS WITH NO TIME LIMITATION
121 F AXABBR="DEM","ADC","DC","DS","PRC","OPC","CVF","CVP","ADR","DI","VS","PN","RXOP","RXIV","RXUD","BT","CH","MIC","SP","CY","MEDS","IP","IS","SR","CW","CN","DCS","ORC","CP","NSR","ONC" D EXTRACT
122 Q
123NHBP ; PHAR12 - EXTRACT 12 MONTHS OF PHARMACY INFORMATION
124 S AXDAYS=365
125PHARM ; EXTRACT THE WHOLE PHARMACY
126 F AXABBR="DEM","ADR","RXOP","RXIV","RXUD" D EXTRACT
127 Q
128EXTRACT ; Extract one component
129 S AXSEG=$$FIND1^DIC(142.1,"","OX",AXABBR,"C")
130 I $G(AXCHK) S:'AXSEG AXCHK("NF")=$G(AXCHK("NF"))_","_AXABBR Q
131 N DFN,GMTSEG,GMTSEGI,GMTSEGC,GMTSTITL,GMTSDLM,GMTSNDM
132 S DFN=AXDFN,GMTSDLM=$G(AXDAYS),GMTSTITL="NHE EXTRACT"
133 S GMTSEG(1)="1^"_AXSEG_"^^"_GMTSDLM_"^^N^L^Y"
134 S (GMTSEGI(AXSEG),GMTSEGC)=1
135 D EN^GMTS1
136 Q
137FAIL(AXERR) ; Note the error.
138 S AXABORT=1
139 S AXTI=$O(^TMP("AFJX",$J,""),-1)
140 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
141 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=$$CJ^XLFSTR(" PROBLEM REPORT ",79,"-")
142 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
143 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)="We couldn't process your NHE request, because of the following problem:"
144 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
145 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=AXERR
146 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
147 S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=$$REPEAT^XLFSTR("-",79)
148 Q
149SENSIT ; Data for sensitive patient was accessed,
150 ; so notify DG SENSITIVITY MAILGROUP
151 N XMZ,XMSUB,XMTEXT,XMY,AXTEXT,AXGRP,XMDUZ,AXNHEDUZ
152 S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
153 I 'AXNHEDUZ S AXNHEDUZ=.5
154 S AXTEXT(1)=$$REPEAT^XLFSTR("@",48)
155 S AXTEXT(2)=$$CJ^XLFSTR("SENSITIVE PATIENT DATA REQUESTED",48)
156 S AXTEXT(3)=$$REPEAT^XLFSTR("@",48)
157 S AXTEXT(4)=""
158 S AXTEXT(5)="Data for SENSITIVE patient: "_AXPID("NAME")_" "_AXRQSSN
159 S AXTEXT(6)="has been requested by: "_AXRQFROM
160 S AXGRP=$$GET1^DIQ(43,"1,",509)
161 I AXGRP'="" S XMY("G."_AXGRP)="" ;CFB/SF/TUSC MOD TO USE MAS PAT SENSIT MG.
162 S XMSUB="NETWORK HEALTH EXCHANGE REQUESTED FOR SENSITIVE PATIENT"
163 S XMY(AXNHEDUZ)=""
164 S XMTEXT="AXTEXT("
165 S XMDUZ=.5
166 D ^XMD
167 Q
168AUDIT ;
169 N AXSUCCES
170 S AXSUCCES=$S(AXABORT:"N",1:"Y")
171 I $D(^AFJ(537000,"B",AXRQXMZ)) D DUPLI Q
172 D NEW
173 Q
174DUPLI ; Look for the same message number to avoid duplicate tracking entries
175 N AXIEN
176 S AXIEN=""
177 F S AXIEN=$O(^AFJ(537000,"B",AXRQXMZ,AXIEN)) Q:AXIEN="" D
178 . N DIE,DA,DR
179 . S DIE="^AFJ(537000,"
180 . S DA=AXIEN
181 . S DR="9////"_AXSUCCES_";10////"_+$G(AXSENSIT)_";12////"_$$NOW^XLFDT
182 . D ^DIE
183 Q
184NEW ;
185 N DIC,X,Y,DLAYGO,DD,DO
186 S DIC="^AFJ(537000,",DLAYGO=537000
187 S DIC(0)="L"
188 S X=AXRQXMZ
189 S DIC("DR")="1////"_AXRQWHEN_";2////"_AXRQTYPE_";3////"_AXRQSSN_";6////"_AXRQDUZ_";7////"_AXRQNAME_";8////"_AXDOMIEN_";9////"_AXSUCCES_";10////"_+$G(AXSENSIT)_";12////"_$$NOW^XLFDT
190 D FILE^DICN
191 Q
Note: See TracBrowser for help on using the repository browser.