AFJXALRT ;FO-OAKLAND/GMB-PROCESS INFO AND ALERT USER ;3/17/99 13:42
;;5.1;Network Health Exchange;**6,15,17,23,31,32**;Jan 23, 1996
; Totally rewritten 11/2001. (Previously FJ/CWS.)
; ENTER - Invoked by server option AFJXSERVER
;
; DBIAs:
; 1092 - Call DSD^ZISPL and DSDOC^ZISPL1 (Kernel)
; 3587 - Read fields 2 and 9 of file 3.51 (Kernel)
; 3774 - Read field .04 of file 142.99 (Health Summary)
; 3779 - Search file 4.2, read field 1 (MailMan)
ENTER ;
N XMZ,XMSER
D:'$$CLOSED(XQSND) PROCESS(XQMSG) ; Ignore if sending site is closed.
S XMSER="S.AFJXSERVER",XMZ=XQMSG D REMSBMSG^XMA1C
Q
CLOSED(AXFROM) ; Returns 1 if sending site is closed; 0 otherwise.
I AXFROM'["@" Q 0
N AXDOMIEN
S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",$P($P(AXFROM,"@",2),">",1),"B^C")
Q:'AXDOMIEN 0
Q $$GET1^DIQ(4.2,AXDOMIEN_",",1)["C"
PROCESS(AXRQXMZ) ; Process data incoming
N AXPID,AXSENSIT,AXDFN,AXDOMIEN,AXABORT,AXSPDOC,AXSPDATA,AXTI
N AXRQREC,AXRQSSN,AXRQDUZ,AXRQNAME,AXRQWHEN,AXRQSITE,AXRQTYPE,AXRQFROM
D INIT
I 'AXABORT D
. D GATHER
. D TRANSFER
D FINISH
Q
INIT ;
S (AXABORT,AXTI)=0
K ^TMP("AFJX",$J)
D ^%ZISC ; Make sure all devices are closed
S AXRQREC=$G(^XMB(3.9,AXRQXMZ,2,1,0))
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=AXRQREC
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)="***CONFIDENTIAL Patient Data from "_^XMB("NETNAME")_"*** "_$$FMTE^XLFDT(DT,"2Z")
S AXRQSSN=$P(AXRQREC,U,1) ; Patient SSN
S AXRQDUZ=$P(AXRQREC,U,2) ; Requestor's DUZ
S AXRQNAME=$P(AXRQREC,U,3) ; Requestor's name
S AXRQWHEN=$P(AXRQREC,U,4) ; Date/Time request was made
S AXRQSITE=$P(AXRQREC,U,5) ; Requestor's site
S AXRQTYPE=$P(AXRQREC,U,6) ; Type of request
S AXRQFROM=AXRQNAME_"@"_AXRQSITE
S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXRQSITE,"B^C")
I 'AXDOMIEN D FAIL("Site not found in DOMAIN file: "_AXRQSITE) Q
I 'AXRQSSN D FAIL("SSN not supplied.") Q
S AXDFN=$$FIND1^DIC(2,"","X",AXRQSSN,"SSN")
I 'AXDFN D FAIL("SSN not found in PATIENT file: "_AXRQSSN) Q
D PERSON(AXDFN) Q:AXABORT
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=AXPID("INFO")
D CHKSEGS Q:AXABORT
D OPENDEV Q:AXABORT
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
S AXSENSIT=+$P($G(^DGSL(38.1,AXDFN,0)),U,2)
Q
GATHER ; Gather the requested data on the patient (it is sent to spool)
N AXDAYS,AXABBR,AXSEG,AXCHK
U IO
D @AXRQTYPE ; One of "TOTAL", "PHARM", "NHBP", or "BRIEF"
D CLOSDEV
Q
TRANSFER ; Transfer the spool data to the temp global
D SPL2TMP^AFJXTRF
D DSDOC^ZISPL(AXSPDOC),DSD^ZISPL(AXSPDATA) ; Delete spool doc and data
Q
FINISH ; Send the data and clean up.
S AXTI=$O(^TMP("AFJX",$J,""),-1)
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=$$CJ^XLFSTR("End of CONFIDENTIAL Patient Data from "_^XMB("NETNAME"),79,"*")
D SEND
K ^TMP("AFJX",$J)
I $G(AXSENSIT),'AXABORT D SENSIT
D AUDIT
Q
SEND ; Send the data to the requestor
N XMZ,XMSUB,XMY,XMTEXT
S XMSUB="Reply for <"_AXRQTYPE_"> "_$E($P($G(AXPID("NAME"),"*UNKNOWN*"),",",1),1,15)_" "_AXRQSSN_" "_^XMB("NETNAME")
S XMY("NETWORK,HEALTH EXCHANGE@"_AXRQSITE)=""
S XMY("S.AFJXNHDONE@"_AXRQSITE)=""
S XMTEXT="^TMP(""AFJX"",$J,"
D ^XMD
Q
PERSON(DFN) ; Get personal demographic info about the patient
N VA,VADM,VAERR
D DEM^VADPT
S AXPID("NAME")=VADM(1) ; Name - last,first
S AXPID("SSN")=$P(VADM(2),U) ; SSN - nnnnnnnnn
S AXPID("S-S-N")=VA("PID") ; SSN - nnn-nn-nnnn
S AXPID("DOB")=$$FMTE^XLFDT(+VADM(3),"5Z") ; Date of birth - mm/dd/yyyy
S AXPID("INFO")=$$LJ^XLFSTR(AXPID("NAME")_" "_AXPID("S-S-N"),55)_" DOB: "_AXPID("DOB")
Q
OPENDEV ; Set IOP to a unique name to avoid duplicates
N AXSPDEV
S AXSPDEV=$$GET1^DIQ(142.99,"1,",.04)
I AXSPDEV']"" D FAIL("Can't get spool device name from file 142.99") Q
S (IOP,AXSPDEV)=AXSPDEV_";NHE"_AXDFN_"-"_$P($H,",",2)
S %ZIS=0
D ^%ZIS Q:'POP
D ^%ZISC
D FAIL("Can't open spool device: "_AXSPDEV)
Q
CLOSDEV ; Close the spooler device and get device info
; AXSPDOC = IEN in file 3.51 of the Spool Document
; AXSPDATA = IEN in file 3.519 of the Spool Data
S AXSPDOC=IO("SPOOL")
D ^%ZISC
F Q:$$GET1^DIQ(3.51,AXSPDOC_",",2,"I")="r" H 5 ; Wait until "ready"
S AXSPDATA=$$GET1^DIQ(3.51,AXSPDOC_",",9,"I")
Q
CHKSEGS ; Check to see if all components exist before proceeding
N AXSEG,AXABBR,AXCHK
S AXCHK=1
D @AXRQTYPE ; "TOTAL", "PHARM", "NHBP", or "BRIEF"
Q:'$D(AXCHK("NF"))
D FAIL("Can't find segment(s) in file 142.1: "_$E(AXCHK("NF"),2,999))
Q
BRIEF ; MED12 - EXTRACT 12 MONTHS OF ALL SEGMENTS
S AXDAYS=365
TOTAL ; EXTRACT ALL SEGMENTS WITH NO TIME LIMITATION
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
Q
NHBP ; PHAR12 - EXTRACT 12 MONTHS OF PHARMACY INFORMATION
S AXDAYS=365
PHARM ; EXTRACT THE WHOLE PHARMACY
F AXABBR="DEM","ADR","RXOP","RXIV","RXUD" D EXTRACT
Q
S AXSEG=$$FIND1^DIC(142.1,"","OX",AXABBR,"C")
I $G(AXCHK) S:'AXSEG AXCHK("NF")=$G(AXCHK("NF"))_","_AXABBR Q
N DFN,GMTSEG,GMTSEGI,GMTSEGC,GMTSTITL,GMTSDLM,GMTSNDM
S DFN=AXDFN,GMTSDLM=$G(AXDAYS),GMTSTITL="NHE EXTRACT"
S GMTSEG(1)="1^"_AXSEG_"^^"_GMTSDLM_"^^N^L^Y"
S (GMTSEGI(AXSEG),GMTSEGC)=1
D EN^GMTS1
Q
FAIL(AXERR) ; Note the error.
S AXABORT=1
S AXTI=$O(^TMP("AFJX",$J,""),-1)
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=$$CJ^XLFSTR(" PROBLEM REPORT ",79,"-")
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)="We couldn't process your NHE request, because of the following problem:"
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=AXERR
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=""
S AXTI=AXTI+1,^TMP("AFJX",$J,AXTI,0)=$$REPEAT^XLFSTR("-",79)
Q
SENSIT ; Data for sensitive patient was accessed,
; so notify DG SENSITIVITY MAILGROUP
N XMZ,XMSUB,XMTEXT,XMY,AXTEXT,AXGRP,XMDUZ,AXNHEDUZ
S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
I 'AXNHEDUZ S AXNHEDUZ=.5
S AXTEXT(1)=$$REPEAT^XLFSTR("@",48)
S AXTEXT(2)=$$CJ^XLFSTR("SENSITIVE PATIENT DATA REQUESTED",48)
S AXTEXT(3)=$$REPEAT^XLFSTR("@",48)
S AXTEXT(4)=""
S AXTEXT(5)="Data for SENSITIVE patient: "_AXPID("NAME")_" "_AXRQSSN
S AXTEXT(6)="has been requested by: "_AXRQFROM
S AXGRP=$$GET1^DIQ(43,"1,",509)
I AXGRP'="" S XMY("G."_AXGRP)="" ;CFB/SF/TUSC MOD TO USE MAS PAT SENSIT MG.
S XMSUB="NETWORK HEALTH EXCHANGE REQUESTED FOR SENSITIVE PATIENT"
S XMY(AXNHEDUZ)=""
S XMTEXT="AXTEXT("
S XMDUZ=.5
D ^XMD
Q
AUDIT ;
N AXSUCCES
S AXSUCCES=$S(AXABORT:"N",1:"Y")
I $D(^AFJ(537000,"B",AXRQXMZ)) D DUPLI Q
D NEW
Q
DUPLI ; Look for the same message number to avoid duplicate tracking entries
N AXIEN
S AXIEN=""
F S AXIEN=$O(^AFJ(537000,"B",AXRQXMZ,AXIEN)) Q:AXIEN="" D
. N DIE,DA,DR
. S DIE="^AFJ(537000,"
. S DA=AXIEN
. S DR="9////"_AXSUCCES_";10////"_+$G(AXSENSIT)_";12////"_$$NOW^XLFDT
. D ^DIE
Q
NEW ;
N DIC,X,Y,DLAYGO,DD,DO
S DIC="^AFJ(537000,",DLAYGO=537000
S DIC(0)="L"
S X=AXRQXMZ
S DIC("DR")="1////"_AXRQWHEN_";2////"_AXRQTYPE_";3////"_AXRQSSN_";6////"_AXRQDUZ_";7////"_AXRQNAME_";8////"_AXDOMIEN_";9////"_AXSUCCES_";10////"_+$G(AXSENSIT)_";12////"_$$NOW^XLFDT
D FILE^DICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAFJXALRT 7365 printed Dec 13, 2024@02:17:43 Page 2
AFJXALRT ;FO-OAKLAND/GMB-PROCESS INFO AND ALERT USER ;3/17/99 13:42
+1 ;;5.1;Network Health Exchange;**6,15,17,23,31,32**;Jan 23, 1996
+2 ; Totally rewritten 11/2001. (Previously FJ/CWS.)
+3 ; ENTER - Invoked by server option AFJXSERVER
+4 ;
+5 ; DBIAs:
+6 ; 1092 - Call DSD^ZISPL and DSDOC^ZISPL1 (Kernel)
+7 ; 3587 - Read fields 2 and 9 of file 3.51 (Kernel)
+8 ; 3774 - Read field .04 of file 142.99 (Health Summary)
+9 ; 3779 - Search file 4.2, read field 1 (MailMan)
ENTER ;
+1 NEW XMZ,XMSER
+2 ; Ignore if sending site is closed.
if '$$CLOSED(XQSND)
DO PROCESS(XQMSG)
+3 SET XMSER="S.AFJXSERVER"
SET XMZ=XQMSG
DO REMSBMSG^XMA1C
+4 QUIT
CLOSED(AXFROM) ; Returns 1 if sending site is closed; 0 otherwise.
+1 IF AXFROM'["@"
QUIT 0
+2 NEW AXDOMIEN
+3 SET AXDOMIEN=$$FIND1^DIC(4.2,"","MX",$PIECE($PIECE(AXFROM,"@",2),">",1),"B^C")
+4 if 'AXDOMIEN
QUIT 0
+5 QUIT $$GET1^DIQ(4.2,AXDOMIEN_",",1)["C"
PROCESS(AXRQXMZ) ; Process data incoming
+1 NEW AXPID,AXSENSIT,AXDFN,AXDOMIEN,AXABORT,AXSPDOC,AXSPDATA,AXTI
+2 NEW AXRQREC,AXRQSSN,AXRQDUZ,AXRQNAME,AXRQWHEN,AXRQSITE,AXRQTYPE,AXRQFROM
+3 DO INIT
+4 IF 'AXABORT
Begin DoDot:1
+5 DO GATHER
+6 DO TRANSFER
End DoDot:1
+7 DO FINISH
+8 QUIT
INIT ;
+1 SET (AXABORT,AXTI)=0
+2 KILL ^TMP("AFJX",$JOB)
+3 ; Make sure all devices are closed
DO ^%ZISC
+4 SET AXRQREC=$GET(^XMB(3.9,AXRQXMZ,2,1,0))
+5 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=AXRQREC
+6 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)="***CONFIDENTIAL Patient Data from "_^XMB("NETNAME")_"*** "_$$FMTE^XLFDT(DT,"2Z")
+7 ; Patient SSN
SET AXRQSSN=$PIECE(AXRQREC,U,1)
+8 ; Requestor's DUZ
SET AXRQDUZ=$PIECE(AXRQREC,U,2)
+9 ; Requestor's name
SET AXRQNAME=$PIECE(AXRQREC,U,3)
+10 ; Date/Time request was made
SET AXRQWHEN=$PIECE(AXRQREC,U,4)
+11 ; Requestor's site
SET AXRQSITE=$PIECE(AXRQREC,U,5)
+12 ; Type of request
SET AXRQTYPE=$PIECE(AXRQREC,U,6)
+13 SET AXRQFROM=AXRQNAME_"@"_AXRQSITE
+14 SET AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXRQSITE,"B^C")
+15 IF 'AXDOMIEN
DO FAIL("Site not found in DOMAIN file: "_AXRQSITE)
QUIT
+16 IF 'AXRQSSN
DO FAIL("SSN not supplied.")
QUIT
+17 SET AXDFN=$$FIND1^DIC(2,"","X",AXRQSSN,"SSN")
+18 IF 'AXDFN
DO FAIL("SSN not found in PATIENT file: "_AXRQSSN)
QUIT
+19 DO PERSON(AXDFN)
if AXABORT
QUIT
+20 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=AXPID("INFO")
+21 DO CHKSEGS
if AXABORT
QUIT
+22 DO OPENDEV
if AXABORT
QUIT
+23 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=""
+24 SET AXSENSIT=+$PIECE($GET(^DGSL(38.1,AXDFN,0)),U,2)
+25 QUIT
GATHER ; Gather the requested data on the patient (it is sent to spool)
+1 NEW AXDAYS,AXABBR,AXSEG,AXCHK
+2 USE IO
+3 ; One of "TOTAL", "PHARM", "NHBP", or "BRIEF"
DO @AXRQTYPE
+4 DO CLOSDEV
+5 QUIT
TRANSFER ; Transfer the spool data to the temp global
+1 DO SPL2TMP^AFJXTRF
+2 ; Delete spool doc and data
DO DSDOC^ZISPL(AXSPDOC)
DO DSD^ZISPL(AXSPDATA)
+3 QUIT
FINISH ; Send the data and clean up.
+1 SET AXTI=$ORDER(^TMP("AFJX",$JOB,""),-1)
+2 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=""
+3 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=$$CJ^XLFSTR("End of CONFIDENTIAL Patient Data from "_^XMB("NETNAME"),79,"*")
+4 DO SEND
+5 KILL ^TMP("AFJX",$JOB)
+6 IF $GET(AXSENSIT)
IF 'AXABORT
DO SENSIT
+7 DO AUDIT
+8 QUIT
SEND ; Send the data to the requestor
+1 NEW XMZ,XMSUB,XMY,XMTEXT
+2 SET XMSUB="Reply for <"_AXRQTYPE_"> "_$EXTRACT($PIECE($GET(AXPID("NAME"),"*UNKNOWN*"),",",1),1,15)_" "_AXRQSSN_" "_^XMB("NETNAME")
+3 SET XMY("NETWORK,HEALTH EXCHANGE@"_AXRQSITE)=""
+4 SET XMY("S.AFJXNHDONE@"_AXRQSITE)=""
+5 SET XMTEXT="^TMP(""AFJX"",$J,"
+6 DO ^XMD
+7 QUIT
PERSON(DFN) ; Get personal demographic info about the patient
+1 NEW VA,VADM,VAERR
+2 DO DEM^VADPT
+3 ; Name - last,first
SET AXPID("NAME")=VADM(1)
+4 ; SSN - nnnnnnnnn
SET AXPID("SSN")=$PIECE(VADM(2),U)
+5 ; SSN - nnn-nn-nnnn
SET AXPID("S-S-N")=VA("PID")
+6 ; Date of birth - mm/dd/yyyy
SET AXPID("DOB")=$$FMTE^XLFDT(+VADM(3),"5Z")
+7 SET AXPID("INFO")=$$LJ^XLFSTR(AXPID("NAME")_" "_AXPID("S-S-N"),55)_" DOB: "_AXPID("DOB")
+8 QUIT
OPENDEV ; Set IOP to a unique name to avoid duplicates
+1 NEW AXSPDEV
+2 SET AXSPDEV=$$GET1^DIQ(142.99,"1,",.04)
+3 IF AXSPDEV']""
DO FAIL("Can't get spool device name from file 142.99")
QUIT
+4 SET (IOP,AXSPDEV)=AXSPDEV_";NHE"_AXDFN_"-"_$PIECE($HOROLOG,",",2)
+5 SET %ZIS=0
+6 DO ^%ZIS
if 'POP
QUIT
+7 DO ^%ZISC
+8 DO FAIL("Can't open spool device: "_AXSPDEV)
+9 QUIT
CLOSDEV ; Close the spooler device and get device info
+1 ; AXSPDOC = IEN in file 3.51 of the Spool Document
+2 ; AXSPDATA = IEN in file 3.519 of the Spool Data
+3 SET AXSPDOC=IO("SPOOL")
+4 DO ^%ZISC
+5 ; Wait until "ready"
FOR
if $$GET1^DIQ(3.51,AXSPDOC_",",2,"I")="r"
QUIT
HANG 5
+6 SET AXSPDATA=$$GET1^DIQ(3.51,AXSPDOC_",",9,"I")
+7 QUIT
CHKSEGS ; Check to see if all components exist before proceeding
+1 NEW AXSEG,AXABBR,AXCHK
+2 SET AXCHK=1
+3 ; "TOTAL", "PHARM", "NHBP", or "BRIEF"
DO @AXRQTYPE
+4 if '$DATA(AXCHK("NF"))
QUIT
+5 DO FAIL("Can't find segment(s) in file 142.1: "_$EXTRACT(AXCHK("NF"),2,999))
+6 QUIT
BRIEF ; MED12 - EXTRACT 12 MONTHS OF ALL SEGMENTS
+1 SET AXDAYS=365
TOTAL ; EXTRACT ALL SEGMENTS WITH NO TIME LIMITATION
+1 FOR 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"
DO EXTRACT
+2 QUIT
NHBP ; PHAR12 - EXTRACT 12 MONTHS OF PHARMACY INFORMATION
+1 SET AXDAYS=365
PHARM ; EXTRACT THE WHOLE PHARMACY
+1 FOR AXABBR="DEM","ADR","RXOP","RXIV","RXUD"
DO EXTRACT
+2 QUIT
+1 SET AXSEG=$$FIND1^DIC(142.1,"","OX",AXABBR,"C")
+2 IF $GET(AXCHK)
if 'AXSEG
SET AXCHK("NF")=$GET(AXCHK("NF"))_","_AXABBR
QUIT
+3 NEW DFN,GMTSEG,GMTSEGI,GMTSEGC,GMTSTITL,GMTSDLM,GMTSNDM
+4 SET DFN=AXDFN
SET GMTSDLM=$GET(AXDAYS)
SET GMTSTITL="NHE EXTRACT"
+5 SET GMTSEG(1)="1^"_AXSEG_"^^"_GMTSDLM_"^^N^L^Y"
+6 SET (GMTSEGI(AXSEG),GMTSEGC)=1
+7 DO EN^GMTS1
+8 QUIT
FAIL(AXERR) ; Note the error.
+1 SET AXABORT=1
+2 SET AXTI=$ORDER(^TMP("AFJX",$JOB,""),-1)
+3 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=""
+4 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=$$CJ^XLFSTR(" PROBLEM REPORT ",79,"-")
+5 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=""
+6 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)="We couldn't process your NHE request, because of the following problem:"
+7 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=""
+8 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=AXERR
+9 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=""
+10 SET AXTI=AXTI+1
SET ^TMP("AFJX",$JOB,AXTI,0)=$$REPEAT^XLFSTR("-",79)
+11 QUIT
SENSIT ; Data for sensitive patient was accessed,
+1 ; so notify DG SENSITIVITY MAILGROUP
+2 NEW XMZ,XMSUB,XMTEXT,XMY,AXTEXT,AXGRP,XMDUZ,AXNHEDUZ
+3 SET AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
+4 IF 'AXNHEDUZ
SET AXNHEDUZ=.5
+5 SET AXTEXT(1)=$$REPEAT^XLFSTR("@",48)
+6 SET AXTEXT(2)=$$CJ^XLFSTR("SENSITIVE PATIENT DATA REQUESTED",48)
+7 SET AXTEXT(3)=$$REPEAT^XLFSTR("@",48)
+8 SET AXTEXT(4)=""
+9 SET AXTEXT(5)="Data for SENSITIVE patient: "_AXPID("NAME")_" "_AXRQSSN
+10 SET AXTEXT(6)="has been requested by: "_AXRQFROM
+11 SET AXGRP=$$GET1^DIQ(43,"1,",509)
+12 ;CFB/SF/TUSC MOD TO USE MAS PAT SENSIT MG.
IF AXGRP'=""
SET XMY("G."_AXGRP)=""
+13 SET XMSUB="NETWORK HEALTH EXCHANGE REQUESTED FOR SENSITIVE PATIENT"
+14 SET XMY(AXNHEDUZ)=""
+15 SET XMTEXT="AXTEXT("
+16 SET XMDUZ=.5
+17 DO ^XMD
+18 QUIT
AUDIT ;
+1 NEW AXSUCCES
+2 SET AXSUCCES=$SELECT(AXABORT:"N",1:"Y")
+3 IF $DATA(^AFJ(537000,"B",AXRQXMZ))
DO DUPLI
QUIT
+4 DO NEW
+5 QUIT
DUPLI ; Look for the same message number to avoid duplicate tracking entries
+1 NEW AXIEN
+2 SET AXIEN=""
+3 FOR
SET AXIEN=$ORDER(^AFJ(537000,"B",AXRQXMZ,AXIEN))
if AXIEN=""
QUIT
Begin DoDot:1
+4 NEW DIE,DA,DR
+5 SET DIE="^AFJ(537000,"
+6 SET DA=AXIEN
+7 SET DR="9////"_AXSUCCES_";10////"_+$GET(AXSENSIT)_";12////"_$$NOW^XLFDT
+8 DO ^DIE
End DoDot:1
+9 QUIT
NEW ;
+1 NEW DIC,X,Y,DLAYGO,DD,DO
+2 SET DIC="^AFJ(537000,"
SET DLAYGO=537000
+3 SET DIC(0)="L"
+4 SET X=AXRQXMZ
+5 SET DIC("DR")="1////"_AXRQWHEN_";2////"_AXRQTYPE_";3////"_AXRQSSN_";6////"_AXRQDUZ_";7////"_AXRQNAME_";8////"_AXDOMIEN_";9////"_AXSUCCES_";10////"_+$GET(AXSENSIT)_";12////"_$$NOW^XLFDT
+6 DO FILE^DICN
+7 QUIT
