DVBAB1A ;ALB/GAK - CAPRI Exam Complete Email Driver ; 03/13/2013 11:23 AM
 ;;2.7;AMIE;**185,187,189**;Apr 10, 1995;Build 22
 ;
 
Q
 

MSG2(ERR,DUZ,RIEN,ELIST) ;
 ;
 ;DUZ     PERSON FILE DFN
 ;RIEN    2507 REQUEST IEN #396.3
 ;ELIST   2507 EXAM LIST #396.4
 ;
 
DVBOPEN,DVBOPENS,DVBOPENC,J
 
PNAM,PSSN,CNUM,ERR3,ERR2,ERR4,RTN,RTN2,XX
 
;N POE
 
MSG1,MERR1,CTR1
 
MSG2,MERR2,CTR2
 
CLMTYP
 
EIEN,EARY,EERR,ENAM,ESTA
 
XMTEXT,L,XMSUB,XMY
 
MSG,MERR
 
;
 
ERR=""
 
DUZ="" ERR="NO DUZ PASSED" ERR
 
RIEN="" ERR="NO REQUEST IEN PASSED" ERR
 
I $D(ELIST)'>1 ERR="NO EXAM LIST PASSED" ERR
 
;
 
^TMP($J,"DVBAB1A")
 
^TMP($J,"AMIE")
 
^TMP($J,"AMIE1")
 
;
 
J=""
 
F  S J=$O(ELIST(J)) Q:J=""  D
 
^TMP($J,"DVBAB1A","ELIST",J)=J
 
;
 ;Determine and count number of open exams on 2507 request
 
DVBOPEN=""
 
DVBOPENS=0,DVBOPENC=0
 
FINDEXAM^DVBAB1(.DVBOPEN,RIEN)
 
J="" F  S J=$O(DVBOPEN(J)) Q:J=""  D
 
I $E(DVBOPEN(J),($L(DVBOPEN(J))-5),$L(DVBOPEN(J)))="[OPEN]" DVBOPENS=1,DVBOPENC=DVBOPENC+1
 
;
 ;Determine patient name, SSN and C-Number
 
(PNAM,PSSN,CNUM,ERR3,ERR2,RTN,RTN2,XX)=""
 
RTN,ERR3
 
GETS^DIQ(396.3,RIEN,".01","I","RTN","ERR3")
 
I $D(RTND
 
XX=""_".01;.09;.313"_""
 
RTN2,ERR2
 
GETS^DIQ(2,RTN(396.3,RIEN_",",.01,"I"),XX,"E","RTN2","ERR2")
 . 
PNAM=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.01,"E"))
 . 
PSSN=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.09,"E"))
 . 
CNUM=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.313,"E"))
 
S:'$D(PNAMPNAM=""
 
S:'$D(PSSNPSSN=""
 
S:'$D(CNUMCNUM=""
 ;
 ;Build Exam Array Info
 
^TMP($J,"DVBAB1A","ELIST")
 
J=""
 
F  S J=$O(ELIST(J)) Q:J=""  D
 
EIEN=ELIST(J)
 . 
EARY,EERR
 
GETS^DIQ(396.4,EIEN,".03;.04","IE","EARY","EERR")
 . 
Q:'$D(EARY(396.4,EIEN_",",.03,"E"))
 . 
ENAM=$G(EARY(396.4,EIEN_",",.03,"E"))
 . 
ESTA=$G(EARY(396.4,EIEN_",",.04,"E"))
 . 
^TMP($J,"DVBAB1A","ELIST",J)=ENAM_$E("                                   ",1,35-$L(ENAM))_" "_ESTA
 
;
 ;Determine Priority of Exam
 ;K ERR4
 ;S POE=$$GET1^DIQ(396.3,RIEN_",",9,"E","","ERR4")
 ;I '$D(POE) S POE=""
 ;
 ;Build Claim Type Info
 
MSG1,MERR1,CTR1
 
^TMP($J,"DVBAB1A","CT")
 
MSG1="",MERR1="",CTR1=1
 
GETS^DIQ(396.3,RIEN_",","9.1*","E","MSG1","MERR1")
 
I $G(MERR1)'="" ^TMP($J,"DVBAB1A","CT",CTR1)="ERROR GETTING CLAIM TYPE CODES"
 
J=""
 
F  S J=$O(MSG1(396.32,J)) Q:J=""  D
 
CTR1=CTR1+1
 . 
^TMP($J,"DVBAB1A","CT",CTR1)=$G(MSG1(396.32,J,.01,"E"))
 
;
 ;Build Special Considerations Info
 
MSG2,MERR2,CTR2
 
^TMP($J,"DVBAB1A","SC")
 
MSG2="",MERR2="",CTR2=1
 
GETS^DIQ(396.3,RIEN,"50*","IE","MSG2","MERR2")
 
I $G(MERR2)'="" ^TMP($J,"DVBAB1A","SC",CTR2)="ERROR GETTING SPECIAL CONSIDERATION CODES"
 
J=""
 
F  S J=$O(MSG2(396.31,J)) Q:J=""  D
 
CTR2=CTR2+1
 . 
