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

DVBAB1.m

Go to the documentation of this file.
  1. DVBAB1 ;ALB/SPH - CAPRI UTILITIES ; MAY 27, 2022@11:31am
  1. ;;2.7;AMIE;**35,37,50,42,53,57,73,104,109,137,146,143,179,238**;Apr 10, 1995;Build 16
  1. ;
  1. VERSION(ZMSG,DVBGUIV) ;
  1. ;
  1. ; --rpc: DVBAB VERSION
  1. ;
  1. ; Must have a letter at the end of the Version for Delphi compatibility.
  1. ; 1st piece is version description
  1. ; 2nd piece can be YESOLD or NOOLD
  1. ; YESOLD --> Allow old GUI to run with new KID
  1. ; NOOLD --> Do not allow old GUI to run with newer version
  1. ;
  1. ; Ex: "CAPRI GUI V2.7*123*0*A^NOOLD"
  1. ;
  1. ; Sets variables DVBABVR* so that the error trap will display what
  1. ; version of the client software the user was utilizing if CAPRI bombs.
  1. ; Patch 238 adds two N variables and the checking GUI version against minimum and previous versions
  1. ;
  1. N DVBVERS
  1. N DVBOLD
  1. N DVBPREV
  1. N DVBGUIC
  1. N DVBABVR1,DVBABVR2,DVBABVR3
  1. ;
  1. ;obtain version parameters and build version string result
  1. S DVBVERS=$$GET^XPAR("PKG","DVBAB CAPRI MINIMUM VERSION",1,"Q")
  1. S DVBOLD=$$GET^XPAR("PKG","DVBAB CAPRI ALLOW OLD VERSION",1,"Q")
  1. S ZMSG=DVBVERS_"^"_$S(DVBOLD=1:"YESOLD",1:"NOOLD")
  1. ;
  1. ;238-Checking GUI version against minimum and previous versions
  1. ;Strip preceding zero from minor build number and setting date to prevent other gui's
  1. I $G(DVBGUIV)'="" S DVBGUIC=DVBGUIV,$P(DVBGUIC,".",3)=+$P(DVBGUIC,".",3) D
  1. .I $P(ZMSG,"*",2)'=$P(DVBGUIC,"*",3) D
  1. ..S DVBPREV=$$GET^XPAR("PKG","DVBAB CAPRI PREVIOUS VERSION",1,"Q")
  1. ..I DVBPREV'="",($P(DVBGUIC,"*",3)'=$P(DVBPREV,"*",3)) D
  1. ...S $P(ZMSG,"*",5)=2800101
  1. ;
  1. ;set DVBABVR* vars for error trap
  1. S DVBABVR1="CAPRI Server Version: "_ZMSG
  1. S DVBABVR2="CAPRI GUI Version: "_$S($G(DVBGUIV)]"":DVBGUIV,1:"UNKNOWN")
  1. S DVBABVR3=$P(^VA(200,DUZ,0),"^",1)
  1. Q
  1. ;
  1. REQUESTS(Y,TYPE) ;
  1. ; TYPE is the internal value of field 17 in file 396.3
  1. ; This relates to which status of request should be returned
  1. N DVBABCNT,DVBABIEN
  1. S DVBABCNT=0,DVBABIEN=0
  1. F S DVBABIEN=$O(^DVB(396.3,DVBABIEN)) Q:'DVBABIEN D
  1. .S DVBABST=$P($G(^DVB(396.3,DVBABIEN,0)),"^",18)
  1. .I DVBABST=TYPE D
  1. ..S DVBABNM=$P($G(^DVB(396.3,DVBABIEN,0)),"^",1)
  1. ..S DVBABPT=DVBABNM
  1. ..I DVBABNM'="" S DVBABNM=$P($G(^DPT(DVBABNM,0)),"^",1)
  1. ..S DVBABDT=$$FMTE^XLFDT($P($G(^DVB(396.3,DVBABIEN,0)),"^",2),"2D")
  1. ..S DVBABWHO=$P($G(^DVB(396.3,DVBABIEN,0)),"^",4)
  1. ..I DVBABWHO'="" S DVBABWHO=$P($G(^VA(200,DVBABWHO,0)),"^",1)
  1. ..E S DVBABWHO="UNKNOWN"
  1. ..S DVBABRO=$P($G(^DVB(396.3,DVBABIEN,0)),"^",3)
  1. ..I DVBABRO'="" S DVBABRO=$P($G(^DIC(4,DVBABRO,0)),"^",1)
  1. ..E S DVBABRO="UNKNOWN"
  1. ..S ^TMP("DVBAREQ",DUZ,DVBABCNT)=DVBABST_"^"_DVBABPT_"^"_DVBABNM_"^"_DVBABDT_"^"_DVBABWHO_"^"_DVBABRO_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1
  1. S Y=$NA(^TMP("DVBAREQ",DUZ))
  1. K DVBABCNT,DVBABIEN,TYPE,DVBABNM,DVBABDT,DVBABST,DVBABWHO,DVBABPT
  1. Q
  1. TEAMPTS(DVBORY,TEAM,TMPFLAG) ; RETURN LIST OF PATIENTS IN A TEAM
  1. ; If TMPFLAG passed and = TRUE, code expects a "^TMP(xxx"
  1. ; global root string passed in ORY, and builds the returned
  1. ; list in that global instead of to a memory array.
  1. N DOTMP,NEWTMP,DVBSSN,DVBORI,DVBORPT,I
  1. K ^TMP("DVBATMPT",DUZ)
  1. S (I,DOTMP,DVBORI)=0
  1. I $G(TMPFLAG) D ; Was value passed?
  1. .I TMPFLAG S DOTMP=1 ; Is value TRUE?
  1. I +$G(TEAM)<1 D
  1. .I DOTMP S NEWTMP=DVBORY_1_")",@NEWTMP="^No team identified"
  1. .E S DVBORY(1)="^No team identified"
  1. F S DVBORI=$O(^OR(100.21,+TEAM,10,DVBORI)) Q:DVBORI<1 D
  1. .S DVBORPT=^OR(100.21,+TEAM,10,DVBORI,0)
  1. .I DOTMP D
  1. ..S I=I+1,NEWTMP=DVBORY_+I_")"
  1. ..S @NEWTMP=+DVBORPT_U_$P(^DPT(+DVBORPT,0),U)
  1. .S DVBSSN=$P($G(^DPT($P(DVBORPT,";",1),0)),U,9)
  1. .E S I=I+1,^TMP("DVBATMPT",DUZ,I)=+DVBORPT_U_$P(^DPT(+DVBORPT,0),U)_U_DVBSSN_$C(13)
  1. I DOTMP S:I<1 NEWTMP=DVBORY_1_")",@NEWTMP="^No patients found."
  1. E S:I<1 ^TMP("DVBATMPT",DUZ,1)="^No patients found."
  1. S DVBORY=$NA(^TMP("DVBATMPT",DUZ))
  1. Q
  1. DIVISION(Y) ; Returns Name for an Institution
  1. N DVBARR,DVBERR,DVBATP
  1. S Y=""
  1. Q:$G(DUZ(2))=""
  1. D GETS^DIQ(4,DUZ(2)_",0",".01","I","DVBARR","DVBERR")
  1. Q:$D(DVBERR)
  1. S Y=$G(DVBARR(4,DUZ(2)_",0,",.01,"I"))
  1. D GETS^DIQ(4,DUZ(2)_",0",13,"I","DVBARR","DVBERR")
  1. S DVBATP=$G(DVBARR(4,DUZ(2)_",0,",13,"I"))
  1. I DVBATP'="" S DVBATP=$P($G(^DIC(4.1,DVBATP,0)),"^",1)
  1. S Y=Y_"-"_DVBATP
  1. Q
  1. ;
  1. DT(Y,X1,X2) ; Returns date X1 minus X2 days
  1. ; change the '00:00' that could be passed so Fileman doesn't reject
  1. ;C^%DTC(X1,X2)
  1. ;S %DT=$G(%DT,"TS") D ^%DT
  1. ;K %DT,X1,X2
  1. ;Q
  1. DTTM(Y) ;
  1. S Y=$$HTE^XLFDT($H,"P")
  1. Q
  1. CHKCRED(Y) ;KLB
  1. S Y="[OK]"
  1. I '$D(DUZ(2)) S Y="Your division number is missing." Q
  1. I $D(DUZ)#2=0 S Y="Your user number is invalid." Q
  1. I +DUZ(2)<1 S Y="Invalid division."
  1. Q
  1. PTINQ(REF,DFN) ; Return formatted pt inquiry report
  1. K ^TMP("ORDATA",$J,1)
  1. ; DVBA*2.7*109 - Added $D to next line
  1. I ($D(^DPT(DFN,0))) D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)")
  1. S REF=$NA(^TMP("ORDATA",$J,1))
  1. Q
  1. TEMPLATE(Y) ; Returns list of CAPRI exam templates
  1. N DVBABCNT,DVBABIEN,DVBABNM,DVBABAD,DVBABDD,DVBABSL,DVBABOC
  1. K Y,^TMP("DVBALAB1",DUZ)
  1. S DVBABCNT=0,DVBABIEN=0
  1. F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
  1. .S DVBABNM=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
  1. .S DVBABAD=$P($G(^DVB(396.18,DVBABIEN,2)),"^",1)
  1. .S DVBABDD=$P($G(^DVB(396.18,DVBABIEN,2)),"^",2)
  1. .S DVBABSL=$P($G(^DVB(396.18,DVBABIEN,6)),"^",1)
  1. .S DVBABOC=$P($G(^DVB(396.18,DVBABIEN,6)),"^",2)
  1. .S ^TMP("DVBATMPL",DUZ,DVBABCNT)=DVBABNM_"^"_DVBABAD_"^"_DVBABDD_"^"_DVBABSL_"^"_DVBABOC_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1
  1. S Y=$NA(^TMP("DVBATMPL",DUZ))
  1. Q
  1. ;
  1. LABLIST(Y) ; Returns list of LAB TEST NAMES
  1. N DVBABCNT,DVBABIEN,DVBABLNM
  1. K Y,^TMP("DVBALAB1",DUZ)
  1. S DVBABCNT=0,DVBABIEN=0
  1. F S DVBABIEN=$O(^LAB(60,DVBABIEN)) Q:'DVBABIEN D
  1. .S DVBABLNM=$P($G(^LAB(60,DVBABIEN,0)),"^",1)
  1. .S ^TMP("DVBALAB1",DUZ,DVBABCNT)=DVBABLNM_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1
  1. S Y=$NA(^TMP("DVBALAB1",DUZ))
  1. Q
  1. ;
  1. INSTLIST(Y) ; Returns full list of Institutions
  1. N DVBABCNT,DVBABIEN,DVBABNM,DVBABSTN,DVBABST,DVBABDS,DVBARR,DVBERR,DVBATP
  1. K Y,^TMP("DVBAINST",$J,DUZ)
  1. S (DVBABCNT,DVBABIEN)=0
  1. F S DVBABIEN=$O(^DIC(4,DVBABIEN)) Q:'DVBABIEN D
  1. . K DVBARR,DVBERR
  1. . D GETS^DIQ(4,DVBABIEN_",0",".01:.02:.03:","I","DVBARR","DVBERR")
  1. . Q:$D(DVBERR)
  1. . S DVBABNM=$G(DVBARR(4,DVBABIEN_",0,",.01,"I"))
  1. . Q:DVBABNM=""
  1. . S DVBABSTN=$G(DVBARR(4,DVBABIEN_",0,",.02,"I"))
  1. . Q:DVBABSTN=""
  1. . S DVBABDS=$G(DVBARR(4,DVBABIEN_",0,",.03,"I"))
  1. . K DVBARR,DVBERR
  1. . D GETS^DIQ(5,DVBABSTN_",0",.01,"I","DVBARR","DVBERR")
  1. . Q:$D(DVBERR)
  1. . S DVBABST=$G(DVBARR(5,DVBABSTN_",0,",.01,"I"))
  1. . K DVBARR,DVBERR
  1. . D GETS^DIQ(4,DVBABIEN_",0",13,"I","DVBARR","DVBERR")
  1. . S DVBATP=$G(DVBARR(4,DVBABIEN_",0,",13,"I"))
  1. . I DVBATP'="" D
  1. .. S DVBATP=$P($G(^DIC(4.1,DVBATP,0)),"^",1)
  1. . S ^TMP("DVBAINST",$J,DUZ,DVBABCNT)=DVBABNM_"-"_DVBATP_"^"_DVBABST_"^"_DVBABDS_"^"_DVBABIEN_$C(13)
  1. . S DVBABCNT=DVBABCNT+1
  1. S Y=$NA(^TMP("DVBAINST",$J,DUZ))
  1. Q
  1. ;
  1. INCEXAM(ZMSG) ;Increased exam # in file and passes back the # to user
  1. S ZMSG=+$G(^DVB(396.1,1,5))+1
  1. S ^DVB(396.1,1,5)=ZMSG
  1. Q
  1. ;
  1. MSG(ERR,DUZ,XMSUB,XMTEXT,MGN,ID) ;Generate mail message;KLB
  1. ; --rpc: DVBAB SEND MSG
  1. ;
  1. ; This remote procedure is used to generate bulletins for specific CAPRI actions, such as cancellation of 2507 exams.
  1. ;
  1. ; Supported References:
  1. ; DBIA #10111: Allows FM read access of ^XMB(3.8,D0,0) using DIC.
  1. K ^TMP($J,"AMIE")
  1. S XMB="",XMDUZ=DUZ
  1. I '$D(DUZ) S ERR="MISSING DUZ" Q
  1. I '$D(XMSUB) S ERR="MISSING SUBJECT" Q
  1. I '$D(XMTEXT) S ERR="MISSING TEXT" Q
  1. I '$D(MGN) S ERR="MISSING MAIL GROUP NAME" Q
  1. ;IF MGN=DVBA C 2507 EXAM READY NO BULLETIN NECESSARY, BUILD THE EMAIL AND QUIT
  1. I MGN="DVBA C 2507 EXAM READY" D SENDMSG Q
  1. S J=0
  1. F S J=$O(XMTEXT(J)) Q:'J S ^TMP($J,"AMIE",J)=$G(XMTEXT(J))
  1. S XMTEXT="^TMP($J,""AMIE"","
  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. I '$$GOTLOCAL^XMXAPIG(MGN) S ERR="NO ACTIVE LOCAL MEMBERS IN MAIL GROUP" K ^TMP("XMERR",$J) Q
  1. I MGN="DVBA C NEW C&P VETERAN" S XMB="DVBA CAPRI NEW C&P VETERAN"
  1. I MGN="DVBA C 2507 CANCELLATION" S XMB="DVBA CAPRI 2507 CANCELLATION"
  1. I XMB="" S ERR="UNABLE TO SET BULLETIN" Q
  1. D ^XMB
  1. ;XMB = -1 if bulletin not found in file (#3.6)
  1. S ERR=$S(XMB=-1:"BULLETIN NOT FOUND",1:"MESSAGE SENT")
  1. ;before we quit, send a message to the requestor if the message is a cancellation
  1. I MGN="DVBA C 2507 CANCELLATION" D SENDMSG
  1. K XMSUB,XMTEXT,MGN,DIC,DIC(0),J,Y,XMDUZ,XMB
  1. Q
  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. SENDMSG ;SET UP TO SEND EMAIL/NOTIFICATION TO REQUESTOR OF 2507
  1. N DVBA0,DVBAREQ,DVBAEA,DVBAC,DVBAQUIT,DVBADFN,DVBASITE,DVBADT,DUZ
  1. N MSG,MERR,CTR,RIEN
  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. I $G(ID)="" Q
  1. S XMDUZ=$P(^VA(200,XMDUZ,0),"^",1)_" CAPRI"
  1. S DVBA0=$G(^DVB(396.3,ID,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. S DVBAEA=$P($G(^VA(200,DVBAREQ,.15)),"^",1)
  1. I DVBAEA'="" D
  1. . S XMY(DVBAEA)="",DVBASITE=$$SITE^VASITE
  1. . I MGN="DVBA C 2507 CANCELLATION" D CNCLMSG Q
  1. . I MGN="DVBA C 2507 EXAM READY" D RDYMSG Q
  1. Q
  1. CNCLMSG ;SEND CANCEL MESSAGE TO REQUESTOR OF THE 2507 EXAM
  1. ;need to loop through previously built text to make sure all PII is removed
  1. S J=0,DVBAQUIT=0
  1. F S J=$O(^TMP($J,"AMIE",J)) Q:'J!(DVBAQUIT) D
  1. .I $G(^TMP($J,"AMIE",J))["Name" S ^TMP($J,"AMIE",J)="DFN: `"_DVBADFN_" SITE: "_$P($G(DVBASITE),"^",2)_" Request Date: "_DVBADT
  1. .I $G(^TMP($J,"AMIE",J))["Additional Comments" D Q
  1. ..S ^TMP($J,"AMIE1",J)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI"
  1. ..S ^TMP($J,"AMIE1",J+1)="Patient Selector 'Patient ID' field to find the patient. Be sure to include"
  1. ..S ^TMP($J,"AMIE1",J+2)="the ` (backward-apostrophe) character."
  1. ..S ^TMP($J,"AMIE1",J+3)=""
  1. ..S ^TMP($J,"AMIE1",J+4)=""
  1. ..S ^TMP($J,"AMIE1",J+4)=""
  1. ..S ^TMP($J,"AMIE1",J+5)="*****This is an auto-generated email. Do not respond to this email address.*****"
  1. ..S DVBAQUIT=1 Q
  1. .S ^TMP($J,"AMIE1",J)=$G(^TMP($J,"AMIE",J))
  1. S XMTEXT="^TMP($J,""AMIE1"","
  1. D ^XMD
  1. K ^TMP($J,"AMIE1")
  1. Q
  1. RDYMSG ;SEND EXAM COMPLETE MESSAGE TO REQUESTOR OF 2507
  1. ;no text/body is passed in so we have to build the message from scratch
  1. S ^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."
  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)=" Vista Site: "_$P($G(DVBASITE),"^",2)
  1. S ^TMP($J,"AMIE1",6)=" Request Date: "_DVBADT
  1. S ^TMP($J,"AMIE1",7)=""
  1. S ^TMP($J,"AMIE1",8)=""
  1. S ^TMP($J,"AMIE1",9)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI"
  1. S ^TMP($J,"AMIE1",10)="Patient Selector 'Patient ID' field to find the patient. Be sure to include"
  1. S ^TMP($J,"AMIE1",11)="the ` (backward-apostrophe) character."
  1. S ^TMP($J,"AMIE1",12)=""
  1. S ^TMP($J,"AMIE1",13)=""
  1. S ^TMP($J,"AMIE1",14)=""
  1. S ^TMP($J,"AMIE1",15)="*****This is an auto-generated email. Do not respond to this email address.*****"
  1. S XMTEXT="^TMP($J,""AMIE1"","
  1. D ^XMD
  1. K ^TMP($J,"AMIE1")
  1. K XMSUB,XMTEXT,MGN,XMDUZ
  1. Q