ORPDMPNT ;ISP/LMT - PDMP Note Code ;Dec 06, 2021@15:41
;;3.0;ORDER ENTRY/RESULTS REPORTING;**519,498,405**;Dec 17, 1997;Build 211
;
; This routine uses the following ICRs:
; 4476 - File 8925.1, Field .01, .07 (private)
; 4478 - File 8925.1, Field .04 (private)
; 3375 - MAKE^TIUSRVP (controlled)
; 3062 - MAIN^TIULAPIS (controlled)
;
Q
;
; Create the PDMP note
MAKENOTE(ORRETURN,ORINPUTTXT,ORVDT,ORVLOC,ORVSTR,DFN,ORUSER,ORCOSIGNER,ORERROR,ORERRMSG,ORLOGIENS,ORSHARED) ;
;
; Returns:
; If successfully created note:
; ORRETURN = Note IEN ^ Change Log ^ Date/Time
;
; If there was an error:
; ORRETURN = -1 ^ Error Message
;
N ORCHANGE,ORCNT,ORDATETIME,ORLCNT,ORNOASF,ORNOTETXT,ORTITLE,ORTIUX
;
S ORTITLE=$$GETNOTE
I ORTITLE="" S ORRETURN="-1^Cannot find PDMP note title." Q
I '$G(DFN) S ORRETURN="-1^DFN is required." Q
;
S ORUSER=$G(ORUSER,DUZ)
S ORCOSIGNER=$G(ORCOSIGNER)
S ORVDT=$G(ORVDT)
S ORVLOC=$G(ORVLOC)
S ORVSTR=$G(ORVSTR)
I 'ORVDT,'ORVLOC,'ORVSTR S ORRETURN="-1^Visit info is required." Q
I 'ORVLOC S ORVLOC=$P(ORVSTR,";",1)
I 'ORVDT S ORVDT=$P(ORVSTR,";",2)
S ORERROR=$G(ORERROR)
S ORSHARED=$G(ORSHARED,0)
;
I 'ORSHARED,ORLOGIENS'="" D
. S ORSHARED=+$P($G(^ORD(101.62,+$P(ORLOGIENS,",",2),1,+ORLOGIENS,0)),U,5)
;
S ORDATETIME=$$NOW^XLFDT
S ORNOASF=1
S ORTIUX(1201)=ORDATETIME ; entry date and time
S ORTIUX(1202)=ORUSER ; author
S ORTIUX(1204)=ORUSER ;expected signer
S ORTIUX(1208)=ORCOSIGNER ; expected signer
S ORTIUX(1301)=ORDATETIME ; reference date/time (this can be something other than NOW)
;
D BLDTEXT(.ORNOTETXT,.ORINPUTTXT,ORERROR,.ORERRMSG,ORUSER,ORCOSIGNER,ORSHARED)
S ORCNT=0
S ORLCNT=0
F S ORCNT=$O(ORNOTETXT(ORCNT)) Q:ORCNT'>0 D
. S ORLCNT=ORLCNT+1
. S ORTIUX("TEXT",ORLCNT,0)=$G(ORNOTETXT(ORCNT))
;
D MAKE^TIUSRVP(.ORRETURN,DFN,ORTITLE,ORVDT,ORVLOC,0,.ORTIUX,ORVSTR,"",ORNOASF) ; ICR 3375
I ORRETURN>0 D
. S ORCHANGE=$P($$FMTE^XLFDT(ORVDT,2),"@")
. S ORCHANGE=ORCHANGE_" "_$P(^TIU(8925.1,+ORTITLE,0),U)_", "_$P($G(^SC(+ORVLOC,0)),U)_" "_$$TITLE^XLFSTR($P(^VA(200,ORUSER,0),U)) ; ICRs 4476, 10040, 10060
. S ORRETURN=ORRETURN_U_ORCHANGE_U_ORDATETIME
. I $G(ORLOGIENS)'="" D UPDATELOG^ORPDMP(ORLOGIENS,"","","","","","",+ORRETURN)
;
Q
;
; Return the PDMP note title IEN
GETNOTE() ;
;
N ORTITLE
;
S ORTITLE=$$GET^XPAR("ALL","OR PDMP NOTE TITLE",1,"I")
I ORTITLE'>0 Q ""
;Request needed for ICR 2321
I $P($G(^TIU(8925.1,+ORTITLE,0)),U,4)'="DOC" Q "" ; ICR 4478
I +$$GET1^DIQ(8925.1,ORTITLE,.07,"I")'=11 Q "" ; ICR 4476
;
Q ORTITLE
;
; Build the note text
BLDTEXT(ORNOTETXT,ORINPUTTXT,ORERROR,ORERRMSG,ORUSER,ORCOSIGNER,ORSHARED) ;
;
N DIWF,DIWL,DIWR,ORAUTHUSER,ORI,ORLINE,ORNAME,ORNAMEC,ORTXT,X
;
S ORAUTHUSER=$$ISAUTH^ORPDMP(ORUSER)
;
S ORLINE=0
;
; Add who submitted the query.
S ORNAME=$$NAME^XUSER(ORUSER,"F")
I ORAUTHUSER S ORTXT="This PDMP query was submitted by "_ORNAME_"."
I 'ORAUTHUSER,ORCOSIGNER D
. S ORNAMEC=$$NAME^XUSER(ORCOSIGNER,"F")
. S ORTXT="This PDMP query was submitted by "_ORNAME_" on behalf of "_ORNAMEC_"."
; Format line for 80-char
K ^UTILITY($J,"W")
S DIWL=1
S DIWR=80
S X=$G(ORTXT)
D ^DIWP
S ORI=0
F S ORI=$O(^UTILITY($J,"W",1,ORI)) Q:'ORI D
. S ORTXT=$G(^UTILITY($J,"W",1,ORI,0))
. I ORTXT="" Q
. S ORLINE=ORLINE+1
. S ORNOTETXT(ORLINE)=ORTXT
K ^UTILITY($J,"W")
;
; Add Justification/Reason text to note
D GETTXT(.ORNOTETXT,.ORLINE,"R",1)
;
; Add Disclosure text to note
I ORSHARED D
. D GETTXT(.ORNOTETXT,.ORLINE,"D",1)
;
; Add Delegate Canned Statement to Note
I 'ORAUTHUSER,'ORERROR D
. D GETTXT(.ORNOTETXT,.ORLINE,"CD",1)
;
I $O(ORINPUTTXT(0)),'ORERROR D
. S ORLINE=ORLINE+1
. S ORNOTETXT(ORLINE)=""
. S ORI=0
. F S ORI=$O(ORINPUTTXT(ORI)) Q:'ORI D
. . S ORLINE=ORLINE+1
. . S ORNOTETXT(ORLINE)=ORINPUTTXT(ORI)
;
; If error, add error text to note
I ORERROR D
. D GETTXT(.ORNOTETXT,.ORLINE,"E",1)
. I $D(ORERRMSG) D
. . S ORI=0
. . F S ORI=$O(ORERRMSG(ORI)) Q:'ORI D
. . . S ORLINE=ORLINE+1
. . . S ORNOTETXT(ORLINE)=$G(ORERRMSG(ORI))
;
Q
;
; Get canned text from OR PDMP NOTE TEXT parameter
GETTXT(ORNOTETXT,ORLINE,ORTYPE,ORADDLINE) ;
;
N ORI,ORARR,ORERR
;
D GETWP^XPAR(.ORARR,"ALL","OR PDMP NOTE TEXT",ORTYPE,.ORERR)
;
I '$D(ORARR) Q
;
I $G(ORADDLINE)>0 D
. F ORI=1:1:ORADDLINE D
. . S ORLINE=ORLINE+1
. . S ORNOTETXT(ORLINE)=""
;
S ORI=0
F S ORI=$O(ORARR(ORI)) Q:'ORI D
. S ORLINE=ORLINE+1
. S ORNOTETXT(ORLINE)=ORARR(ORI,0)
;
Q
;
; Get the most recent date a PDMP note was completed for a patient
RECNTNOTE(ORRETURN,DFN) ;
;
N ORDATE,ORDOC,ORSTATUS
;
S ORSTATUS="COMPLETED"
S ORDOC(1)=$$GETNOTE
K ^TMP("TIU",$J)
D MAIN^TIULAPIS(DFN,.ORDOC,.ORSTATUS,,,1,0) ; ICR 3062
S ORDATE=$O(^TMP("TIU",$J,0))
I ORDATE S ORDATE=9999999-ORDATE
K ^TMP("TIU",$J)
S ORRETURN=ORDATE
;
Q
;
; If note was deleted, retracted, or reassigned delete the pointer to the Note from the PDMP Query Log
DOCACT ; Queue processor for TIU DOCUMENT ACTION
;
N ORACT,ORDOC,ORIEN,ORIEN1,ORLOGIENS,ORSUB
;
S ORSUB="TIUDOCACT"
Q:'$D(^TMP(ORSUB,$J))
;
N $ET,$ES
S $ET="D UNEXPERR^ORPDMPNT"
;
S ORACT=$G(^TMP(ORSUB,$J,"ACTION"))
S ORACT=$S(ORACT="DELETE":"D",ORACT="RETRACT":"R",ORACT="REASSIGN":"A",1:"")
I ORACT="" Q
I ORACT'="A" S ORDOC=+$G(^TMP(ORSUB,$J,"DOCUMENT"))
I ORACT="A" S ORDOC=+$G(^TMP(ORSUB,$J,"DOCUMENT","OLD"))
I '$G(ORDOC) Q
;
S ORIEN=0
F S ORIEN=$O(^ORD(101.62,"AT",ORDOC,ORIEN)) Q:'ORIEN D
. S ORIEN1=0
. F S ORIEN1=$O(^ORD(101.62,"AT",ORDOC,ORIEN,ORIEN1)) Q:'ORIEN1 D
. . S ORLOGIENS=ORIEN1_","_ORIEN_","
. . D UPDATELOG^ORPDMP(ORLOGIENS,"","","","","","","@",ORACT)
;
Q
;
; Unexpected error handler during DOACT
UNEXPERR ;
;ZEXCEPT: ORSUB
N %ZT,%ZTERROR
S %ZT($NA(^TMP(ORSUB,$J)))=""
D ^%ZTER ;file error
S $ECODE=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPDMPNT 6055 printed Dec 13, 2024@02:32:28 Page 2
ORPDMPNT ;ISP/LMT - PDMP Note Code ;Dec 06, 2021@15:41
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**519,498,405**;Dec 17, 1997;Build 211
+2 ;
+3 ; This routine uses the following ICRs:
+4 ; 4476 - File 8925.1, Field .01, .07 (private)
+5 ; 4478 - File 8925.1, Field .04 (private)
+6 ; 3375 - MAKE^TIUSRVP (controlled)
+7 ; 3062 - MAIN^TIULAPIS (controlled)
+8 ;
+9 QUIT
+10 ;
+11 ; Create the PDMP note
MAKENOTE(ORRETURN,ORINPUTTXT,ORVDT,ORVLOC,ORVSTR,DFN,ORUSER,ORCOSIGNER,ORERROR,ORERRMSG,ORLOGIENS,ORSHARED) ;
+1 ;
+2 ; Returns:
+3 ; If successfully created note:
+4 ; ORRETURN = Note IEN ^ Change Log ^ Date/Time
+5 ;
+6 ; If there was an error:
+7 ; ORRETURN = -1 ^ Error Message
+8 ;
+9 NEW ORCHANGE,ORCNT,ORDATETIME,ORLCNT,ORNOASF,ORNOTETXT,ORTITLE,ORTIUX
+10 ;
+11 SET ORTITLE=$$GETNOTE
+12 IF ORTITLE=""
SET ORRETURN="-1^Cannot find PDMP note title."
QUIT
+13 IF '$GET(DFN)
SET ORRETURN="-1^DFN is required."
QUIT
+14 ;
+15 SET ORUSER=$GET(ORUSER,DUZ)
+16 SET ORCOSIGNER=$GET(ORCOSIGNER)
+17 SET ORVDT=$GET(ORVDT)
+18 SET ORVLOC=$GET(ORVLOC)
+19 SET ORVSTR=$GET(ORVSTR)
+20 IF 'ORVDT
IF 'ORVLOC
IF 'ORVSTR
SET ORRETURN="-1^Visit info is required."
QUIT
+21 IF 'ORVLOC
SET ORVLOC=$PIECE(ORVSTR,";",1)
+22 IF 'ORVDT
SET ORVDT=$PIECE(ORVSTR,";",2)
+23 SET ORERROR=$GET(ORERROR)
+24 SET ORSHARED=$GET(ORSHARED,0)
+25 ;
+26 IF 'ORSHARED
IF ORLOGIENS'=""
Begin DoDot:1
+27 SET ORSHARED=+$PIECE($GET(^ORD(101.62,+$PIECE(ORLOGIENS,",",2),1,+ORLOGIENS,0)),U,5)
End DoDot:1
+28 ;
+29 SET ORDATETIME=$$NOW^XLFDT
+30 SET ORNOASF=1
+31 ; entry date and time
SET ORTIUX(1201)=ORDATETIME
+32 ; author
SET ORTIUX(1202)=ORUSER
+33 ;expected signer
SET ORTIUX(1204)=ORUSER
+34 ; expected signer
SET ORTIUX(1208)=ORCOSIGNER
+35 ; reference date/time (this can be something other than NOW)
SET ORTIUX(1301)=ORDATETIME
+36 ;
+37 DO BLDTEXT(.ORNOTETXT,.ORINPUTTXT,ORERROR,.ORERRMSG,ORUSER,ORCOSIGNER,ORSHARED)
+38 SET ORCNT=0
+39 SET ORLCNT=0
+40 FOR
SET ORCNT=$ORDER(ORNOTETXT(ORCNT))
if ORCNT'>0
QUIT
Begin DoDot:1
+41 SET ORLCNT=ORLCNT+1
+42 SET ORTIUX("TEXT",ORLCNT,0)=$GET(ORNOTETXT(ORCNT))
End DoDot:1
+43 ;
+44 ; ICR 3375
DO MAKE^TIUSRVP(.ORRETURN,DFN,ORTITLE,ORVDT,ORVLOC,0,.ORTIUX,ORVSTR,"",ORNOASF)
+45 IF ORRETURN>0
Begin DoDot:1
+46 SET ORCHANGE=$PIECE($$FMTE^XLFDT(ORVDT,2),"@")
+47 ; ICRs 4476, 10040, 10060
SET ORCHANGE=ORCHANGE_" "_$PIECE(^TIU(8925.1,+ORTITLE,0),U)_", "_$PIECE($GET(^SC(+ORVLOC,0)),U)_" "_$$TITLE^XLFSTR($PIECE(^VA(200,ORUSER,0),U))
+48 SET ORRETURN=ORRETURN_U_ORCHANGE_U_ORDATETIME
+49 IF $GET(ORLOGIENS)'=""
DO UPDATELOG^ORPDMP(ORLOGIENS,"","","","","","",+ORRETURN)
End DoDot:1
+50 ;
+51 QUIT
+52 ;
+53 ; Return the PDMP note title IEN
GETNOTE() ;
+1 ;
+2 NEW ORTITLE
+3 ;
+4 SET ORTITLE=$$GET^XPAR("ALL","OR PDMP NOTE TITLE",1,"I")
+5 IF ORTITLE'>0
QUIT ""
+6 ;Request needed for ICR 2321
+7 ; ICR 4478
IF $PIECE($GET(^TIU(8925.1,+ORTITLE,0)),U,4)'="DOC"
QUIT ""
+8 ; ICR 4476
IF +$$GET1^DIQ(8925.1,ORTITLE,.07,"I")'=11
QUIT ""
+9 ;
+10 QUIT ORTITLE
+11 ;
+12 ; Build the note text
BLDTEXT(ORNOTETXT,ORINPUTTXT,ORERROR,ORERRMSG,ORUSER,ORCOSIGNER,ORSHARED) ;
+1 ;
+2 NEW DIWF,DIWL,DIWR,ORAUTHUSER,ORI,ORLINE,ORNAME,ORNAMEC,ORTXT,X
+3 ;
+4 SET ORAUTHUSER=$$ISAUTH^ORPDMP(ORUSER)
+5 ;
+6 SET ORLINE=0
+7 ;
+8 ; Add who submitted the query.
+9 SET ORNAME=$$NAME^XUSER(ORUSER,"F")
+10 IF ORAUTHUSER
SET ORTXT="This PDMP query was submitted by "_ORNAME_"."
+11 IF 'ORAUTHUSER
IF ORCOSIGNER
Begin DoDot:1
+12 SET ORNAMEC=$$NAME^XUSER(ORCOSIGNER,"F")
+13 SET ORTXT="This PDMP query was submitted by "_ORNAME_" on behalf of "_ORNAMEC_"."
End DoDot:1
+14 ; Format line for 80-char
+15 KILL ^UTILITY($JOB,"W")
+16 SET DIWL=1
+17 SET DIWR=80
+18 SET X=$GET(ORTXT)
+19 DO ^DIWP
+20 SET ORI=0
+21 FOR
SET ORI=$ORDER(^UTILITY($JOB,"W",1,ORI))
if 'ORI
QUIT
Begin DoDot:1
+22 SET ORTXT=$GET(^UTILITY($JOB,"W",1,ORI,0))
+23 IF ORTXT=""
QUIT
+24 SET ORLINE=ORLINE+1
+25 SET ORNOTETXT(ORLINE)=ORTXT
End DoDot:1
+26 KILL ^UTILITY($JOB,"W")
+27 ;
+28 ; Add Justification/Reason text to note
+29 DO GETTXT(.ORNOTETXT,.ORLINE,"R",1)
+30 ;
+31 ; Add Disclosure text to note
+32 IF ORSHARED
Begin DoDot:1
+33 DO GETTXT(.ORNOTETXT,.ORLINE,"D",1)
End DoDot:1
+34 ;
+35 ; Add Delegate Canned Statement to Note
+36 IF 'ORAUTHUSER
IF 'ORERROR
Begin DoDot:1
+37 DO GETTXT(.ORNOTETXT,.ORLINE,"CD",1)
End DoDot:1
+38 ;
+39 IF $ORDER(ORINPUTTXT(0))
IF 'ORERROR
Begin DoDot:1
+40 SET ORLINE=ORLINE+1
+41 SET ORNOTETXT(ORLINE)=""
+42 SET ORI=0
+43 FOR
SET ORI=$ORDER(ORINPUTTXT(ORI))
if 'ORI
QUIT
Begin DoDot:2
+44 SET ORLINE=ORLINE+1
+45 SET ORNOTETXT(ORLINE)=ORINPUTTXT(ORI)
End DoDot:2
End DoDot:1
+46 ;
+47 ; If error, add error text to note
+48 IF ORERROR
Begin DoDot:1
+49 DO GETTXT(.ORNOTETXT,.ORLINE,"E",1)
+50 IF $DATA(ORERRMSG)
Begin DoDot:2
+51 SET ORI=0
+52 FOR
SET ORI=$ORDER(ORERRMSG(ORI))
if 'ORI
QUIT
Begin DoDot:3
+53 SET ORLINE=ORLINE+1
+54 SET ORNOTETXT(ORLINE)=$GET(ORERRMSG(ORI))
End DoDot:3
End DoDot:2
End DoDot:1
+55 ;
+56 QUIT
+57 ;
+58 ; Get canned text from OR PDMP NOTE TEXT parameter
GETTXT(ORNOTETXT,ORLINE,ORTYPE,ORADDLINE) ;
+1 ;
+2 NEW ORI,ORARR,ORERR
+3 ;
+4 DO GETWP^XPAR(.ORARR,"ALL","OR PDMP NOTE TEXT",ORTYPE,.ORERR)
+5 ;
+6 IF '$DATA(ORARR)
QUIT
+7 ;
+8 IF $GET(ORADDLINE)>0
Begin DoDot:1
+9 FOR ORI=1:1:ORADDLINE
Begin DoDot:2
+10 SET ORLINE=ORLINE+1
+11 SET ORNOTETXT(ORLINE)=""
End DoDot:2
End DoDot:1
+12 ;
+13 SET ORI=0
+14 FOR
SET ORI=$ORDER(ORARR(ORI))
if 'ORI
QUIT
Begin DoDot:1
+15 SET ORLINE=ORLINE+1
+16 SET ORNOTETXT(ORLINE)=ORARR(ORI,0)
End DoDot:1
+17 ;
+18 QUIT
+19 ;
+20 ; Get the most recent date a PDMP note was completed for a patient
RECNTNOTE(ORRETURN,DFN) ;
+1 ;
+2 NEW ORDATE,ORDOC,ORSTATUS
+3 ;
+4 SET ORSTATUS="COMPLETED"
+5 SET ORDOC(1)=$$GETNOTE
+6 KILL ^TMP("TIU",$JOB)
+7 ; ICR 3062
DO MAIN^TIULAPIS(DFN,.ORDOC,.ORSTATUS,,,1,0)
+8 SET ORDATE=$ORDER(^TMP("TIU",$JOB,0))
+9 IF ORDATE
SET ORDATE=9999999-ORDATE
+10 KILL ^TMP("TIU",$JOB)
+11 SET ORRETURN=ORDATE
+12 ;
+13 QUIT
+14 ;
+15 ; If note was deleted, retracted, or reassigned delete the pointer to the Note from the PDMP Query Log
DOCACT ; Queue processor for TIU DOCUMENT ACTION
+1 ;
+2 NEW ORACT,ORDOC,ORIEN,ORIEN1,ORLOGIENS,ORSUB
+3 ;
+4 SET ORSUB="TIUDOCACT"
+5 if '$DATA(^TMP(ORSUB,$JOB))
QUIT
+6 ;
+7 NEW $ETRAP,$ESTACK
+8 SET $ETRAP="D UNEXPERR^ORPDMPNT"
+9 ;
+10 SET ORACT=$GET(^TMP(ORSUB,$JOB,"ACTION"))
+11 SET ORACT=$SELECT(ORACT="DELETE":"D",ORACT="RETRACT":"R",ORACT="REASSIGN":"A",1:"")
+12 IF ORACT=""
QUIT
+13 IF ORACT'="A"
SET ORDOC=+$GET(^TMP(ORSUB,$JOB,"DOCUMENT"))
+14 IF ORACT="A"
SET ORDOC=+$GET(^TMP(ORSUB,$JOB,"DOCUMENT","OLD"))
+15 IF '$GET(ORDOC)
QUIT
+16 ;
+17 SET ORIEN=0
+18 FOR
SET ORIEN=$ORDER(^ORD(101.62,"AT",ORDOC,ORIEN))
if 'ORIEN
QUIT
Begin DoDot:1
+19 SET ORIEN1=0
+20 FOR
SET ORIEN1=$ORDER(^ORD(101.62,"AT",ORDOC,ORIEN,ORIEN1))
if 'ORIEN1
QUIT
Begin DoDot:2
+21 SET ORLOGIENS=ORIEN1_","_ORIEN_","
+22 DO UPDATELOG^ORPDMP(ORLOGIENS,"","","","","","","@",ORACT)
End DoDot:2
End DoDot:1
+23 ;
+24 QUIT
+25 ;
+26 ; Unexpected error handler during DOACT
UNEXPERR ;
+1 ;ZEXCEPT: ORSUB
+2 NEW %ZT,%ZTERROR
+3 SET %ZT($NAME(^TMP(ORSUB,$JOB)))=""
+4 ;file error
DO ^%ZTER
+5 SET $ECODE=""
+6 QUIT
