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

DVBAB1C.m

Go to the documentation of this file. 
  1. DVBAB1C ;ALB/AJF;CAPRI UTILITIES ; 10/13/21 8:02am
  1.  ;;2.7;AMIE;**193,227**;Apr 10, 1995;Build 21
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. MSG(RIEN) ;Generate mail message;AJF
  1.  ;
  1.  D GETREQ
  1.  D MGUSR
  1.  ;
  1.  S XMSUB="CAPRI: 2507 Exam Request Rejected"
  1.  S ^TMP($J,"AMIE1",1)="The 2507 Exam Request as described below has been rejected."
  1.  S ^TMP($J,"AMIE1",2)=""
  1.  S ^TMP($J,"AMIE1",3)=""
  1.  S ^TMP($J,"AMIE1",4)="                 DFN:  `"_DVBADFN
  1.  S ^TMP($J,"AMIE1",5)="          Requested Date: "_DVBADT
  1.  S ^TMP($J,"AMIE1",6)="          Requested Site: "_RTF
  1.  S ^TMP($J,"AMIE1",7)=""
  1.  S ^TMP($J,"AMIE1",8)="          Rerouted Date: "_RDT
  1.  S ^TMP($J,"AMIE1",9)="          Rerouted Site: "_RTO
  1.  S ^TMP($J,"AMIE1",10)=""
  1.  ;changes for patch 227 displaying reject date/reason
  1.  S ^TMP($J,"AMIE1",11)="         Rejected Date: "_RRRD
  1.  S ^TMP($J,"AMIE1",12)="         Rejected Reason: "_RRRJ
  1.  S ^TMP($J,"AMIE1",13)=""
  1.  S ^TMP($J,"AMIE1",14)=""
  1.  S ^TMP($J,"AMIE1",15)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI"
  1.  S ^TMP($J,"AMIE1",16)="Patient Selector 'Patient ID' field to find the patient. Be sure to include"
  1.  S ^TMP($J,"AMIE1",17)="the ` (backward-apostrophe) character."
  1.  S ^TMP($J,"AMIE1",18)=""
  1.  S ^TMP($J,"AMIE1",19)=""
  1.  S ^TMP($J,"AMIE1",20)=""
  1.  S ^TMP($J,"AMIE1",21)="*****This is an auto-generated email.  Do not respond to this email address.*****"
  1.  S XMTEXT="^TMP($J,""AMIE1"","
  1.  D ^XMD,END
  1.  Q
  1.  ;
  1.  ;
  1. AMSG(RIEN) ;Generate Acceptance Email
  1.  ;
  1.  D GETREQ
  1.  D MGUSR
  1.  ;
  1.  S XMSUB="CAPRI: 2507 Exam Request Accepted"
  1.  S ^TMP($J,"AMIE1",1)="The 2507 Exam Request as described below has been ACCEPTED."
  1.  S ^TMP($J,"AMIE1",2)=""
  1.  S ^TMP($J,"AMIE1",3)=""
  1.  S ^TMP($J,"AMIE1",4)="                 DFN:  `"_DVBADFN
  1.  S ^TMP($J,"AMIE1",5)="          Requested Date: "_DVBADT
  1.  S ^TMP($J,"AMIE1",6)="          Requested Site: "_RTF
  1.  S ^TMP($J,"AMIE1",7)=""
  1.  S ^TMP($J,"AMIE1",8)="          Rerouted Date: "_RDT
  1.  S ^TMP($J,"AMIE1",9)="          Rerouted Site: "_RTO
  1.  S ^TMP($J,"AMIE1",10)=""
  1.  S ^TMP($J,"AMIE1",11)=""
  1.  S ^TMP($J,"AMIE1",12)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI"
  1.  S ^TMP($J,"AMIE1",13)="Patient Selector 'Patient ID' field to find the patient. Be sure to include"
  1.  S ^TMP($J,"AMIE1",14)="the ` (backward-apostrophe) character."
  1.  S ^TMP($J,"AMIE1",15)=""
  1.  S ^TMP($J,"AMIE1",16)=""
  1.  S ^TMP($J,"AMIE1",17)=""
  1.  S ^TMP($J,"AMIE1",18)="*****This is an auto-generated email.  Do not respond to this email address.*****"
  1.  S XMTEXT="^TMP($J,""AMIE1"","
  1.  D ^XMD,END
  1.  Q
  1.  ;
  1. FINDEXAM(ZMSG,ZIEN) ;Returns list of exams in 396.4 that are linked to ZIEN in 396.3
  1.  N DVBABCNT,DVBABIEN
  1.  S DVBABCNT=0,DVBABIEN=0
  1.  F  S DVBABIEN=$O(^DVB(396.4,"C",ZIEN,DVBABIEN)) Q:'DVBABIEN  D
  1.  .S DVBABD1=$P($G(^DVB(396.4,DVBABIEN,0)),"^",2)
  1.  .S DVBABD2=$P($G(^DVB(396.6,+$P($G(^DVB(396.4,DVBABIEN,0)),"^",3),0)),"^",1)  ;Name of Exam
  1.  .S DVBABD3=$P($G(^DVB(396.4,DVBABIEN,0)),"^",4)
  1.  .I DVBABD3="O" S DVBABD3="[OPEN]"
  1.  .I DVBABD3="C" S DVBABD3="[COMPLETE]"
  1.  .I DVBABD3="X" S DVBABD3="[CANCELED BY MAS]"
  1.  .I DVBABD3="RX" S DVBABD3="[CANCELED BY RO]"
  1.  .I DVBABD3="T" S DVBABD3="[TRANSFERRED OUT]"
  1.  .I ZIEN=DVBABD1 D
  1.  ..S ZMSG(DVBABCNT)=DVBABIEN_"^"_DVBABD2_" "_DVBABD3
  1.  ..S DVBABCNT=DVBABCNT+1
  1.  K DVBABCNT,DVBABIEN,ZIEN,DVBABD1,DVBABD2,DVBABD3
  1.  Q
  1.  ;
  1.  ;
  1. SENDMSG(RIEN) ;SET UP TO SEND EMAIL/NOTIFICATION TO REQUESTOR OF 2507
  1.  D GETREQ
  1.  Q:DVBAEA=""
  1.  ;
  1. RDYMSG ;SEND REROUTED MESSAGE TO REQUESTOR OF 2507 
  1.  ;no text/body is passed in so we have to build the message from scratch
  1.  S XMSUB="CAPRI: 2507 Exam Request Rerouted"
  1.  S ^TMP($J,"AMIE1",1)="The 2507 Exam Request as described below has been rerouted."
  1.  S ^TMP($J,"AMIE1",2)=""
  1.  S ^TMP($J,"AMIE1",3)=""
  1.  S ^TMP($J,"AMIE1",4)="                 DFN:  `"_DVBADFN
  1.  S ^TMP($J,"AMIE1",5)="          Requested Date: "_DVBADT
  1.  S ^TMP($J,"AMIE1",6)="          Requested Site: "_RTF
  1.  S ^TMP($J,"AMIE1",7)="          Requested By: "_DVBNM
  1.  S ^TMP($J,"AMIE1",8)=""
  1.  S ^TMP($J,"AMIE1",9)="          Rerouted Date: "_RDT
  1.  S ^TMP($J,"AMIE1",10)="          Rerouted Site: "_RTO
  1.  S ^TMP($J,"AMIE1",11)=""
  1.  S ^TMP($J,"AMIE1",12)="         Reroute Reason: "_RRR
  1.  S ^TMP($J,"AMIE1",13)="         Reroute Description: "_RRD
  1.  S ^TMP($J,"AMIE1",14)=""
  1.  S ^TMP($J,"AMIE1",15)=""
  1.  S ^TMP($J,"AMIE1",16)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI"
  1.  S ^TMP($J,"AMIE1",17)="Patient Selector 'Patient ID' field to find the patient. Be sure to include"
  1.  S ^TMP($J,"AMIE1",18)="the ` (backward-apostrophe) character."
  1.  S ^TMP($J,"AMIE1",19)=""
  1.  S ^TMP($J,"AMIE1",20)=""
  1.  S ^TMP($J,"AMIE1",21)=""
  1.  S ^TMP($J,"AMIE1",22)="*****This is an auto-generated email.  Do not respond to this email address.*****"
  1.  S XMTEXT="^TMP($J,""AMIE1"","
  1.  D ^XMD,END
  1.  Q
  1.  ;
  1. GETREQ ; Get infor the RIEN
  1.  N DVBA0,DVBAREQ,DVBAC,DVBAQUIT,DUZ
  1.  N MSG,MERR,CTR
  1.  ;SINCE MAILMAN DOES NOT ALLOW MESSAGES TO BE SENT FROM USERS WITHOUT ACCESS CODES OR MAILBOXES
  1.  ;WHICH CAPRI REMOTE USER DO NOT HAVE, WE HAVE TO NEW DUZ AND CHANGE XMDUZ TO THE NAME OF THE USER
  1.  ;AS A STRING SO THE PROCESS IS STILL LINKED TO THE USER SENDING/TRIGGERING THE MESSAGE
  1.  S DVBA0=$G(^DVB(396.3,RIEN,0))
  1.  S DVBADFN=$P(DVBA0,"^",1),DVBAREQ=$P(DVBA0,"^",4)
  1.  ;S XMDUZ=$P(^VA(200,DVBAREQ,0),"^",1)_" CAPRI"
  1.  S XMDUZ="CAPRI "_$P(^VA(200,.5,0),"^",1)
  1.  S DVBADT=$$FMTE^XLFDT($P(DVBA0,"^",2))
  1.  ;following call supported by IA 3858
  1.  S DVBAEA=$P($G(^VA(200,DVBAREQ,.15)),"^",1)
  1.  S DVBNM=$P($G(^VA(200,DVBAREQ,0)),"^",1)
  1.  S J1=$O(^DVB(396.3,RIEN,6,99999),-1)
  1.  S J2=$O(^DVB(396.3,RIEN,6,J1,1,99999),-1)
  1.  S J10=^DVB(396.3,RIEN,6,J1,0),J20=^DVB(396.3,RIEN,6,J1,1,J2,0)
  1.  ;changes for patch 227 adding reject reason in reject message
  1.  S RRRJ=$G(^DVB(396.3,RIEN,6,J1,1,J2,1))
  1.  S:RRRJ="" RRRJ="None"
  1.  S RRR=$$EXTERNAL^DILFD(396.34,4,,$P(J10,"^",5))
  1.  S RRD=$P(J10,"^",6)
  1.  S:RRD="" RRD="None"
  1.  S RDT=$$EXTERNAL^DILFD(396.34,.01,,$P(J10,"^",1))
  1.  S RTO=$$EXTERNAL^DILFD(396.34,.02,,$P(J10,"^",7))
  1.  S RTF=$$EXTERNAL^DILFD(396.34,3,,$P(J10,"^",4))
  1.  S RRRD=$$EXTERNAL^DILFD(396.341,.01,,$P(J20,"^",1))
  1.  I DVBAEA="" Q
  1.  S XMY(DVBAEA)="",DVBASITE=$$SITE^VASITE
  1.  K J1,J10,J2,J20
  1.  ;
  1.  Q
  1.  ;
  1. MGUSR ; set email addresses from mail group
  1.  ;  Supported References:                                               
  1.  ;     DBIA #10111: Allows FM read access of ^XMB(3.8,D0,0) using DIC.
  1.  ;
  1.  N MGN,XMB,DIC,MMG,MDIEN,DVEM,MMUS,ERR
  1.  S MGN="DVBA C 2507 REROUTE",XMB="DVBA CAPRI REROUTE"
  1.  S XMDUZ="CAPRI "_$P(^VA(200,.5,0),"^",1)
  1.  S DIC="^XMB(3.8,",DIC(0)="QM",X=MGN D ^DIC
  1.  I +Y<0 S ERR="INVALID MAIL GROUP NAME" Q
  1.  S MDIEN=+Y,MMG=0
  1.  I '$$GOTLOCAL^XMXAPIG(MGN) S ERR="NO ACTIVE LOCAL MEMBERS IN MAIL GROUP" K ^TMP("XMERR",$J) Q
  1.  F  S MMG=$O(^XMB(3.8,MDIEN,1,MMG)) Q:MMG="B"  D
  1.  .S MMUS=$P($G(^XMB(3.8,MDIEN,1,MMG,0)),"^",1)
  1.  .S DVEM=$P($G(^VA(200,MMUS,.15)),"^",1)
  1.  .Q:DVEM=""
  1.  .S XMY(DVEM)=""
  1.  Q
  1.  ;
  1. END ;
  1.  K RDT,RRD,RRR,RRRJ,RTF,RTO,X,XMY,XMSUB,XMTEXT,MGN,DIC,DIC(0),J,Y,XMDUZ,XMB,ERR,RRRD
  1.  K ^TMP($J,"AMIE1"),DVBADFN,DVBASITE,DVBADT,DVBAEA,DVBNM
  1.  Q