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

ORPDMPNT.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; This routine uses the following ICRs:
  1.  ;   4476 - File 8925.1, Field .01, .07   (private)
  1.  ;   4478 - File 8925.1, Field .04        (private)
  1.  ;   3375 - MAKE^TIUSRVP                  (controlled)
  1.  ;   3062 - MAIN^TIULAPIS                 (controlled)
  1.  ;
  1.  Q
  1.  ;
  1.  ; Create the PDMP note
  1. MAKENOTE(ORRETURN,ORINPUTTXT,ORVDT,ORVLOC,ORVSTR,DFN,ORUSER,ORCOSIGNER,ORERROR,ORERRMSG,ORLOGIENS,ORSHARED) ;
  1.  ;
  1.  ; Returns:
  1.  ;   If successfully created note:
  1.  ;     ORRETURN = Note IEN ^ Change Log ^ Date/Time
  1.  ;
  1.  ;   If there was an error:
  1.  ;     ORRETURN = -1 ^ Error Message
  1.  ;
  1.  N ORCHANGE,ORCNT,ORDATETIME,ORLCNT,ORNOASF,ORNOTETXT,ORTITLE,ORTIUX
  1.  ;
  1.  S ORTITLE=$$GETNOTE
  1.  I ORTITLE="" S ORRETURN="-1^Cannot find PDMP note title." Q
  1.  I '$G(DFN) S ORRETURN="-1^DFN is required." Q
  1.  ;
  1.  S ORUSER=$G(ORUSER,DUZ)
  1.  S ORCOSIGNER=$G(ORCOSIGNER)
  1.  S ORVDT=$G(ORVDT)
  1.  S ORVLOC=$G(ORVLOC)
  1.  S ORVSTR=$G(ORVSTR)
  1.  I 'ORVDT,'ORVLOC,'ORVSTR S ORRETURN="-1^Visit info is required." Q
  1.  I 'ORVLOC S ORVLOC=$P(ORVSTR,";",1)
  1.  I 'ORVDT S ORVDT=$P(ORVSTR,";",2)
  1.  S ORERROR=$G(ORERROR)
  1.  S ORSHARED=$G(ORSHARED,0)
  1.  ;
  1.  I 'ORSHARED,ORLOGIENS'="" D
  1.  . S ORSHARED=+$P($G(^ORD(101.62,+$P(ORLOGIENS,",",2),1,+ORLOGIENS,0)),U,5)
  1.  ;
  1.  S ORDATETIME=$$NOW^XLFDT
  1.  S ORNOASF=1
  1.  S ORTIUX(1201)=ORDATETIME ; entry date and time
  1.  S ORTIUX(1202)=ORUSER ; author
  1.  S ORTIUX(1204)=ORUSER ;expected signer
  1.  S ORTIUX(1208)=ORCOSIGNER ; expected signer
  1.  S ORTIUX(1301)=ORDATETIME ; reference date/time (this can be something other than NOW)
  1.  ;
  1.  D BLDTEXT(.ORNOTETXT,.ORINPUTTXT,ORERROR,.ORERRMSG,ORUSER,ORCOSIGNER,ORSHARED)
  1.  S ORCNT=0
  1.  S ORLCNT=0
  1.  F  S ORCNT=$O(ORNOTETXT(ORCNT)) Q:ORCNT'>0  D
  1.  . S ORLCNT=ORLCNT+1
  1.  . S ORTIUX("TEXT",ORLCNT,0)=$G(ORNOTETXT(ORCNT))
  1.  ;
  1.  D MAKE^TIUSRVP(.ORRETURN,DFN,ORTITLE,ORVDT,ORVLOC,0,.ORTIUX,ORVSTR,"",ORNOASF)  ; ICR 3375
  1.  I ORRETURN>0 D
  1.  . S ORCHANGE=$P($$FMTE^XLFDT(ORVDT,2),"@")
  1.  . 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
  1.  . S ORRETURN=ORRETURN_U_ORCHANGE_U_ORDATETIME
  1.  . I $G(ORLOGIENS)'="" D UPDATELOG^ORPDMP(ORLOGIENS,"","","","","","",+ORRETURN)
  1.  ;
  1.  Q
  1.  ;
  1.  ; Return the PDMP note title IEN
  1. GETNOTE() ;
  1.  ;
  1.  N ORTITLE
  1.  ;
  1.  S ORTITLE=$$GET^XPAR("ALL","OR PDMP NOTE TITLE",1,"I")
  1.  I ORTITLE'>0 Q ""
  1.  ;Request needed for ICR 2321
  1.  I $P($G(^TIU(8925.1,+ORTITLE,0)),U,4)'="DOC" Q ""  ; ICR 4478
  1.  I +$$GET1^DIQ(8925.1,ORTITLE,.07,"I")'=11 Q ""  ; ICR 4476
  1.  ;
  1.  Q ORTITLE
  1.  ;
  1.  ; Build the note text
  1. BLDTEXT(ORNOTETXT,ORINPUTTXT,ORERROR,ORERRMSG,ORUSER,ORCOSIGNER,ORSHARED) ;
  1.  ;
  1.  N DIWF,DIWL,DIWR,ORAUTHUSER,ORI,ORLINE,ORNAME,ORNAMEC,ORTXT,X
  1.  ;
  1.  S ORAUTHUSER=$$ISAUTH^ORPDMP(ORUSER)
  1.  ;
  1.  S ORLINE=0
  1.  ;
  1.  ; Add who submitted the query.
  1.  S ORNAME=$$NAME^XUSER(ORUSER,"F")
  1.  I ORAUTHUSER S ORTXT="This PDMP query was submitted by "_ORNAME_"."
  1.  I 'ORAUTHUSER,ORCOSIGNER D
  1.  . S ORNAMEC=$$NAME^XUSER(ORCOSIGNER,"F")
  1.  . S ORTXT="This PDMP query was submitted by "_ORNAME_" on behalf of "_ORNAMEC_"."
  1.  ; Format line for 80-char
  1.  K ^UTILITY($J,"W")
  1.  S DIWL=1
  1.  S DIWR=80
  1.  S X=$G(ORTXT)
  1.  D ^DIWP
  1.  S ORI=0
  1.  F  S ORI=$O(^UTILITY($J,"W",1,ORI)) Q:'ORI  D
  1.  . S ORTXT=$G(^UTILITY($J,"W",1,ORI,0))
  1.  . I ORTXT="" Q
  1.  . S ORLINE=ORLINE+1
  1.  . S ORNOTETXT(ORLINE)=ORTXT
  1.  K ^UTILITY($J,"W")
  1.  ;
  1.  ; Add Justification/Reason text to note
  1.  D GETTXT(.ORNOTETXT,.ORLINE,"R",1)
  1.  ;
  1.  ; Add Disclosure text to note
  1.  I ORSHARED D
  1.  . D GETTXT(.ORNOTETXT,.ORLINE,"D",1)
  1.  ;
  1.  ; Add Delegate Canned Statement to Note
  1.  I 'ORAUTHUSER,'ORERROR D
  1.  . D GETTXT(.ORNOTETXT,.ORLINE,"CD",1)
  1.  ;
  1.  I $O(ORINPUTTXT(0)),'ORERROR D
  1.  . S ORLINE=ORLINE+1
  1.  . S ORNOTETXT(ORLINE)=""
  1.  . S ORI=0
  1.  . F  S ORI=$O(ORINPUTTXT(ORI)) Q:'ORI  D
  1.  . . S ORLINE=ORLINE+1
  1.  . . S ORNOTETXT(ORLINE)=ORINPUTTXT(ORI)
  1.  ;
  1.  ; If error, add error text to note
  1.  I ORERROR D
  1.  . D GETTXT(.ORNOTETXT,.ORLINE,"E",1)
  1.  . I $D(ORERRMSG) D
  1.  . . S ORI=0
  1.  . . F  S ORI=$O(ORERRMSG(ORI)) Q:'ORI  D
  1.  . . . S ORLINE=ORLINE+1
  1.  . . . S ORNOTETXT(ORLINE)=$G(ORERRMSG(ORI))
  1.  ;
  1.  Q
  1.  ;
  1.  ; Get canned text from OR PDMP NOTE TEXT parameter
  1. GETTXT(ORNOTETXT,ORLINE,ORTYPE,ORADDLINE)  ;
  1.  ;
  1.  N ORI,ORARR,ORERR
  1.  ;
  1.  D GETWP^XPAR(.ORARR,"ALL","OR PDMP NOTE TEXT",ORTYPE,.ORERR)
  1.  ;
  1.  I '$D(ORARR) Q
  1.  ;
  1.  I $G(ORADDLINE)>0 D
  1.  . F ORI=1:1:ORADDLINE D
  1.  . . S ORLINE=ORLINE+1
  1.  . . S ORNOTETXT(ORLINE)=""
  1.  ;
  1.  S ORI=0
  1.  F  S ORI=$O(ORARR(ORI)) Q:'ORI  D
  1.  . S ORLINE=ORLINE+1
  1.  . S ORNOTETXT(ORLINE)=ORARR(ORI,0)
  1.  ;
  1.  Q
  1.  ;
  1.  ; Get the most recent date a PDMP note was completed for a patient
  1. RECNTNOTE(ORRETURN,DFN) ;
  1.  ;
  1.  N ORDATE,ORDOC,ORSTATUS
  1.  ;
  1.  S ORSTATUS="COMPLETED"
  1.  S ORDOC(1)=$$GETNOTE
  1.  K ^TMP("TIU",$J)
  1.  D MAIN^TIULAPIS(DFN,.ORDOC,.ORSTATUS,,,1,0)  ; ICR 3062
  1.  S ORDATE=$O(^TMP("TIU",$J,0))
  1.  I ORDATE S ORDATE=9999999-ORDATE
  1.  K ^TMP("TIU",$J)
  1.  S ORRETURN=ORDATE
  1.  ;
  1.  Q
  1.  ;
  1.  ; If note was deleted, retracted, or reassigned delete the pointer to the Note from the PDMP Query Log
  1. DOCACT ; Queue processor for TIU DOCUMENT ACTION
  1.  ;
  1.  N ORACT,ORDOC,ORIEN,ORIEN1,ORLOGIENS,ORSUB
  1.  ;
  1.  S ORSUB="TIUDOCACT"
  1.  Q:'$D(^TMP(ORSUB,$J))
  1.  ;
  1.  N $ET,$ES
  1.  S $ET="D UNEXPERR^ORPDMPNT"
  1.  ;
  1.  S ORACT=$G(^TMP(ORSUB,$J,"ACTION"))
  1.  S ORACT=$S(ORACT="DELETE":"D",ORACT="RETRACT":"R",ORACT="REASSIGN":"A",1:"")
  1.  I ORACT="" Q
  1.  I ORACT'="A" S ORDOC=+$G(^TMP(ORSUB,$J,"DOCUMENT"))
  1.  I ORACT="A" S ORDOC=+$G(^TMP(ORSUB,$J,"DOCUMENT","OLD"))
  1.  I '$G(ORDOC) Q
  1.  ;
  1.  S ORIEN=0
  1.  F  S ORIEN=$O(^ORD(101.62,"AT",ORDOC,ORIEN)) Q:'ORIEN  D
  1.  . S ORIEN1=0
  1.  . F  S ORIEN1=$O(^ORD(101.62,"AT",ORDOC,ORIEN,ORIEN1)) Q:'ORIEN1  D
  1.  . . S ORLOGIENS=ORIEN1_","_ORIEN_","
  1.  . . D UPDATELOG^ORPDMP(ORLOGIENS,"","","","","","","@",ORACT)
  1.  ;
  1.  Q
  1.  ;
  1.  ; Unexpected error handler during DOACT
  1. UNEXPERR ;
  1.  ;ZEXCEPT: ORSUB
  1.  N %ZT,%ZTERROR
  1.  S %ZT($NA(^TMP(ORSUB,$J)))=""
  1.  D ^%ZTER ;file error
  1.  S $ECODE=""
  1.  Q