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

DVBAB1A.m

Go to the documentation of this file. 
  1. DVBAB1A ;ALB/GAK - CAPRI Exam Complete Email Driver ; 03/13/2013 11:23 AM
  1.  ;;2.7;AMIE;**185,187,189**;Apr 10, 1995;Build 22
  1.  ;
  1.  Q
  1.  ; 
  1. MSG2(ERR,DUZ,RIEN,ELIST) ;
  1.  ;
  1.  ;DUZ     PERSON FILE DFN
  1.  ;RIEN    2507 REQUEST IEN #396.3
  1.  ;ELIST   2507 EXAM LIST #396.4
  1.  ;
  1.  N DVBOPEN,DVBOPENS,DVBOPENC,J
  1.  N PNAM,PSSN,CNUM,ERR3,ERR2,ERR4,RTN,RTN2,XX
  1.  ;N POE
  1.  N MSG1,MERR1,CTR1
  1.  N MSG2,MERR2,CTR2
  1.  N CLMTYP
  1.  N EIEN,EARY,EERR,ENAM,ESTA
  1.  N XMTEXT,L,XMSUB,XMY
  1.  N MSG,MERR
  1.  ;
  1.  S ERR=""
  1.  I DUZ="" S ERR="NO DUZ PASSED" Q ERR
  1.  I RIEN="" S ERR="NO REQUEST IEN PASSED" Q ERR
  1.  I $D(ELIST)'>1 S ERR="NO EXAM LIST PASSED" Q ERR
  1.  ;
  1.  K ^TMP($J,"DVBAB1A")
  1.  K ^TMP($J,"AMIE")
  1.  K ^TMP($J,"AMIE1")
  1.  ;
  1.  S J=""
  1.  F  S J=$O(ELIST(J)) Q:J=""  D
  1.  . S ^TMP($J,"DVBAB1A","ELIST",J)=J
  1.  ;
  1.  ;Determine and count number of open exams on 2507 request
  1.  S DVBOPEN=""
  1.  S DVBOPENS=0,DVBOPENC=0
  1.  D FINDEXAM^DVBAB1(.DVBOPEN,RIEN)
  1.  S J="" F  S J=$O(DVBOPEN(J)) Q:J=""  D
  1.  . I $E(DVBOPEN(J),($L(DVBOPEN(J))-5),$L(DVBOPEN(J)))="[OPEN]" S DVBOPENS=1,DVBOPENC=DVBOPENC+1
  1.  ;
  1.  ;Determine patient name, SSN and C-Number
  1.  S (PNAM,PSSN,CNUM,ERR3,ERR2,RTN,RTN2,XX)=""
  1.  K RTN,ERR3
  1.  D GETS^DIQ(396.3,RIEN,".01","I","RTN","ERR3")
  1.  I $D(RTN) D
  1.  . S XX=""_".01;.09;.313"_""
  1.  . K RTN2,ERR2
  1.  . D GETS^DIQ(2,RTN(396.3,RIEN_",",.01,"I"),XX,"E","RTN2","ERR2")
  1.  . S PNAM=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.01,"E"))
  1.  . S PSSN=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.09,"E"))
  1.  . S CNUM=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.313,"E"))
  1.  S:'$D(PNAM) PNAM=""
  1.  S:'$D(PSSN) PSSN=""
  1.  S:'$D(CNUM) CNUM=""
  1.  ;
  1.  ;Build Exam Array Info
  1.  K ^TMP($J,"DVBAB1A","ELIST")
  1.  S J=""
  1.  F  S J=$O(ELIST(J)) Q:J=""  D
  1.  . S EIEN=ELIST(J)
  1.  . K EARY,EERR
  1.  . D GETS^DIQ(396.4,EIEN,".03;.04","IE","EARY","EERR")
  1.  . Q:'$D(EARY(396.4,EIEN_",",.03,"E"))
  1.  . S ENAM=$G(EARY(396.4,EIEN_",",.03,"E"))
  1.  . S ESTA=$G(EARY(396.4,EIEN_",",.04,"E"))
  1.  . S ^TMP($J,"DVBAB1A","ELIST",J)=ENAM_$E("                                   ",1,35-$L(ENAM))_" "_ESTA
  1.  ;
  1.  ;Determine Priority of Exam
  1.  ;K ERR4
  1.  ;S POE=$$GET1^DIQ(396.3,RIEN_",",9,"E","","ERR4")
  1.  ;I '$D(POE) S POE=""
  1.  ;
  1.  ;Build Claim Type Info
  1.  N MSG1,MERR1,CTR1
  1.  K ^TMP($J,"DVBAB1A","CT")
  1.  S MSG1="",MERR1="",CTR1=1
  1.  D GETS^DIQ(396.3,RIEN_",","9.1*","E","MSG1","MERR1")
  1.  I $G(MERR1)'="" S ^TMP($J,"DVBAB1A","CT",CTR1)="ERROR GETTING CLAIM TYPE CODES"
  1.  S J=""
  1.  F  S J=$O(MSG1(396.32,J)) Q:J=""  D
  1.  . S CTR1=CTR1+1
  1.  . S ^TMP($J,"DVBAB1A","CT",CTR1)=$G(MSG1(396.32,J,.01,"E"))
  1.  ;
  1.  ;Build Special Considerations Info
  1.  N MSG2,MERR2,CTR2
  1.  K ^TMP($J,"DVBAB1A","SC")
  1.  S MSG2="",MERR2="",CTR2=1
  1.  D GETS^DIQ(396.3,RIEN,"50*","IE","MSG2","MERR2")
  1.  I $G(MERR2)'="" S ^TMP($J,"DVBAB1A","SC",CTR2)="ERROR GETTING SPECIAL CONSIDERATION CODES"
  1.  S J=""
  1.  F  S J=$O(MSG2(396.31,J)) Q:J=""  D
  1.  . S CTR2=CTR2+1
  1.  . S ^TMP($J,"DVBAB1A","SC",CTR2)=$G(MSG2(396.31,J,.01,"E"))
  1.  ;
  1.  ;
  1.  D ONEEMAIL
  1.  ;
  1.  K ^TMP($J,"DVBAB1A","ELIST")
  1.  K ^TMP($J,"DVBAB1A","CT")
  1.  K ^TMP($J,"DVBAB1A","SC")
  1.  K ^TMP($J,"AMIE")
  1.  K ^TMP($J,"AMIE1")
  1.  I $D(ERR) Q ERR
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1. ONEEMAIL ;
  1.  K ERR
  1.  N DVBA0,DVBADFN,DVBASITE,DVBADT,DVBAREQ,DVBAEA
  1.  S XMDUZ=DUZ
  1.  ;following call supported by IA 3858
  1.  N DUZ
  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.  ;
  1.  S XMDUZ=$P($G(^VA(200,XMDUZ,0)),"^",1)_" CAPRI"
  1.  I $G(^DVB(396.3,RIEN,0))="" S ERR="INVALID REQUEST 396.3 TOP NODE" Q
  1.  S DVBA0=$G(^DVB(396.3,RIEN,0))
  1.  S DVBADFN=$P(DVBA0,"^",1),DVBAREQ=$P(DVBA0,"^",4),DVBADT=$$FMTE^XLFDT($P(DVBA0,"^",2))
  1.  ;following call supported by IA 3858
  1.  ;rra 938270 make sure email address exists prior to attempting to send notification
  1.  S DVBAEA=$P($G(^VA(200,DVBAREQ,.15)),"^",1)
  1.  I DVBAEA="" Q
  1.  S XMY(DVBAEA)=""
  1.  ;
  1.  S DVBASITE=$$SITE^VASITE
  1.  I '$D(DVBASITE) S DVBASITE="^"
  1.  ;
  1.  S XMSUB="CAPRI: Completion of 2507 Exams"
  1.  ;
  1.  S L=0
  1.  S L=L+1
  1.  S ^TMP($J,"AMIE",L)="The following veteran had one or more 2507 exams completed.",L=L+1
  1.  I DVBOPENS=0 S ^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
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  S ^TMP($J,"AMIE",L)="DFN: `"_DVBADFN_"       SITE: "_$P($G(DVBASITE),"^",2)_"       Request Date: "_DVBADT
  1.  S L=L+1
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  ;
  1.  S ^TMP($J,"AMIE",L)="  Special Consideration(s):",L=L+1
  1.  S J=""
  1.  F  S J=$O(^TMP($J,"DVBAB1A","SC",J)) Q:J=""  D
  1.  . S ^TMP($J,"AMIE",L)="    "_^TMP($J,"DVBAB1A","SC",J),L=L+1
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  ;
  1.  ;S ^TMP($J,"AMIE",L)="  Priority of Exam: "_POE,L=L+1
  1.  ;S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  ;
  1.  S ^TMP($J,"AMIE",L)="  Claim Type:",L=L+1
  1.  S J=""
  1.  F  S J=$O(^TMP($J,"DVBAB1A","CT",J)) Q:J=""  D
  1.  . S ^TMP($J,"AMIE",L)="    "_^TMP($J,"DVBAB1A","CT",J),L=L+1
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  ;
  1.  S ^TMP($J,"AMIE",L)="Exam(s)",L=L+1
  1.  S ^TMP($J,"AMIE",L)="   EXAM TYPE                          STATUS",L=L+1
  1.  ;
  1.  S J=""
  1.  F  S J=$O(^TMP($J,"DVBAB1A","ELIST",J)) Q:J=""  D
  1.  . S ^TMP($J,"AMIE",L)="   "_^TMP($J,"DVBAB1A","ELIST",J),L=L+1
  1.  ;
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  ;
  1.  I DVBOPENS=1 S ^TMP($J,"AMIE",L)="*** Number of exams still open on this request: "_DVBOPENC_" ***",L=L+1
  1.  I DVBOPENS=0 S ^TMP($J,"AMIE",L)="*** This is the last exam to be completed on this 2507 request. ***",L=L+1
  1.  ;
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  S ^TMP($J,"AMIE",L)="** NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI **",L=L+1
  1.  S ^TMP($J,"AMIE",L)="** Patient Selector 'Patient ID' field to find the patient. Be sure to include  **",L=L+1
  1.  S ^TMP($J,"AMIE",L)="** the ` (backward-apostrophe) character.                                       **",L=L+1
  1.  S ^TMP($J,"AMIE",L)=" ",L=L+1
  1.  S ^TMP($J,"AMIE",L)="*****This is an auto-generated email.  Do not respond to this email address.*****",L=L+1
  1.  ;
  1.  S XMTEXT="^TMP($J,""AMIE"","
  1.  ;
  1.  D ^XMD
  1.  ;
  1.  I $D(XMMG) S ERR=XMMG
  1.  I $D(XMZ) S ERR="MESSAGE SENT"
  1.  ;
  1.  Q