Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AFJXALRT

AFJXALRT.m

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