ORPDMP ;SLC/AGP - PDMP Code ;Jul 10, 2023@14:58:48
;;3.0;ORDER ENTRY/RESULTS REPORTING;**519,405,588**;Dec 17, 1997;Build 29
; SAC EXEMPTION 20200131-02 : Vendor Specific Code is used
; SAC EXEMPTION 202211140901-02 : Non-standard $Z special variable used
; Reference to ^VA(200, in ICR #7143
; Reference to REQCOS^TIUSRVA in ICR #5541
;
Q
;
; Returns parameters
GETPAR(ORRESULTS,ORUSER) ;
;
N ORNOTE,ORREQCOSIG
;
S ORRESULTS("PDMP","turnedOn")=+$$GET^XPAR("ALL","OR PDMP TURN ON",1,"I")
; Check if Note write access is disabled
I ORRESULTS("PDMP","turnedOn"),'$$GET^XPAR("ALL","OR CPRS TABS WRITE ACCESS","N") S ORRESULTS("PDMP","turnedOn")=0
S ORRESULTS("PDMP","delegateFeatureEnabled")=+$$GET^XPAR("ALL","OR PDMP DELEGATION ENABLED",1,"I")
S ORRESULTS("PDMP","useDefaultBrowser")=+$$GET^XPAR("ALL","OR PDMP USE DEFAULT BROWSER",1,"I")
S ORRESULTS("PDMP","pollingInterval")=+$$GET^XPAR("ALL","OR PDMP POLLING INTERVAL",1,"I")
S ORRESULTS("PDMP","showButton")="ALWAYS"
S ORRESULTS("PDMP","daysBetweenReview")=+$$GET^XPAR("ALL","OR PDMP DAYS BETWEEN REVIEWS",1,"I")
S ORRESULTS("PDMP","commentLimit")=+$$GET^XPAR("ALL","OR PDMP COMMENT LIMIT",1,"I")
S ORRESULTS("PDMP","pasteEnabled")=+$$GET^XPAR("ALL","OR PDMP COPY/PASTE ENABLED",1,"I")
S ORRESULTS("PDMP","isAuthorizedUser")=$$ISAUTH(ORUSER)
S ORRESULTS("PDMP","backgroundRetrieval")=+$$GET^XPAR("ALL","OR PDMP BACKGROUND RETRIEVAL",1,"I")
S ORNOTE=$$GETNOTE^ORPDMPNT()
S ORRESULTS("PDMP","validNoteTitle")=$S(ORNOTE>0:1,1:0)
S ORRESULTS("PDMP","noteTitle")=$S(ORNOTE>0:ORNOTE,1:"")
D REQCOS^TIUSRVA(.ORREQCOSIG,ORNOTE,0,ORUSER,$$NOW^XLFDT) ; ICR 5541
S ORRESULTS("PDMP","requiresCosigner")=ORREQCOSIG
;
Q
;
;
; Entry point to initiate PDMP Query
STRTPDMP(ORRESULTS,ORUSER,ORCOSIGNER,DFN,ORVSTR) ;
;
; Returns:
; If there was an error initiating the query
; @ORRESULTS@(0) = -1
; @ORRESULTS@(1) = Error message
;
; If query is tasked to run in the background
; @ORRESULTS@(0) = 0^Handle - (Pass in Handle to CHKTASK to check status of tasked job)
;
; If query ran in the foreground, will return the same format as RETPDMP
;
N OREMAIL,ORAUTHUSER,ORLASTCHECKED,ORLOGIENS,ORRESULT,ORSUB
;
S ORSUB="ORPDMP"
K ^TMP(ORSUB,$J)
S ORRESULTS=$NA(^TMP(ORSUB,$J))
;
I '$G(ORUSER) S ORUSER=DUZ
S ORCOSIGNER=$G(ORCOSIGNER)
S ORAUTHUSER=$$ISAUTH(ORUSER)
I ORUSER=ORCOSIGNER S ORCOSIGNER=""
;
I '$G(DFN) D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="DFN is null."
I $G(ORVSTR)="" D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="ORVSTR is null."
;
; Check if PDMP is enabled
I '$$GET^XPAR("ALL","OR PDMP TURN ON",1,"I") D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="The PDMP functionality has been DISABLED."
;
; Check if Note write access is disabled
I '$$GET^XPAR("ALL","OR CPRS TABS WRITE ACCESS","N") D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="CPRS write access for 'Notes' has been disabled."
;
I 'ORAUTHUSER,'$$GET^XPAR("ALL","OR PDMP DELEGATION ENABLED",1,"I") D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="The PDMP delegate feature has been disabled. Only authorized healthcare providers can run a PDMP query."
;
; If delegate, check if they have an email defined
I 'ORAUTHUSER,'$$HASEMAIL(ORUSER) D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="Your VistA account does not have your domain.ext email address defined. You need to have it defined to make a PDMP query as a delegate."
. S ^TMP(ORSUB,$J,2)=" "
. S ^TMP(ORSUB,$J,3)="You can log back into CPRS using your PIV card to link your VistA account with your PIV card, and that should populate your VistA account with your domain.ext email address."
;
; Check if authorized user, or if delegate, if user chosen is an authorized user
I 'ORAUTHUSER,'$$ISAUTH(+ORCOSIGNER) D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="You need to be an authorized healthcare provider to run a PDMP query, or if you are a delegate, you need to select an authorized healthcare provider."
;
; check if PDMP note title exists
I '$$GETNOTE^ORPDMPNT D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="The national PDMP note title needs to be created in order run a PDMP query."
;
S ORLOGIENS=$$LOGQUERY(DFN,$$NOW^XLFDT,ORUSER,ORCOSIGNER,ORAUTHUSER,0,"NO")
;
; if set to background retrieval start tasked job
I +$$GET^XPAR("ALL","OR PDMP BACKGROUND RETRIEVAL",1,"I") D Q
. D STRTTASK(ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS)
. S ^TMP(ORSUB,$J,0)="0^"_ORLOGIENS
;
; otherwise retrieve data directly
D RETPDMP(ORSUB,ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS)
;
Q
;
;
; Start PDMP query task (for background retrieval)
STRTTASK(ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS) ;
;
N OROTHER,ORTASK,ORXSUB
;
S ORXSUB="ORPDMP-"_ORLOGIENS
S ^XTMP(ORXSUB,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"PDMP Results"
S ^XTMP(ORXSUB,"DFN")=DFN
S ^XTMP(ORXSUB,"STARTDT")=$H
;
S OROTHER("ZTDTH")=$$NOW^XLFDT
S ORTASK=$$NODEV^XUTMDEVQ("TASKEN^ORPDMP","PDMP Query From CPRS","ORUSER;ORCOSIGNER;DFN;ORVSTR;ORLOGIENS",.OROTHER)
I ORTASK<0 Q
;
S ^XTMP(ORXSUB,"TASKNUM")=ORTASK
;
Q
;
;
; Call PDMP query in background task (for background retrieval)
TASKEN ;
;
; ZEXCEPT: DFN,ORCOSIGNER,ORVSTR,ORLOGIENS,ORUSER,ZTSTOP
N ORSUB,ORXSUB
;
S ORSUB="ORPDMP"
K ^TMP(ORSUB,$J)
;
I $$S^%ZTLOAD() D Q
. D PROCSTOP(ORLOGIENS)
;
S ORXSUB="ORPDMP-"_ORLOGIENS
D RETPDMP(ORSUB,ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS)
;
I $$S^%ZTLOAD() D Q
. D PROCSTOP(ORLOGIENS)
;
I $D(^XTMP(ORXSUB)) D
. M ^XTMP(ORXSUB,"DATA")=^TMP(ORSUB,$J)
. S ^XTMP(ORXSUB,"DONE")=1
;
Q
;
;
; Process stop task request
PROCSTOP(ORLOGIENS) ;
;
; ZEXCEPT: ZTSTOP
;
K ^XTMP("ORPDMP-"_ORLOGIENS)
;
S ZTSTOP=1
;
Q
;
;
; When PDMP is being called in the background, check if the task completed
CHCKTASK(ORRESULTS,DFN,ORLOGIENS) ;
;
; Returns:
; If query is still running
; @ORRESULTS@(0) = 0^Handle - (query is still running in the background... keep checking back)
;
; If there was an error checking on the background task
; @ORRESULTS@(0) = -1
; @ORRESULTS@(1) = Error message
;
; If background task completed, will return the same format as RETPDMP
;
N ORSUB,ORTASK,ORTASKSTARTDT,ORX,ORXSUB
;
S ORSUB="ORPDMP"
K ^TMP(ORSUB,$J)
S ORRESULTS=$NA(^TMP(ORSUB,$J))
;
I '$G(DFN) D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="DFN is null."
I $G(ORLOGIENS)="" D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="ORLOGIENS is null."
;
S ORXSUB="ORPDMP-"_ORLOGIENS
I '$D(^XTMP(ORXSUB))!($G(^XTMP(ORXSUB,"DFN"))'=DFN) D Q
. S ^TMP(ORSUB,$J,0)=-1
. S ^TMP(ORSUB,$J,1)="System Error"
;
I $G(^XTMP(ORXSUB,"DONE"))=1 D Q
. M ^TMP(ORSUB,$J)=^XTMP(ORXSUB,"DATA")
. ;K ^XTMP(ORXSUB)
;
S ORTASKSTARTDT=$G(^XTMP(ORXSUB,"STARTDT"))
I ORTASKSTARTDT,$$HDIFF^XLFDT($H,ORTASKSTARTDT,2)>$$GET^XPAR("ALL","OR PDMP TIMEOUT QUERY",1,"I") D Q
. S ^TMP(ORSUB,$J,0)=-1
. S ^TMP(ORSUB,$J,1)="PDMP query timed out."
;
S ^TMP(ORSUB,$J,0)="0"_U_ORLOGIENS
;
Q
;
;
; Call PDMP Gateway (via web service)
RETPDMP(ORSUB,ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS) ;
;
; Returns:
; ^TMP(ORSUB,$J,0) = Status ^ ^ ^ ^ Handle ^ Note Cosigner
; Note: Status can be one of the following values:
; -1 - PDMP down, or other reason that didn't even attempt to connect
; -2 - error connecting
; -3 - connected - but error returned by PDMP
; 1 - success
;
; For errors (Status < 1):
; ^TMP(ORSUB,$J,1) = Error Message.
;
; For success (Status = 1):
; ^TMP(ORSUB,$J,1) = Report URL
; ^TMP(ORSUB,$J,2...n) = Data needed to create the review form.
;
N ORARR,ORAUTHUSER,ORDELEGATEOF,ORFINISH,ORQSTATS,ORRETURN,ORSESSION,ORSHARED,ORSTART,ORSTATUS,ORTRACK,ORVDT,ORVLOC
;
S ORVLOC=$P(ORVSTR,";",1)
S ORVDT=$P(ORVSTR,";",2)
;
S ORAUTHUSER=$$ISAUTH(ORUSER)
S ORDELEGATEOF=ORCOSIGNER
I ORAUTHUSER S ORDELEGATEOF=""
S ORSTART=$ZH
D EN^ORPDMPWS(.ORRETURN,DFN,ORUSER,ORDELEGATEOF,$G(DUZ(2)))
S ORFINISH=$ZH
;
S ORQSTATS=ORFINISH-ORSTART
S ORQSTATS=+$FN(ORQSTATS,"",2)
S ORSTATUS=$P($G(^TMP(ORSUB,$J,0)),U,1)
S ORSHARED=+$P($G(^TMP(ORSUB,$J,0)),U,2)
S ORSESSION=$P($G(^TMP(ORSUB,$J,0)),U,3)
D UPDATELOG(ORLOGIENS,ORSTATUS,ORSHARED,ORQSTATS,"",$NA(^TMP(ORSUB,$J,"ERR")),ORSESSION)
;
S ^TMP(ORSUB,$J,0)=ORSTATUS
K ^TMP(ORSUB,$J,"ERR")
;
I ORSTATUS=1 D
. S $P(^TMP(ORSUB,$J,0),U,5,6)=ORLOGIENS_U_ORCOSIGNER
. ; return nodes 2...n with data for UI to create review form
. I ORAUTHUSER D
. . D RVWFORM(ORSUB,"P",DFN)
. I 'ORAUTHUSER D
. . D RVWFORM(ORSUB,"D",DFN)
;
I ORSTATUS<0 D
. S ORTRACK="VistA "_$E(ORLOGIENS,1,$L(ORLOGIENS)-1)
. I ORSESSION'="" S ORTRACK=ORTRACK_". VDIF "_ORSESSION
. S ^TMP(ORSUB,$J,1)=$G(^TMP(ORSUB,$J,1))_" ["_ORTRACK_"]"
;
Q
;
; Return Review Form text
RVWFORM(ORSUB,ORTYPE,DFN) ;
;
N ORARR,ORI,ORJ,ORTEXT,ORLINE,ORERR,ORLASTNOTE,ORREPLACE
;
S ORREPLACE("|DAYS|")=+$$GET^XPAR("ALL","OR PDMP DAYS BETWEEN REVIEWS",1,"I")
D RECNTNOTE^ORPDMPNT(.ORLASTNOTE,DFN)
I ORLASTNOTE S ORREPLACE("|LASTDATE|")=$$FMTE^XLFDT(ORLASTNOTE,"5D")
I 'ORLASTNOTE S ORREPLACE("|LASTDATE|")="none"
;
D GETWP^XPAR(.ORARR,"ALL","OR PDMP REVIEW FORM",ORTYPE,.ORERR)
S ORI=0
S ORJ=1
S ORTEXT=""
F S ORI=$O(ORARR(ORI)) Q:'ORI D
. S ORLINE=$$TRIM^XLFSTR($G(ORARR(ORI,0)))
. I ORLINE="" D Q
. . I ORTEXT["|" S ORTEXT=$$REPLACE^XLFSTR(ORTEXT,.ORREPLACE)
. . S ORJ=ORJ+1
. . S ^TMP(ORSUB,$J,ORJ)=ORTEXT
. . S ORTEXT=""
. S ORTEXT=ORTEXT_$S(ORTEXT="":"",1:" ")_ORLINE
;
I ORTEXT'="" D
. I ORTEXT["|" S ORTEXT=$$REPLACE^XLFSTR(ORTEXT,.ORREPLACE)
. S ORJ=ORJ+1
. S ^TMP(ORSUB,$J,ORJ)=ORTEXT
;
Q
;
;
; Request that PDMP task be stopped
STOPTASK(ORRESULTS,ORLOGIENS) ;
;
N ORSUB,ORTASK
;
S ORSUB="ORPDMP"
K ^TMP(ORSUB,$J)
S ORRESULTS=$NA(^TMP(ORSUB,$J))
;
I $G(ORLOGIENS)="" D Q
. S ^TMP(ORSUB,$J,0)="-1"
. S ^TMP(ORSUB,$J,1)="ORLOGIENS is null."
;
D UPDATELOG(ORLOGIENS,"","","","QCANCEL")
;
S ORTASK=$G(^XTMP("ORPDMP-"_ORLOGIENS,"TASKNUM"))
I 'ORTASK D Q
. S ORRESULTS=-1
;
S ORRESULTS=$$ASKSTOP^%ZTLOAD(ORTASK)
;
Q
;
; Check if there are cached PDMP results for a given patient and user
GETCACHE(ORRESULTS,DFN,ORUSER) ;
;
; Returns:
; If there are no cached results
; @ORRESULTS@(0) = 0
;
; If there are cached results, will return the same format as RETPDMP (although status should always be 1).
;
N ORHOURSBACK,ORIEN,ORIENQ,ORLOGIENS,ORSTARTDT,ORSTATUS,ORSUB,ORVIEWED,ORQDT,ORXSUB
;
S ORSUB="ORPDMP"
K ^TMP(ORSUB,$J)
S ORRESULTS=$NA(^TMP(ORSUB,$J))
S ^TMP(ORSUB,$J,0)=0
I '$$GET^XPAR("ALL","OR PDMP BACKGROUND RETRIEVAL",1,"I") Q
I '$G(DFN) Q
I '$G(ORUSER) S ORUSER=DUZ
;
S ORHOURSBACK=+$$GET^XPAR("ALL","OR PDMP TIME TO CACHE URL",1,"I")
S ORSTARTDT=$$FMADD^XLFDT($$NOW^XLFDT,0,-ORHOURSBACK)
S ORSTATUS=1 ;Report URL is available
S ORVIEWED="NO" ;User never viewed report
S ORQDT=$O(^ORD(101.62,"AC",DFN,ORUSER,ORSTATUS,ORVIEWED,ORSTARTDT))
I 'ORQDT Q
S ORIEN=$O(^ORD(101.62,"AC",DFN,ORUSER,ORSTATUS,ORVIEWED,ORQDT,0))
I 'ORIEN Q
S ORIENQ=$O(^ORD(101.62,"AC",DFN,ORUSER,ORSTATUS,ORVIEWED,ORQDT,ORIEN,0))
I 'ORIENQ Q
;
S ORLOGIENS=ORIENQ_","_ORIEN_","
S ORXSUB="ORPDMP-"_ORLOGIENS
I '$G(^XTMP(ORXSUB,"DATA",0)) Q
I '$G(^XTMP(ORXSUB,"DONE")) Q
I $G(^XTMP(ORXSUB,"DFN"))'=DFN Q
M ^TMP(ORSUB,$J)=^XTMP(ORXSUB,"DATA")
;
Q
;
; Log Query to the PDMP Query Log file
LOGQUERY(DFN,ORDATE,ORUSER,ORCOSIGNER,ORAUTHUSER,ORSTATUS,ORVIEWED) ;
;
N ORIENOUT,ORIENS,ORERR,ORFDA
;
; Root entry - Add new entry if one doesn't already exist for this patient
S ORIENS="?+1,"
S ORFDA(101.62,ORIENS,.01)=DFN
; Query Multiple - Always add new multiple entry
S ORIENS="+2,"_ORIENS
I '$G(ORDATE) S ORDATE=$$NOW^XLFDT
S ORFDA(101.621,ORIENS,.01)=ORDATE
I '$G(ORUSER) S ORUSER=DUZ
S ORFDA(101.621,ORIENS,.02)=ORUSER
I $G(ORCOSIGNER)'="" S ORFDA(101.621,ORIENS,.03)=ORCOSIGNER
I $G(ORAUTHUSER)'="" S ORFDA(101.621,ORIENS,.08)=ORAUTHUSER
I $G(ORSTATUS)'="" S ORFDA(101.621,ORIENS,.04)=ORSTATUS
I $G(ORVIEWED)'="" S ORFDA(101.621,ORIENS,.07)=ORVIEWED
;
L +^ORD(101.62,0):DILOCKTM
D UPDATE^DIE("U","ORFDA","ORIENOUT","ORERR")
L -^ORD(101.62,0)
;
; Return the ORIENS to this query multiple
S ORIENS=ORIENOUT(2)_","_ORIENOUT(1)_","
;
Q ORIENS
;
; Update the entry in the PDMP Query Log file
UPDATELOG(ORIENS,ORSTATUS,ORSHARED,ORQSTATS,ORVIEWED,ORERRINFO,ORSESSION,ORNOTE,ORNOTESTAT,ORFROMREM) ;
;
N ORFDA
;
I $G(ORSTATUS)'="" S ORFDA(101.621,ORIENS,.04)=ORSTATUS
I $G(ORSHARED)'="" S ORFDA(101.621,ORIENS,.05)=ORSHARED
I $G(ORQSTATS)'="" S ORFDA(101.621,ORIENS,.06)=ORQSTATS
I $G(ORVIEWED)'="" S ORFDA(101.621,ORIENS,.07)=ORVIEWED
I $G(ORNOTE)'="" S ORFDA(101.621,ORIENS,.09)=ORNOTE
I $G(ORNOTESTAT)'="" S ORFDA(101.621,ORIENS,.1)=ORNOTESTAT
I $G(ORSESSION)'="" S ORFDA(101.621,ORIENS,.11)=ORSESSION
I $G(ORFROMREM)'="" S ORFDA(101.621,ORIENS,.12)=ORFROMREM
I $G(ORERRINFO)'="",$D(@ORERRINFO) S ORFDA(101.621,ORIENS,1)=ORERRINFO
L +^ORD(101.62,ORIENS):DILOCKTM
D FILE^DIE("","ORFDA")
L -^ORD(101.62,ORIENS)
;
Q
;
;
; Update PDMP Query Log to reflect if user viewed the PDMP report
VIEWEDREPORT(ORRESULT,ORLOGIENS,ORSTATUS,ORNOTE,ORERRINFO) ;
;
N ORD0,ORD1,ORI,ORLINE,ORLOGERR,ORFROMREM
;
I $G(ORLOGIENS)="" D Q
. S ORRESULT="-1^ORLOGIENS is null."
;
I $G(ORSTATUS)="" D Q
. S ORRESULT="-1^ORSTATUS is null."
;
I $O(ORERRINFO(""))'="" D
. S ORD0=$P(ORLOGIENS,",",2)
. S ORD1=$P(ORLOGIENS,",",1)
. S ORLINE=0
. S ORI=0
. F S ORI=$O(^ORD(101.62,ORD0,1,ORD1,1,ORI)) Q:'ORI D
. . S ORLINE=ORLINE+1
. . S ORLOGERR(ORLINE)=$G(^ORD(101.62,ORD0,1,ORD1,1,ORI,0))
. S ORLINE=ORLINE+1
. S ORLOGERR(ORLINE)="Error viewing PDMP report. Error received:"
. S ORI=""
. F S ORI=$O(ORERRINFO(ORI)) Q:ORI="" D
. . S ORLINE=ORLINE+1
. . S ORLOGERR(ORLINE)=$G(ORERRINFO(ORI))
;
I $G(ORNOTE) S ORFROMREM=1
D UPDATELOG(ORLOGIENS,"","","",ORSTATUS,"ORLOGERR","",$G(ORNOTE),"",$G(ORFROMREM))
S ORRESULT=1
;
Q
;
; Does ORUSER have their domain.ext email defined?
HASEMAIL(ORUSER) ;
N OREMAIL
D GETEMAIL(.OREMAIL,ORUSER)
Q $S(OREMAIL'="":1,1:0)
;
;
; Return a user's domain.ext email address (only look at #200,#205.5 as it's standardized by IAM)
GETEMAIL(ORRESULT,ORUSER) ;
;
N OREMAIL
;
S ORRESULT=""
;
S OREMAIL=$$GET1^DIQ(200,ORUSER_",",205.5) ; ICR 7143
I $$LOW^XLFSTR(OREMAIL)["@domain.ext" D Q
. S ORRESULT=OREMAIL
;
Q
;
; Is user a PDMP authorized user?
ISAUTH(ORUSER) ;
;
N ORNPI,ORPERSCLASS,ORVACODE,ORI,ORRETURN,ORLIST
;
; If user has an active DEA #, they are an authorized user.
I $$USERDEA(ORUSER)'="" Q 1
;
; Also, if user has an NPI # and a person class from the OR PDMP PERSON CLASS param
; list they are an authorized user.
;
S ORNPI=$$USERNPI(ORUSER)
I ORNPI="" Q 0 ; Does not have active NPI #
;
; User has NPI #. Now check if they have correct Person Class.
S ORPERSCLASS=$$GET^XUA4A72(ORUSER)
I ORPERSCLASS<1 Q 0 ; Does not have active Person Class
S ORVACODE=$P(ORPERSCLASS,U,7)
I ORVACODE="" Q 0
D GETLST^XPAR(.ORLIST,"ALL","OR PDMP PERSON CLASS","I")
S ORRETURN=0
S ORI=0
F S ORI=$O(ORLIST(ORI)) Q:'ORI D Q:ORRETURN
. I ORVACODE=$G(ORLIST(ORI)) S ORRETURN=1
;
Q ORRETURN
;
;
; Return user's DEA #
USERDEA(ORUSER) ;
;
N ORDEA
;
S ORDEA=$$DEA^XUSER(0,ORUSER)
I ORDEA["-" S ORDEA=""
Q ORDEA
;
;
; Return user's NPI #
USERNPI(ORUSER) ;
;
N ORNPI
;
S ORNPI=$$NPI^XUSNPI("Individual_ID",ORUSER)
I ORNPI<1!($P(ORNPI,U,3)'="Active") Q ""
Q $P(ORNPI,U,1)
;
;
; Return Institution's DEA #
INSTDEA(ORINST) ;
;
N ORDEA,ORARR
;
S ORDEA=$$GET1^DIQ(4,ORINST_",",52) ; ICR 10090 (supported)
;
Q ORDEA
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPDMP 16199 printed Dec 13, 2024@02:32:26 Page 2
ORPDMP ;SLC/AGP - PDMP Code ;Jul 10, 2023@14:58:48
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**519,405,588**;Dec 17, 1997;Build 29
+2 ; SAC EXEMPTION 20200131-02 : Vendor Specific Code is used
+3 ; SAC EXEMPTION 202211140901-02 : Non-standard $Z special variable used
+4 ; Reference to ^VA(200, in ICR #7143
+5 ; Reference to REQCOS^TIUSRVA in ICR #5541
+6 ;
+7 QUIT
+8 ;
+9 ; Returns parameters
GETPAR(ORRESULTS,ORUSER) ;
+1 ;
+2 NEW ORNOTE,ORREQCOSIG
+3 ;
+4 SET ORRESULTS("PDMP","turnedOn")=+$$GET^XPAR("ALL","OR PDMP TURN ON",1,"I")
+5 ; Check if Note write access is disabled
+6 IF ORRESULTS("PDMP","turnedOn")
IF '$$GET^XPAR("ALL","OR CPRS TABS WRITE ACCESS","N")
SET ORRESULTS("PDMP","turnedOn")=0
+7 SET ORRESULTS("PDMP","delegateFeatureEnabled")=+$$GET^XPAR("ALL","OR PDMP DELEGATION ENABLED",1,"I")
+8 SET ORRESULTS("PDMP","useDefaultBrowser")=+$$GET^XPAR("ALL","OR PDMP USE DEFAULT BROWSER",1,"I")
+9 SET ORRESULTS("PDMP","pollingInterval")=+$$GET^XPAR("ALL","OR PDMP POLLING INTERVAL",1,"I")
+10 SET ORRESULTS("PDMP","showButton")="ALWAYS"
+11 SET ORRESULTS("PDMP","daysBetweenReview")=+$$GET^XPAR("ALL","OR PDMP DAYS BETWEEN REVIEWS",1,"I")
+12 SET ORRESULTS("PDMP","commentLimit")=+$$GET^XPAR("ALL","OR PDMP COMMENT LIMIT",1,"I")
+13 SET ORRESULTS("PDMP","pasteEnabled")=+$$GET^XPAR("ALL","OR PDMP COPY/PASTE ENABLED",1,"I")
+14 SET ORRESULTS("PDMP","isAuthorizedUser")=$$ISAUTH(ORUSER)
+15 SET ORRESULTS("PDMP","backgroundRetrieval")=+$$GET^XPAR("ALL","OR PDMP BACKGROUND RETRIEVAL",1,"I")
+16 SET ORNOTE=$$GETNOTE^ORPDMPNT()
+17 SET ORRESULTS("PDMP","validNoteTitle")=$SELECT(ORNOTE>0:1,1:0)
+18 SET ORRESULTS("PDMP","noteTitle")=$SELECT(ORNOTE>0:ORNOTE,1:"")
+19 ; ICR 5541
DO REQCOS^TIUSRVA(.ORREQCOSIG,ORNOTE,0,ORUSER,$$NOW^XLFDT)
+20 SET ORRESULTS("PDMP","requiresCosigner")=ORREQCOSIG
+21 ;
+22 QUIT
+23 ;
+24 ;
+25 ; Entry point to initiate PDMP Query
STRTPDMP(ORRESULTS,ORUSER,ORCOSIGNER,DFN,ORVSTR) ;
+1 ;
+2 ; Returns:
+3 ; If there was an error initiating the query
+4 ; @ORRESULTS@(0) = -1
+5 ; @ORRESULTS@(1) = Error message
+6 ;
+7 ; If query is tasked to run in the background
+8 ; @ORRESULTS@(0) = 0^Handle - (Pass in Handle to CHKTASK to check status of tasked job)
+9 ;
+10 ; If query ran in the foreground, will return the same format as RETPDMP
+11 ;
+12 NEW OREMAIL,ORAUTHUSER,ORLASTCHECKED,ORLOGIENS,ORRESULT,ORSUB
+13 ;
+14 SET ORSUB="ORPDMP"
+15 KILL ^TMP(ORSUB,$JOB)
+16 SET ORRESULTS=$NAME(^TMP(ORSUB,$JOB))
+17 ;
+18 IF '$GET(ORUSER)
SET ORUSER=DUZ
+19 SET ORCOSIGNER=$GET(ORCOSIGNER)
+20 SET ORAUTHUSER=$$ISAUTH(ORUSER)
+21 IF ORUSER=ORCOSIGNER
SET ORCOSIGNER=""
+22 ;
+23 IF '$GET(DFN)
Begin DoDot:1
+24 SET ^TMP(ORSUB,$JOB,0)="-1"
+25 SET ^TMP(ORSUB,$JOB,1)="DFN is null."
End DoDot:1
QUIT
+26 IF $GET(ORVSTR)=""
Begin DoDot:1
+27 SET ^TMP(ORSUB,$JOB,0)="-1"
+28 SET ^TMP(ORSUB,$JOB,1)="ORVSTR is null."
End DoDot:1
QUIT
+29 ;
+30 ; Check if PDMP is enabled
+31 IF '$$GET^XPAR("ALL","OR PDMP TURN ON",1,"I")
Begin DoDot:1
+32 SET ^TMP(ORSUB,$JOB,0)="-1"
+33 SET ^TMP(ORSUB,$JOB,1)="The PDMP functionality has been DISABLED."
End DoDot:1
QUIT
+34 ;
+35 ; Check if Note write access is disabled
+36 IF '$$GET^XPAR("ALL","OR CPRS TABS WRITE ACCESS","N")
Begin DoDot:1
+37 SET ^TMP(ORSUB,$JOB,0)="-1"
+38 SET ^TMP(ORSUB,$JOB,1)="CPRS write access for 'Notes' has been disabled."
End DoDot:1
QUIT
+39 ;
+40 IF 'ORAUTHUSER
IF '$$GET^XPAR("ALL","OR PDMP DELEGATION ENABLED",1,"I")
Begin DoDot:1
+41 SET ^TMP(ORSUB,$JOB,0)="-1"
+42 SET ^TMP(ORSUB,$JOB,1)="The PDMP delegate feature has been disabled. Only authorized healthcare providers can run a PDMP query."
End DoDot:1
QUIT
+43 ;
+44 ; If delegate, check if they have an email defined
+45 IF 'ORAUTHUSER
IF '$$HASEMAIL(ORUSER)
Begin DoDot:1
+46 SET ^TMP(ORSUB,$JOB,0)="-1"
+47 SET ^TMP(ORSUB,$JOB,1)="Your VistA account does not have your domain.ext email address defined. You need to have it defined to make a PDMP query as a delegate."
+48 SET ^TMP(ORSUB,$JOB,2)=" "
+49 SET ^TMP(ORSUB,$JOB,3)="You can log back into CPRS using your PIV card to link your VistA account with your PIV card, and that should populate your VistA account with your domain.ext email address."
End DoDot:1
QUIT
+50 ;
+51 ; Check if authorized user, or if delegate, if user chosen is an authorized user
+52 IF 'ORAUTHUSER
IF '$$ISAUTH(+ORCOSIGNER)
Begin DoDot:1
+53 SET ^TMP(ORSUB,$JOB,0)="-1"
+54 SET ^TMP(ORSUB,$JOB,1)="You need to be an authorized healthcare provider to run a PDMP query, or if you are a delegate, you need to select an authorized healthcare provider."
End DoDot:1
QUIT
+55 ;
+56 ; check if PDMP note title exists
+57 IF '$$GETNOTE^ORPDMPNT
Begin DoDot:1
+58 SET ^TMP(ORSUB,$JOB,0)="-1"
+59 SET ^TMP(ORSUB,$JOB,1)="The national PDMP note title needs to be created in order run a PDMP query."
End DoDot:1
QUIT
+60 ;
+61 SET ORLOGIENS=$$LOGQUERY(DFN,$$NOW^XLFDT,ORUSER,ORCOSIGNER,ORAUTHUSER,0,"NO")
+62 ;
+63 ; if set to background retrieval start tasked job
+64 IF +$$GET^XPAR("ALL","OR PDMP BACKGROUND RETRIEVAL",1,"I")
Begin DoDot:1
+65 DO STRTTASK(ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS)
+66 SET ^TMP(ORSUB,$JOB,0)="0^"_ORLOGIENS
End DoDot:1
QUIT
+67 ;
+68 ; otherwise retrieve data directly
+69 DO RETPDMP(ORSUB,ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS)
+70 ;
+71 QUIT
+72 ;
+73 ;
+74 ; Start PDMP query task (for background retrieval)
STRTTASK(ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS) ;
+1 ;
+2 NEW OROTHER,ORTASK,ORXSUB
+3 ;
+4 SET ORXSUB="ORPDMP-"_ORLOGIENS
+5 SET ^XTMP(ORXSUB,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"PDMP Results"
+6 SET ^XTMP(ORXSUB,"DFN")=DFN
+7 SET ^XTMP(ORXSUB,"STARTDT")=$HOROLOG
+8 ;
+9 SET OROTHER("ZTDTH")=$$NOW^XLFDT
+10 SET ORTASK=$$NODEV^XUTMDEVQ("TASKEN^ORPDMP","PDMP Query From CPRS","ORUSER;ORCOSIGNER;DFN;ORVSTR;ORLOGIENS",.OROTHER)
+11 IF ORTASK<0
QUIT
+12 ;
+13 SET ^XTMP(ORXSUB,"TASKNUM")=ORTASK
+14 ;
+15 QUIT
+16 ;
+17 ;
+18 ; Call PDMP query in background task (for background retrieval)
TASKEN ;
+1 ;
+2 ; ZEXCEPT: DFN,ORCOSIGNER,ORVSTR,ORLOGIENS,ORUSER,ZTSTOP
+3 NEW ORSUB,ORXSUB
+4 ;
+5 SET ORSUB="ORPDMP"
+6 KILL ^TMP(ORSUB,$JOB)
+7 ;
+8 IF $$S^%ZTLOAD()
Begin DoDot:1
+9 DO PROCSTOP(ORLOGIENS)
End DoDot:1
QUIT
+10 ;
+11 SET ORXSUB="ORPDMP-"_ORLOGIENS
+12 DO RETPDMP(ORSUB,ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS)
+13 ;
+14 IF $$S^%ZTLOAD()
Begin DoDot:1
+15 DO PROCSTOP(ORLOGIENS)
End DoDot:1
QUIT
+16 ;
+17 IF $DATA(^XTMP(ORXSUB))
Begin DoDot:1
+18 MERGE ^XTMP(ORXSUB,"DATA")=^TMP(ORSUB,$JOB)
+19 SET ^XTMP(ORXSUB,"DONE")=1
End DoDot:1
+20 ;
+21 QUIT
+22 ;
+23 ;
+24 ; Process stop task request
PROCSTOP(ORLOGIENS) ;
+1 ;
+2 ; ZEXCEPT: ZTSTOP
+3 ;
+4 KILL ^XTMP("ORPDMP-"_ORLOGIENS)
+5 ;
+6 SET ZTSTOP=1
+7 ;
+8 QUIT
+9 ;
+10 ;
+11 ; When PDMP is being called in the background, check if the task completed
CHCKTASK(ORRESULTS,DFN,ORLOGIENS) ;
+1 ;
+2 ; Returns:
+3 ; If query is still running
+4 ; @ORRESULTS@(0) = 0^Handle - (query is still running in the background... keep checking back)
+5 ;
+6 ; If there was an error checking on the background task
+7 ; @ORRESULTS@(0) = -1
+8 ; @ORRESULTS@(1) = Error message
+9 ;
+10 ; If background task completed, will return the same format as RETPDMP
+11 ;
+12 NEW ORSUB,ORTASK,ORTASKSTARTDT,ORX,ORXSUB
+13 ;
+14 SET ORSUB="ORPDMP"
+15 KILL ^TMP(ORSUB,$JOB)
+16 SET ORRESULTS=$NAME(^TMP(ORSUB,$JOB))
+17 ;
+18 IF '$GET(DFN)
Begin DoDot:1
+19 SET ^TMP(ORSUB,$JOB,0)="-1"
+20 SET ^TMP(ORSUB,$JOB,1)="DFN is null."
End DoDot:1
QUIT
+21 IF $GET(ORLOGIENS)=""
Begin DoDot:1
+22 SET ^TMP(ORSUB,$JOB,0)="-1"
+23 SET ^TMP(ORSUB,$JOB,1)="ORLOGIENS is null."
End DoDot:1
QUIT
+24 ;
+25 SET ORXSUB="ORPDMP-"_ORLOGIENS
+26 IF '$DATA(^XTMP(ORXSUB))!($GET(^XTMP(ORXSUB,"DFN"))'=DFN)
Begin DoDot:1
+27 SET ^TMP(ORSUB,$JOB,0)=-1
+28 SET ^TMP(ORSUB,$JOB,1)="System Error"
End DoDot:1
QUIT
+29 ;
+30 IF $GET(^XTMP(ORXSUB,"DONE"))=1
Begin DoDot:1
+31 MERGE ^TMP(ORSUB,$JOB)=^XTMP(ORXSUB,"DATA")
+32 ;K ^XTMP(ORXSUB)
End DoDot:1
QUIT
+33 ;
+34 SET ORTASKSTARTDT=$GET(^XTMP(ORXSUB,"STARTDT"))
+35 IF ORTASKSTARTDT
IF $$HDIFF^XLFDT($HOROLOG,ORTASKSTARTDT,2)>$$GET^XPAR("ALL","OR PDMP TIMEOUT QUERY",1,"I")
Begin DoDot:1
+36 SET ^TMP(ORSUB,$JOB,0)=-1
+37 SET ^TMP(ORSUB,$JOB,1)="PDMP query timed out."
End DoDot:1
QUIT
+38 ;
+39 SET ^TMP(ORSUB,$JOB,0)="0"_U_ORLOGIENS
+40 ;
+41 QUIT
+42 ;
+43 ;
+44 ; Call PDMP Gateway (via web service)
RETPDMP(ORSUB,ORUSER,ORCOSIGNER,DFN,ORVSTR,ORLOGIENS) ;
+1 ;
+2 ; Returns:
+3 ; ^TMP(ORSUB,$J,0) = Status ^ ^ ^ ^ Handle ^ Note Cosigner
+4 ; Note: Status can be one of the following values:
+5 ; -1 - PDMP down, or other reason that didn't even attempt to connect
+6 ; -2 - error connecting
+7 ; -3 - connected - but error returned by PDMP
+8 ; 1 - success
+9 ;
+10 ; For errors (Status < 1):
+11 ; ^TMP(ORSUB,$J,1) = Error Message.
+12 ;
+13 ; For success (Status = 1):
+14 ; ^TMP(ORSUB,$J,1) = Report URL
+15 ; ^TMP(ORSUB,$J,2...n) = Data needed to create the review form.
+16 ;
+17 NEW ORARR,ORAUTHUSER,ORDELEGATEOF,ORFINISH,ORQSTATS,ORRETURN,ORSESSION,ORSHARED,ORSTART,ORSTATUS,ORTRACK,ORVDT,ORVLOC
+18 ;
+19 SET ORVLOC=$PIECE(ORVSTR,";",1)
+20 SET ORVDT=$PIECE(ORVSTR,";",2)
+21 ;
+22 SET ORAUTHUSER=$$ISAUTH(ORUSER)
+23 SET ORDELEGATEOF=ORCOSIGNER
+24 IF ORAUTHUSER
SET ORDELEGATEOF=""
+25 SET ORSTART=$ZH
+26 DO EN^ORPDMPWS(.ORRETURN,DFN,ORUSER,ORDELEGATEOF,$GET(DUZ(2)))
+27 SET ORFINISH=$ZH
+28 ;
+29 SET ORQSTATS=ORFINISH-ORSTART
+30 SET ORQSTATS=+$FNUMBER(ORQSTATS,"",2)
+31 SET ORSTATUS=$PIECE($GET(^TMP(ORSUB,$JOB,0)),U,1)
+32 SET ORSHARED=+$PIECE($GET(^TMP(ORSUB,$JOB,0)),U,2)
+33 SET ORSESSION=$PIECE($GET(^TMP(ORSUB,$JOB,0)),U,3)
+34 DO UPDATELOG(ORLOGIENS,ORSTATUS,ORSHARED,ORQSTATS,"",$NAME(^TMP(ORSUB,$JOB,"ERR")),ORSESSION)
+35 ;
+36 SET ^TMP(ORSUB,$JOB,0)=ORSTATUS
+37 KILL ^TMP(ORSUB,$JOB,"ERR")
+38 ;
+39 IF ORSTATUS=1
Begin DoDot:1
+40 SET $PIECE(^TMP(ORSUB,$JOB,0),U,5,6)=ORLOGIENS_U_ORCOSIGNER
+41 ; return nodes 2...n with data for UI to create review form
+42 IF ORAUTHUSER
Begin DoDot:2
+43 DO RVWFORM(ORSUB,"P",DFN)
End DoDot:2
+44 IF 'ORAUTHUSER
Begin DoDot:2
+45 DO RVWFORM(ORSUB,"D",DFN)
End DoDot:2
End DoDot:1
+46 ;
+47 IF ORSTATUS<0
Begin DoDot:1
+48 SET ORTRACK="VistA "_$EXTRACT(ORLOGIENS,1,$LENGTH(ORLOGIENS)-1)
+49 IF ORSESSION'=""
SET ORTRACK=ORTRACK_". VDIF "_ORSESSION
+50 SET ^TMP(ORSUB,$JOB,1)=$GET(^TMP(ORSUB,$JOB,1))_" ["_ORTRACK_"]"
End DoDot:1
+51 ;
+52 QUIT
+53 ;
+54 ; Return Review Form text
RVWFORM(ORSUB,ORTYPE,DFN) ;
+1 ;
+2 NEW ORARR,ORI,ORJ,ORTEXT,ORLINE,ORERR,ORLASTNOTE,ORREPLACE
+3 ;
+4 SET ORREPLACE("|DAYS|")=+$$GET^XPAR("ALL","OR PDMP DAYS BETWEEN REVIEWS",1,"I")
+5 DO RECNTNOTE^ORPDMPNT(.ORLASTNOTE,DFN)
+6 IF ORLASTNOTE
SET ORREPLACE("|LASTDATE|")=$$FMTE^XLFDT(ORLASTNOTE,"5D")
+7 IF 'ORLASTNOTE
SET ORREPLACE("|LASTDATE|")="none"
+8 ;
+9 DO GETWP^XPAR(.ORARR,"ALL","OR PDMP REVIEW FORM",ORTYPE,.ORERR)
+10 SET ORI=0
+11 SET ORJ=1
+12 SET ORTEXT=""
+13 FOR
SET ORI=$ORDER(ORARR(ORI))
if 'ORI
QUIT
Begin DoDot:1
+14 SET ORLINE=$$TRIM^XLFSTR($GET(ORARR(ORI,0)))
+15 IF ORLINE=""
Begin DoDot:2
+16 IF ORTEXT["|"
SET ORTEXT=$$REPLACE^XLFSTR(ORTEXT,.ORREPLACE)
+17 SET ORJ=ORJ+1
+18 SET ^TMP(ORSUB,$JOB,ORJ)=ORTEXT
+19 SET ORTEXT=""
End DoDot:2
QUIT
+20 SET ORTEXT=ORTEXT_$SELECT(ORTEXT="":"",1:" ")_ORLINE
End DoDot:1
+21 ;
+22 IF ORTEXT'=""
Begin DoDot:1
+23 IF ORTEXT["|"
SET ORTEXT=$$REPLACE^XLFSTR(ORTEXT,.ORREPLACE)
+24 SET ORJ=ORJ+1
+25 SET ^TMP(ORSUB,$JOB,ORJ)=ORTEXT
End DoDot:1
+26 ;
+27 QUIT
+28 ;
+29 ;
+30 ; Request that PDMP task be stopped
STOPTASK(ORRESULTS,ORLOGIENS) ;
+1 ;
+2 NEW ORSUB,ORTASK
+3 ;
+4 SET ORSUB="ORPDMP"
+5 KILL ^TMP(ORSUB,$JOB)
+6 SET ORRESULTS=$NAME(^TMP(ORSUB,$JOB))
+7 ;
+8 IF $GET(ORLOGIENS)=""
Begin DoDot:1
+9 SET ^TMP(ORSUB,$JOB,0)="-1"
+10 SET ^TMP(ORSUB,$JOB,1)="ORLOGIENS is null."
End DoDot:1
QUIT
+11 ;
+12 DO UPDATELOG(ORLOGIENS,"","","","QCANCEL")
+13 ;
+14 SET ORTASK=$GET(^XTMP("ORPDMP-"_ORLOGIENS,"TASKNUM"))
+15 IF 'ORTASK
Begin DoDot:1
+16 SET ORRESULTS=-1
End DoDot:1
QUIT
+17 ;
+18 SET ORRESULTS=$$ASKSTOP^%ZTLOAD(ORTASK)
+19 ;
+20 QUIT
+21 ;
+22 ; Check if there are cached PDMP results for a given patient and user
GETCACHE(ORRESULTS,DFN,ORUSER) ;
+1 ;
+2 ; Returns:
+3 ; If there are no cached results
+4 ; @ORRESULTS@(0) = 0
+5 ;
+6 ; If there are cached results, will return the same format as RETPDMP (although status should always be 1).
+7 ;
+8 NEW ORHOURSBACK,ORIEN,ORIENQ,ORLOGIENS,ORSTARTDT,ORSTATUS,ORSUB,ORVIEWED,ORQDT,ORXSUB
+9 ;
+10 SET ORSUB="ORPDMP"
+11 KILL ^TMP(ORSUB,$JOB)
+12 SET ORRESULTS=$NAME(^TMP(ORSUB,$JOB))
+13 SET ^TMP(ORSUB,$JOB,0)=0
+14 IF '$$GET^XPAR("ALL","OR PDMP BACKGROUND RETRIEVAL",1,"I")
QUIT
+15 IF '$GET(DFN)
QUIT
+16 IF '$GET(ORUSER)
SET ORUSER=DUZ
+17 ;
+18 SET ORHOURSBACK=+$$GET^XPAR("ALL","OR PDMP TIME TO CACHE URL",1,"I")
+19 SET ORSTARTDT=$$FMADD^XLFDT($$NOW^XLFDT,0,-ORHOURSBACK)
+20 ;Report URL is available
SET ORSTATUS=1
+21 ;User never viewed report
SET ORVIEWED="NO"
+22 SET ORQDT=$ORDER(^ORD(101.62,"AC",DFN,ORUSER,ORSTATUS,ORVIEWED,ORSTARTDT))
+23 IF 'ORQDT
QUIT
+24 SET ORIEN=$ORDER(^ORD(101.62,"AC",DFN,ORUSER,ORSTATUS,ORVIEWED,ORQDT,0))
+25 IF 'ORIEN
QUIT
+26 SET ORIENQ=$ORDER(^ORD(101.62,"AC",DFN,ORUSER,ORSTATUS,ORVIEWED,ORQDT,ORIEN,0))
+27 IF 'ORIENQ
QUIT
+28 ;
+29 SET ORLOGIENS=ORIENQ_","_ORIEN_","
+30 SET ORXSUB="ORPDMP-"_ORLOGIENS
+31 IF '$GET(^XTMP(ORXSUB,"DATA",0))
QUIT
+32 IF '$GET(^XTMP(ORXSUB,"DONE"))
QUIT
+33 IF $GET(^XTMP(ORXSUB,"DFN"))'=DFN
QUIT
+34 MERGE ^TMP(ORSUB,$JOB)=^XTMP(ORXSUB,"DATA")
+35 ;
+36 QUIT
+37 ;
+38 ; Log Query to the PDMP Query Log file
LOGQUERY(DFN,ORDATE,ORUSER,ORCOSIGNER,ORAUTHUSER,ORSTATUS,ORVIEWED) ;
+1 ;
+2 NEW ORIENOUT,ORIENS,ORERR,ORFDA
+3 ;
+4 ; Root entry - Add new entry if one doesn't already exist for this patient
+5 SET ORIENS="?+1,"
+6 SET ORFDA(101.62,ORIENS,.01)=DFN
+7 ; Query Multiple - Always add new multiple entry
+8 SET ORIENS="+2,"_ORIENS
+9 IF '$GET(ORDATE)
SET ORDATE=$$NOW^XLFDT
+10 SET ORFDA(101.621,ORIENS,.01)=ORDATE
+11 IF '$GET(ORUSER)
SET ORUSER=DUZ
+12 SET ORFDA(101.621,ORIENS,.02)=ORUSER
+13 IF $GET(ORCOSIGNER)'=""
SET ORFDA(101.621,ORIENS,.03)=ORCOSIGNER
+14 IF $GET(ORAUTHUSER)'=""
SET ORFDA(101.621,ORIENS,.08)=ORAUTHUSER
+15 IF $GET(ORSTATUS)'=""
SET ORFDA(101.621,ORIENS,.04)=ORSTATUS
+16 IF $GET(ORVIEWED)'=""
SET ORFDA(101.621,ORIENS,.07)=ORVIEWED
+17 ;
+18 LOCK +^ORD(101.62,0):DILOCKTM
+19 DO UPDATE^DIE("U","ORFDA","ORIENOUT","ORERR")
+20 LOCK -^ORD(101.62,0)
+21 ;
+22 ; Return the ORIENS to this query multiple
+23 SET ORIENS=ORIENOUT(2)_","_ORIENOUT(1)_","
+24 ;
+25 QUIT ORIENS
+26 ;
+27 ; Update the entry in the PDMP Query Log file
UPDATELOG(ORIENS,ORSTATUS,ORSHARED,ORQSTATS,ORVIEWED,ORERRINFO,ORSESSION,ORNOTE,ORNOTESTAT,ORFROMREM) ;
+1 ;
+2 NEW ORFDA
+3 ;
+4 IF $GET(ORSTATUS)'=""
SET ORFDA(101.621,ORIENS,.04)=ORSTATUS
+5 IF $GET(ORSHARED)'=""
SET ORFDA(101.621,ORIENS,.05)=ORSHARED
+6 IF $GET(ORQSTATS)'=""
SET ORFDA(101.621,ORIENS,.06)=ORQSTATS
+7 IF $GET(ORVIEWED)'=""
SET ORFDA(101.621,ORIENS,.07)=ORVIEWED
+8 IF $GET(ORNOTE)'=""
SET ORFDA(101.621,ORIENS,.09)=ORNOTE
+9 IF $GET(ORNOTESTAT)'=""
SET ORFDA(101.621,ORIENS,.1)=ORNOTESTAT
+10 IF $GET(ORSESSION)'=""
SET ORFDA(101.621,ORIENS,.11)=ORSESSION
+11 IF $GET(ORFROMREM)'=""
SET ORFDA(101.621,ORIENS,.12)=ORFROMREM
+12 IF $GET(ORERRINFO)'=""
IF $DATA(@ORERRINFO)
SET ORFDA(101.621,ORIENS,1)=ORERRINFO
+13 LOCK +^ORD(101.62,ORIENS):DILOCKTM
+14 DO FILE^DIE("","ORFDA")
+15 LOCK -^ORD(101.62,ORIENS)
+16 ;
+17 QUIT
+18 ;
+19 ;
+20 ; Update PDMP Query Log to reflect if user viewed the PDMP report
VIEWEDREPORT(ORRESULT,ORLOGIENS,ORSTATUS,ORNOTE,ORERRINFO) ;
+1 ;
+2 NEW ORD0,ORD1,ORI,ORLINE,ORLOGERR,ORFROMREM
+3 ;
+4 IF $GET(ORLOGIENS)=""
Begin DoDot:1
+5 SET ORRESULT="-1^ORLOGIENS is null."
End DoDot:1
QUIT
+6 ;
+7 IF $GET(ORSTATUS)=""
Begin DoDot:1
+8 SET ORRESULT="-1^ORSTATUS is null."
End DoDot:1
QUIT
+9 ;
+10 IF $ORDER(ORERRINFO(""))'=""
Begin DoDot:1
+11 SET ORD0=$PIECE(ORLOGIENS,",",2)
+12 SET ORD1=$PIECE(ORLOGIENS,",",1)
+13 SET ORLINE=0
+14 SET ORI=0
+15 FOR
SET ORI=$ORDER(^ORD(101.62,ORD0,1,ORD1,1,ORI))
if 'ORI
QUIT
Begin DoDot:2
+16 SET ORLINE=ORLINE+1
+17 SET ORLOGERR(ORLINE)=$GET(^ORD(101.62,ORD0,1,ORD1,1,ORI,0))
End DoDot:2
+18 SET ORLINE=ORLINE+1
+19 SET ORLOGERR(ORLINE)="Error viewing PDMP report. Error received:"
+20 SET ORI=""
+21 FOR
SET ORI=$ORDER(ORERRINFO(ORI))
if ORI=""
QUIT
Begin DoDot:2
+22 SET ORLINE=ORLINE+1
+23 SET ORLOGERR(ORLINE)=$GET(ORERRINFO(ORI))
End DoDot:2
End DoDot:1
+24 ;
+25 IF $GET(ORNOTE)
SET ORFROMREM=1
+26 DO UPDATELOG(ORLOGIENS,"","","",ORSTATUS,"ORLOGERR","",$GET(ORNOTE),"",$GET(ORFROMREM))
+27 SET ORRESULT=1
+28 ;
+29 QUIT
+30 ;
+31 ; Does ORUSER have their domain.ext email defined?
HASEMAIL(ORUSER) ;
+1 NEW OREMAIL
+2 DO GETEMAIL(.OREMAIL,ORUSER)
+3 QUIT $SELECT(OREMAIL'="":1,1:0)
+4 ;
+5 ;
+6 ; Return a user's domain.ext email address (only look at #200,#205.5 as it's standardized by IAM)
GETEMAIL(ORRESULT,ORUSER) ;
+1 ;
+2 NEW OREMAIL
+3 ;
+4 SET ORRESULT=""
+5 ;
+6 ; ICR 7143
SET OREMAIL=$$GET1^DIQ(200,ORUSER_",",205.5)
+7 IF $$LOW^XLFSTR(OREMAIL)["@domain.ext"
Begin DoDot:1
+8 SET ORRESULT=OREMAIL
End DoDot:1
QUIT
+9 ;
+10 QUIT
+11 ;
+12 ; Is user a PDMP authorized user?
ISAUTH(ORUSER) ;
+1 ;
+2 NEW ORNPI,ORPERSCLASS,ORVACODE,ORI,ORRETURN,ORLIST
+3 ;
+4 ; If user has an active DEA #, they are an authorized user.
+5 IF $$USERDEA(ORUSER)'=""
QUIT 1
+6 ;
+7 ; Also, if user has an NPI # and a person class from the OR PDMP PERSON CLASS param
+8 ; list they are an authorized user.
+9 ;
+10 SET ORNPI=$$USERNPI(ORUSER)
+11 ; Does not have active NPI #
IF ORNPI=""
QUIT 0
+12 ;
+13 ; User has NPI #. Now check if they have correct Person Class.
+14 SET ORPERSCLASS=$$GET^XUA4A72(ORUSER)
+15 ; Does not have active Person Class
IF ORPERSCLASS<1
QUIT 0
+16 SET ORVACODE=$PIECE(ORPERSCLASS,U,7)
+17 IF ORVACODE=""
QUIT 0
+18 DO GETLST^XPAR(.ORLIST,"ALL","OR PDMP PERSON CLASS","I")
+19 SET ORRETURN=0
+20 SET ORI=0
+21 FOR
SET ORI=$ORDER(ORLIST(ORI))
if 'ORI
QUIT
Begin DoDot:1
+22 IF ORVACODE=$GET(ORLIST(ORI))
SET ORRETURN=1
End DoDot:1
if ORRETURN
QUIT
+23 ;
+24 QUIT ORRETURN
+25 ;
+26 ;
+27 ; Return user's DEA #
USERDEA(ORUSER) ;
+1 ;
+2 NEW ORDEA
+3 ;
+4 SET ORDEA=$$DEA^XUSER(0,ORUSER)
+5 IF ORDEA["-"
SET ORDEA=""
+6 QUIT ORDEA
+7 ;
+8 ;
+9 ; Return user's NPI #
USERNPI(ORUSER) ;
+1 ;
+2 NEW ORNPI
+3 ;
+4 SET ORNPI=$$NPI^XUSNPI("Individual_ID",ORUSER)
+5 IF ORNPI<1!($PIECE(ORNPI,U,3)'="Active")
QUIT ""
+6 QUIT $PIECE(ORNPI,U,1)
+7 ;
+8 ;
+9 ; Return Institution's DEA #
INSTDEA(ORINST) ;
+1 ;
+2 NEW ORDEA,ORARR
+3 ;
+4 ; ICR 10090 (supported)
SET ORDEA=$$GET1^DIQ(4,ORINST_",",52)
+5 ;
+6 QUIT ORDEA
+7 ;
+8 ;