^TMP($J,"DVBAB1A","SC",CTR2)=$G(MSG2(396.31,J,.01,"E"))
 
;
 ;
 
ONEEMAIL
 
;
 
^TMP($J,"DVBAB1A","ELIST")
 
^TMP($J,"DVBAB1A","CT")
 
^TMP($J,"DVBAB1A","SC")
 
^TMP($J,"AMIE")
 
^TMP($J,"AMIE1")
 
I $D(ERRERR
 
;
 
Q
 
;
 ;
 ;
ONEEMAIL ;
 
ERR
 
DVBA0,DVBADFN,DVBASITE,DVBADT,DVBAREQ,DVBAEA
 
XMDUZ=DUZ
 
;following call supported by IA 3858
 
DUZ
 
;SINCE MAILMAN DOES NOT ALLOW MESSAGES TO BE SENT FROM USERS WITHOUT ACCESS CODES OR MAILBOXES
 ;WHICH CAPRI REMOTE USER DO NOT HAVE, WE HAVE TO NEW DUZ AND CHANGE XMDUZ TO THE NAME OF THE USER
 ;AS A STRING SO THE PROCESS IS STILL LINKED TO THE USER SENDING/TRIGGERING THE MESSAGE
 ;
 
XMDUZ=$P($G(^VA(200,XMDUZ,0)),"^",1)_" CAPRI"
 
I $G(^DVB(396.3,RIEN,0))="" ERR="INVALID REQUEST 396.3 TOP NODE" Q
 S 
DVBA0=$G(^DVB(396.3,RIEN,0))
 
DVBADFN=$P(DVBA0,"^",1),DVBAREQ=$P(DVBA0,"^",4),DVBADT=$$FMTE^XLFDT($P(DVBA0,"^",2))
 
;following call supported by IA 3858
 ;rra 938270 make sure email address exists prior to attempting to send notification
 
DVBAEA=$P($G(^VA(200,DVBAREQ,.15)),"^",1)
 
DVBAEA="" Q
 S 
XMY(DVBAEA)=""
 ;
 
DVBASITE=$$SITE^VASITE
 
'$D(DVBASITEDVBASITE="^"
 ;
 
XMSUB="CAPRI: Completion of 2507 Exams"
 ;
 
L=0
 
L=L+1
 
^TMP($J,"AMIE",L)="The following veteran had one or more 2507 exams completed.",L=L+1
 
DVBOPENS=0 ^TMP($J,"AMIE",L)="A 2507 request as described below has been completed and released to the regional office and is now available in CAPRI.",L=L+1
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
^TMP($J,"AMIE",L)="DFN: `"_DVBADFN_"       SITE: "_$P($G(DVBASITE),"^",2)_"       Request Date: "_DVBADT
 
L=L+1
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
;
 
^TMP($J,"AMIE",L)="  Special Consideration(s):",L=L+1
 
J=""
 
F  S J=$O(^TMP($J,"DVBAB1A","SC",J)) Q:J=""  D
 
^TMP($J,"AMIE",L)="    "_^TMP($J,"DVBAB1A","SC",J),L=L+1
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
;
 ;S ^TMP($J,"AMIE",L)="  Priority of Exam: "_POE,L=L+1
 ;S ^TMP($J,"AMIE",L)=" ",L=L+1
 ;
 
^TMP($J,"AMIE",L)="  Claim Type:",L=L+1
 
J=""
 
F  S J=$O(^TMP($J,"DVBAB1A","CT",J)) Q:J=""  D
 
^TMP($J,"AMIE",L)="    "_^TMP($J,"DVBAB1A","CT",J),L=L+1
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
;
 
^TMP($J,"AMIE",L)="Exam(s)",L=L+1
 
^TMP($J,"AMIE",L)="   EXAM TYPE                          STATUS",L=L+1
 
;
 
J=""
 
F  S J=$O(^TMP($J,"DVBAB1A","ELIST",J)) Q:J=""  D
 
^TMP($J,"AMIE",L)="   "_^TMP($J,"DVBAB1A","ELIST",J),L=L+1
 
;
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
;
 
DVBOPENS=1 ^TMP($J,"AMIE",L)="*** Number of exams still open on this request: "_DVBOPENC_" ***",L=L+1
 
DVBOPENS=0 ^TMP($J,"AMIE",L)="*** This is the last exam to be completed on this 2507 request. ***",L=L+1
 
;
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
^TMP($J,"AMIE",L)="** NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI **",L=L+1
 
^TMP($J,"AMIE",L)="** Patient Selector 'Patient ID' field to find the patient. Be sure to include  **",L=L+1
 
^TMP($J,"AMIE",L)="** the ` (backward-apostrophe) character.                                       **",L=L+1
 
^TMP($J,"AMIE",L)=" ",L=L+1
 
^TMP($J,"AMIE",L)="*****This is an auto-generated email.  Do not respond to this email address.*****",L=L+1
 
;
 
XMTEXT="^TMP($J,""AMIE"","
 ;
 
^XMD
 
;
 
I $D(XMMGERR=XMMG
 
I $D(XMZERR="MESSAGE SENT"
 ;
 
Q