DVBAB1 ;ALB/SPH - CAPRI UTILITIES ; 12/12/11 3:52pm
 ;;2.7;AMIE;**35,37,50,42,53,57,73,104,109,137,146,143,179**;Apr 10, 1995;Build 15
 ;
VERSION(ZMSG,DVBGUIV) ;
 ; 
 ; --rpc: DVBAB VERSION
 ; 
 ; Must have a letter at the end of the Version for Delphi compatibility.
 ;  1st piece is version description
 ;  2nd piece can be YESOLD or NOOLD
 ;    YESOLD --> Allow old GUI to run with new KID
 ;     NOOLD --> Do not allow old GUI to run with newer version
 ;
 ;  Ex: "CAPRI GUI V2.7*123*0*A^NOOLD"
 ; 
 ; Sets variables DVBABVR* so that the error trap will display what
 ; version of the client software the user was utilizing if CAPRI bombs.
 ;
 
DVBVERS
 
DVBOLD
 
;
 ;obtain version parameters and build version string result
 
DVBVERS=$$GET^XPAR("PKG","DVBAB CAPRI MINIMUM VERSION",1,"Q")
 
DVBOLD=$$GET^XPAR("PKG","DVBAB CAPRI ALLOW OLD VERSION",1,"Q")
 
ZMSG=DVBVERS_"^"_$S(DVBOLD=1:"YESOLD",1:"NOOLD")
 
;
 ;set DVBABVR* vars for error trap
 
DVBABVR1="CAPRI Server Version: "_ZMSG
 
DVBABVR2="CAPRI GUI Version: "_$S($G(DVBGUIV)]"":DVBGUIV,1:"UNKNOWN")
 
DVBABVR3=$P(^VA(200,DUZ,0),"^",1)
 

 
;
REQUESTS(Y,TYPE) ;
 ; TYPE is the internal value of field 17 in file 396.3
 ; This relates to which status of request should be returned
 
DVBABCNT,DVBABIEN
 
DVBABCNT=0,DVBABIEN=0
 
F  S DVBABIEN=$O(^DVB(396.3,DVBABIEN)) Q:'DVBABIEN  D
 
.DVBABST=$P($G(^DVB(396.3,DVBABIEN,0)),"^",18)
 .
DVBABST=TYPE D
 
..DVBABNM=$P($G(^DVB(396.3,DVBABIEN,0)),"^",1)
 ..
DVBABPT=DVBABNM
 
..DVBABNM'="" DVBABNM=$P($G(^DPT(DVBABNM,0)),"^",1)
 ..
DVBABDT=$$FMTE^XLFDT($P($G(^DVB(396.3,DVBABIEN,0)),"^",2),"2D")
 ..
DVBABWHO=$P($G(^DVB(396.3,DVBABIEN,0)),"^",4)
 ..
DVBABWHO'="" DVBABWHO=$P($G(^VA(200,DVBABWHO,0)),"^",1)
 ..
E  S DVBABWHO="UNKNOWN"
 
..DVBABRO=$P($G(^DVB(396.3,DVBABIEN,0)),"^",3)
 ..
DVBABRO'="" DVBABRO=$P($G(^DIC(4,DVBABRO,0)),"^",1)
 ..
E  S DVBABRO="UNKNOWN"
 
..^TMP("DVBAREQ",DUZ,DVBABCNT)=DVBABST_"^"_DVBABPT_"^"_DVBABNM_"^"_DVBABDT_"^"_DVBABWHO_"^"_DVBABRO_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1
 
Y=$NA(^TMP("DVBAREQ",DUZ))
 
DVBABCNT,DVBABIEN,TYPE,DVBABNM,DVBABDT,DVBABST,DVBABWHO,DVBABPT
 
Q
TEAMPTS(DVBORY,TEAM,TMPFLAG) ; RETURN LIST OF PATIENTS IN A TEAM
 ; If TMPFLAG passed and = TRUE, code expects a "^TMP(xxx"
 ;    global root string passed in ORY, and builds the returned 
 ;    list in that global instead of to a memory array.
 
