- 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 Jan 18, 2025@03:33:36 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 ;