DOTMP,NEWTMP,DVBSSN,DVBORI,DVBORPT,I
 
^TMP("DVBATMPT",DUZ)
 
(I,DOTMP,DVBORI)=0
 
I $G(TMPFLAGD             ; Was value passed?
 
.TMPFLAG DOTMP=1        ; Is value TRUE?
 
+$G(TEAM)<1 D
 
.DOTMP NEWTMP=DVBORY_1_")",@NEWTMP="^No team identified"
 
.E  S DVBORY(1)="^No team identified"
 
F  S DVBORI=$O(^OR(100.21,+TEAM,10,DVBORI)) Q:DVBORI<1  D
 
.DVBORPT=^OR(100.21,+TEAM,10,DVBORI,0)
 .
DOTMP D
 
..I=I+1,NEWTMP=DVBORY_+I_")"
 
..@NEWTMP=+DVBORPT_U_$P(^DPT(+DVBORPT,0),U)
 .
DVBSSN=$P($G(^DPT($P(DVBORPT,";",1),0)),U,9)
 .
E  S I=I+1,^TMP("DVBATMPT",DUZ,I)=+DVBORPT_U_$P(^DPT(+DVBORPT,0),U)_U_DVBSSN_$C(13)
 
DOTMP S:I<1 NEWTMP=DVBORY_1_")",@NEWTMP="^No patients found."
 
E  S:I<1 ^TMP("DVBATMPT",DUZ,1)="^No patients found."
 
DVBORY=$NA(^TMP("DVBATMPT",DUZ))
 
Q
DIVISION(Y) ; Returns Name for an Institution
 
DVBARR,DVBERR,DVBATP
 
Y=""
 
Q:$G(DUZ(2))=""
 
GETS^DIQ(4,DUZ(2)_",0",".01","I","DVBARR","DVBERR")
 
Q:$D(DVBERR)
 
Y=$G(DVBARR(4,DUZ(2)_",0,",.01,"I"))
 
GETS^DIQ(4,DUZ(2)_",0",13,"I","DVBARR","DVBERR")
 
DVBATP=$G(DVBARR(4,DUZ(2)_",0,",13,"I"))
 
DVBATP'="" DVBATP=$P($G(^DIC(4.1,DVBATP,0)),"^",1)
 
Y=Y_"-"_DVBATP
 
Q
 
;
DT(Y,X1,X2) ; Returns date X1 minus X2 days
 ; change the '00:00' that could be passed so Fileman doesn't reject
 ;C^%DTC(X1,X2)
 ;S %DT=$G(%DT,"TS") D ^%DT
 ;K %DT,X1,X2
 ;Q
DTTM(Y) ;
 
Y=$$HTE^XLFDT($H,"P")
 
Q
CHKCRED(Y) ;KLB
 
Y="[OK]"
 
'$D(DUZ(2)) Y="Your division number is missing." Q
 I $D
(DUZ)#2=0 Y="Your user number is invalid." Q
 I 
+DUZ(2)<1 Y="Invalid division."
 
Q
PTINQ(REF,DFN) ; Return formatted pt inquiry report
 
^TMP("ORDATA",$J,1)
 
; DVBA*2.7*109 - Added $D to next line
 
($D(^DPT(DFN,0))) START^ORWRP(80,"DGINQB^ORCXPND1(DFN)")
 
REF=$NA(^TMP("ORDATA",$J,1))
 
Q
TEMPLATE(Y) ; Returns list of CAPRI exam templates
 
DVBABCNT,DVBABIEN,DVBABNM,DVBABAD,DVBABDD,DVBABSL,DVBABOC
 
Y,^TMP("DVBALAB1",DUZ)
 
DVBABCNT=0,DVBABIEN=0
 
F  S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN  D
 
.DVBABNM=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
 .
DVBABAD=$P($G(^DVB(396.18,DVBABIEN,2)),"^",1)
 .
DVBABDD=$P($G(^DVB(396.18,DVBABIEN,2)),"^",2)
 .
DVBABSL=$P($G(^DVB(396.18,DVBABIEN,6)),"^",1)
 .
DVBABOC=$P($G(^DVB(396.18,DVBABIEN,6)),"^",2)
 .
^TMP("DVBATMPL",DUZ,DVBABCNT)=DVBABNM_"^"_DVBABAD_"^"_DVBABDD_"^"_DVBABSL_"^"_DVBABOC_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1
 
Y=$NA(^TMP("DVBATMPL",DUZ))
 
Q
 
;
LABLIST(Y) ; Returns list of LAB TEST NAMES
 
DVBABCNT,DVBABIEN,DVBABLNM
 
Y,^TMP("DVBALAB1",DUZ)
 
DVBABCNT=0,DVBABIEN=0
 
F  S DVBABIEN=$O(^LAB(60,DVBABIEN)) Q:'DVBABIEN  D
 
.DVBABLNM=$P($G(^LAB(60,DVBABIEN,0)),"^",1)
 .
^TMP("DVBALAB1",DUZ,DVBABCNT)=DVBABLNM_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1
 
Y=$NA(^TMP("DVBALAB1",DUZ))
 
Q
 
;
INSTLIST(Y) ; Returns full list of Institutions
 
DVBABCNT,DVBABIEN,DVBABNM,DVBABSTN,DVBABST,DVBABDS,DVBARR,DVBERR,DVBATP
 
Y,^TMP("DVBAINST",$J,DUZ)
 
(DVBABCNT,DVBABIEN)=0
 
F  S DVBABIEN=$O(^DIC(4,DVBABIEN)) Q:'DVBABIEN  
 
DVBARR,DVBERR
 
GETS^DIQ(4,DVBABIEN_",0",".01:.02:.03:","I","DVBARR","DVBERR")
 . 
Q:$D(DVBERR)
 . 
DVBABNM=$G(DVBARR(4,DVBABIEN_",0,",.01,"I"))
 . 
Q:DVBABNM=""
 
DVBABSTN=$G(DVBARR(4,DVBABIEN_",0,",.02,"I"))
 . 
Q:DVBABSTN=""
 
DVBABDS=$G(DVBARR(4,DVBABIEN_",0,",.03,"I"))
 . 
DVBARR,DVBERR
 
GETS^DIQ(5,DVBABSTN_",0",.01,"I","DVBARR","DVBERR")
 . 
Q:$D(DVBERR)
 . 
DVBABST=$G(DVBARR(5,DVBABSTN_",0,",.01,"I"))
 . 
DVBARR,DVBERR
 
GETS^DIQ(4,DVBABIEN_",0",13,"I","DVBARR","DVBERR")
 . 
DVBATP=$G(DVBARR(4,DVBABIEN_",0,",13,"I"))
 . 
DVBATP'="" D
 
.. DVBATP=$P($G(^DIC(4.1,DVBATP,0)),"^",1)
 . 
^TMP("DVBAINST",$J,DUZ,DVBABCNT)=DVBABNM_"-"_DVBATP_"^"_DVBABST_"^"_DVBABDS_"^"_DVBABIEN_$C(13)
 . 
DVBABCNT=DVBABCNT+1
 
Y=$NA(^TMP("DVBAINST",$J,DUZ))
 
Q
 
;
INCEXAM(ZMSG) ;Increased exam # in file  and passes back the # to user
 
ZMSG=+$G(^DVB(396.1,1,5))+1
 
^DVB(396.1,1,5)=ZMSG
 
Q
 
;
MSG(ERR,DUZ,XMSUB,XMTEXT,MGN,ID) ;Generate mail message;KLB
 ; --rpc: DVBAB SEND MSG
 ;
 ; This remote procedure is used to generate bulletins for specific CAPRI actions, such as cancellation of 2507 exams.
 ;
 ;  Supported References:                                               
 ;     DBIA #10111: Allows FM read access of ^XMB(3.8,D0,0) using DIC.
 
^TMP($J,"AMIE")
 
XMB="",XMDUZ=DUZ
 
'$D(DUZERR="MISSING DUZ" Q
 I 
'$D(XMSUBERR="MISSING SUBJECT" Q
 I 
'$D(XMTEXTERR="MISSING TEXT" Q
 I 
'$D(MGNERR="MISSING MAIL GROUP NAME" Q
 
;IF MGN=DVBA C 2507 EXAM READY NO BULLETIN NECESSARY, BUILD THE EMAIL AND QUIT
 
MGN="DVBA C 2507 EXAM READY" SENDMSG Q
 S 
J=0
 
F  S J=$O(XMTEXT(J)) Q:'J  ^TMP($J,"AMIE",J)=$G(XMTEXT(J))
 
XMTEXT="^TMP($J,""AMIE"","
 
DIC="^XMB(3.8,",DIC(0)="QM",X=MGN ^DIC
 
+Y<0 ERR="INVALID MAIL GROUP NAME" Q
 I 
'$$GOTLOCAL^XMXAPIG(MGNERR="NO ACTIVE LOCAL MEMBERS IN MAIL GROUP" ^TMP("XMERR",$JQ
 I 
MGN="DVBA C NEW C&P VETERAN" XMB="DVBA CAPRI NEW C&P VETERAN"
 
MGN="DVBA C 2507 CANCELLATION" XMB="DVBA CAPRI 2507 CANCELLATION"
 
XMB="" ERR="UNABLE TO SET BULLETIN" Q
 D 
^XMB
 
;XMB = -1 if bulletin not found in file (#3.6)
 
ERR=$S(XMB=-1:"BULLETIN NOT FOUND",1:"MESSAGE SENT")
 
;before we quit, send a message to the requestor if the message is a cancellation
 
MGN="DVBA C 2507 CANCELLATION" SENDMSG
 
XMSUB,XMTEXT,MGN,DIC,DIC(0),J,Y,XMDUZ,XMB
 
Q
FINDEXAM(ZMSG,ZIEN) ;Returns list of exams in 396.4 that are linked to ZIEN in 396.3
 
DVBABCNT,DVBABIEN
 
DVBABCNT=0,DVBABIEN=0
 
F  S DVBABIEN=$O(^DVB(396.4,"C",ZIEN,DVBABIEN)) Q:'DVBABIEN  D
 
.DVBABD1=$P($G(^DVB(396.4,DVBABIEN,0)),"^",2)
 .
DVBABD2=$P($G(^DVB(396.6,+$P($G(^DVB(396.4,DVBABIEN,0)),"^",3),0)),"^",1)  ;Name of Exam
 
.DVBABD3=$P($G(^DVB(396.4,DVBABIEN,0)),"^",4)
 .
DVBABD3="O" DVBABD3="[OPEN]"
 
.DVBABD3="C" DVBABD3="[COMPLETE]"
 
.DVBABD3="X" DVBABD3="[CANCELED BY MAS]"
 
.DVBABD3="RX" DVBABD3="[CANCELED BY RO]"
 
.DVBABD3="T" DVBABD3="[TRANSFERRED OUT]"
 
.ZIEN=DVBABD1 D
 
..ZMSG(DVBABCNT)=DVBABIEN_"^"_DVBABD2_" "_DVBABD3
 
..DVBABCNT=DVBABCNT+1
 
DVBABCNT,DVBABIEN,ZIEN,DVBABD1,DVBABD2,DVBABD3
 
Q
SENDMSG ;SET UP TO SEND EMAIL/NOTIFICATION TO REQUESTOR OF 2507
 
DVBA0,DVBAREQ,DVBAEA,DVBAC,DVBAQUIT,DVBADFN,DVBASITE,DVBADT,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
 
I $G(ID)="" Q
 S 
XMDUZ=$P(^VA(200,XMDUZ,0),"^",1)_" CAPRI"
 
DVBA0=$G(^DVB(396.3,ID,0))
 
DVBADFN=$P(DVBA0,"^",1),DVBAREQ=$P(DVBA0,"^",4),DVBADT=$$FMTE^XLFDT($P(DVBA0,"^",2))
 
;following call supported by IA 3858
 
DVBAEA=$P($G(^VA(200,DVBAREQ,.15)),"^",1)
 
DVBAEA'="" D
 
XMY(DVBAEA)="",DVBASITE=$$SITE^VASITE
 . 
MGN="DVBA C 2507 CANCELLATION" CNCLMSG Q
 
MGN="DVBA C 2507 EXAM READY" RDYMSG Q
 Q
CNCLMSG ;SEND CANCEL MESSAGE TO REQUESTOR OF THE 2507 EXAM
 ;need to loop through previously built text to make sure all PII is removed
 
J=0,DVBAQUIT=0
 
F  S J=$O(^TMP($J,"AMIE",J)) Q:'J!(DVBAQUIT)  D
 
.I $G(^TMP($J,"AMIE",J))["Name" ^TMP($J,"AMIE",J)="DFN: `"_DVBADFN_"       SITE: "_$P($G(DVBASITE),"^",2)_"       Request Date: "_DVBADT
 
.I $G(^TMP($J,"AMIE",J))["Additional Comments" D  Q
 
..^TMP($J,"AMIE1",J)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI"
 
..^TMP($J,"AMIE1",J+1)="Patient Selector 'Patient ID' field to find the patient. Be sure to include"
 
..^TMP($J,"AMIE1",J+2)="the ` (backward-apostrophe) character."
 
..^TMP($J,"AMIE1",J+3)=""
 
..^TMP($J,"AMIE1",J+4)=""
 
..^TMP($J,"AMIE1",J+4)=""
 
..^TMP($J,"AMIE1",J+5)="*****This is an auto-generated email.  Do not respond to this email address.*****"
 
..DVBAQUIT=1 Q
 
.^TMP($J,"AMIE1",J)=$G(^TMP($J,"AMIE",J))
 
XMTEXT="^TMP($J,""AMIE1"","
 
^XMD
 
^TMP($J,"AMIE1")
 
Q
RDYMSG ;SEND EXAM COMPLETE MESSAGE TO REQUESTOR OF 2507 
 ;no text/body is passed in so we have to build the message from scratch
 
^TMP($J,"AMIE1",1)="A 2507 request as described below has been completed and released to the regional office , and is now available in CAPRI."
 
^TMP($J,"AMIE1",2)=""
 
^TMP($J,"AMIE1",3)=""
 
^TMP($J,"AMIE1",4)="                 DFN:  `"_DVBADFN
 
^TMP($J,"AMIE1",5)="          Vista Site: "_$P($G(DVBASITE),"^",2)
 
^TMP($J,"AMIE1",6)="        Request Date: "_DVBADT
 
^TMP($J,"AMIE1",7)=""
 
^TMP($J,"AMIE1",8)=""
 
^TMP($J,"AMIE1",9)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI"
 
^TMP($J,"AMIE1",10)="Patient Selector 'Patient ID' field to find the patient. Be sure to include"
 
^TMP($J,"AMIE1",11)="the ` (backward-apostrophe) character."
 
^TMP($J,"AMIE1",12)=""
 
^TMP($J,"AMIE1",13)=""
 
^TMP($J,"AMIE1",14)=""
 
^TMP($J,"AMIE1",15)="*****This is an auto-generated email.  Do not respond to this email address.*****"
 
XMTEXT="^TMP($J,""AMIE1"","
 
^XMD
 
^TMP($J,"AMIE1")
 
XMSUB,XMTEXT,MGN,XMDUZ
 
Q