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

ORB3UTL.m

Go to the documentation of this file.
  1. ORB3UTL ;SLC/JMH - OE/RR Notification Utilities ;Oct 27, 2023@11:55
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377,539,535**;Dec 17, 1997;Build 20
  1. ;
  1. ; Reference to DEFALERT^XQALDATA,GETPAT3^XQALDATA in ICR #4834
  1. ; Reference to ^TIU(8925) in ICR #2937
  1. ; Reference to ^GMR(123) in ICR #2586
  1. ; Reference to ^SRF() in ICR #7436
  1. ; Reference to $$CANDO^TIULP in #2322
  1. ; Reference to ^TIU(8925.1) in #4476
  1. ; Reference to $$BOIL^TIUSRVD in #2876
  1. ; Reference to ^DPT( in ICR #10035
  1. ; Reference to ^DIE in ICR #10018
  1. ; Reference to FILE^DIE,UPDATE^DIE,WP^DIE in ICR #2053
  1. ; Reference to $$GET1^DIQ in ICR #2056
  1. ; Reference to $$NOW^XLFDT in ICR #10103
  1. ; Reference to ALERTDAT^XQALBUTL in ICR #2788
  1. ; Reference to DEFALERT^XQALDATA,GETPAT3^XQALDATA in ICR #4834
  1. ;
  1. GENALRTS ;fire off due alerts
  1. ;get unfired records
  1. N ORI S ORI=0
  1. F S ORI=$O(^OR(100.97,"C",0,ORI)) Q:'ORI D
  1. .N ORWHEN S ORWHEN=$P($G(^OR(100.97,ORI,0)),U,3)
  1. .I ORWHEN<$$NOW^XLFDT() D GENALRT(ORI) W !,ORI
  1. Q
  1. ;
  1. GENALRT(ORID) ;fire a specific scheduled alert
  1. N ORDUZ,ORMSG
  1. S ORDUZ($P($G(^OR(100.97,ORID,0)),U,4))=$P($G(^OR(100.97,ORID,0)),U,4)
  1. S ORMSG=$G(^OR(100.97,ORID,2))
  1. N ORI S ORI=0 F S ORI=$O(^OR(100.97,ORID,3,ORI)) Q:'ORI S ORMSG(ORI)=$G(^OR(100.97,ORID,3,ORI,0))
  1. N ORDFN S ORDFN=+$G(^OR(100.97,ORID,0))
  1. D EN^ORB3(90,ORDFN,"",.ORDUZ,.ORMSG,"")
  1. N ORXQAID S ORXQAID="OR,"_ORDFN_",90;"_$P($G(^OR(100.97,ORID,0)),U,4)_";"_$$NOW^XLFDT()
  1. K ORFDART,ORMSGRT
  1. S ORFDART(100.97,ORID_",",4)=ORXQAID
  1. S ORFDART(100.97,ORID_",",7)=$$NOW^XLFDT()
  1. D FILE^DIE("","ORFDART","ORMSGRT")
  1. Q ORXQAID
  1. ;
  1. SCHALRT(ORDATA) ;Schedule a long text alert
  1. ;ORDATA fields
  1. ; PATIENT - File 2 IEN - for the patient this alert is for
  1. ; WHEN - date/time of when this alert will be generated
  1. ; WHO - File 200 IEN of who will receive this alert
  1. ; TITLE - Free Text title of alert
  1. ; BODY(D0) - Word Processing body of the alert for long text
  1. N DIC,DIE,DR,DA,ORFDART,ORIENRT,ORMSGRT
  1. S ORFDART(100.97,"+1,",.01)=ORDATA("PATIENT")
  1. D UPDATE^DIE("","ORFDART","ORIENRT","ORMSGRT")
  1. I $D(ORIENRT(1)) S DA=ORIENRT(1)
  1. S DIC="^OR(100.97,",DIC(0)="F",DIE=DIC
  1. S DR="1////"_$$NOW^XLFDT()_";2////"_ORDATA("WHEN")_";3////"_ORDATA("WHO")_";5////"_ORDATA("TITLE")_";4////0"_";8////"_$G(ORDATA("IFN"))
  1. D ^DIE
  1. D WP^DIE(100.97,DA_",",6,,"ORDATA(""BODY"")","ERROR")
  1. Q
  1. ;
  1. DEFER(ORY,ORPROV,ORALERT,ORDT) ;defer an alert
  1. ;ORALERT - alert to defer
  1. ;ORPROV - provider to defer the alert for
  1. ;ORDT - date/time to defer the alert until
  1. N ORROOT
  1. S ORY=1
  1. ;CALL KERNEL API FOR DEFERRAL
  1. D DEFALERT^XQALDATA("ORROOT",ORPROV,ORDT,ORALERT)
  1. N ORRES S ORRES=$G(ORROOT(1),1)
  1. I $P(ORRES,U)<0 S ORY=ORRES
  1. Q
  1. NOTIFPG(ORY,ORPAT,ORFROM,ORTO) ;page through a patients alerts
  1. ;ORPAT - patient DFN
  1. ;ORPG - page to get
  1. ;ORPGSZ - page size (defaults to 25)
  1. N URGLIST,REMLIST,NONORLST,ORY2,I,ORTOTU,ORTOT
  1. N ALRT,ALRTDFN,ALRTDT,ALRTI,ALRTLOC,ALRTMSG,ALRTPT,ALRTXQA,FWDBY,J,NONOR,ORHAS,ORN,ORN0,ORURG,PRE,REM,URG
  1. D INDNOT(.ORY2)
  1. K ORY
  1. K ^TMP("ORB2",$J),^TMP("ORBG",$J)
  1. D GETPAT3^XQALDATA("^TMP(""ORB2"",$J)",ORPAT,ORFROM,ORTO)
  1. D URGLIST^ORQORB(.URGLIST)
  1. D REMLIST^ORQORB(.REMLIST)
  1. D REMNONOR^ORQORB(.NONORLST)
  1. S (I,J)=0
  1. F S I=$O(^TMP("ORB2",$J,I)) Q:'I D
  1. .N ORPROV,ORALRTDAT ; ajb
  1. .S ALRTDFN=""
  1. .S ALRT=^TMP("ORB2",$J,I)
  1. .S PRE=$E(ALRT,1,1)
  1. .S ALRTXQA=$P(ALRT,U,2) ;XQAID
  1. .D ALERTDAT^XQALBUTL(ALRTXQA,"ORALRTDAT")
  1. .S NONOR="" F S NONOR=$O(NONORLST(NONOR)) Q:NONOR="" D
  1. ..I ALRTXQA[NONOR S REM=1 ;allow this type of alert to be Removed
  1. .S ALRTMSG=$P($P(ALRT,U),PRE_" ",2)
  1. .I $E(ALRT,4,8)'="-----" D ;not forwarded alert info/comment
  1. ..S ORURG="n/a"
  1. ..S ALRTI=$P(ALRT," ")
  1. ..S ALRTPT=""
  1. ..S ALRTLOC=""
  1. ..I $E($P(ALRTXQA,";"),1,3)="TIU" D
  1. ... N ORIEN,ORREF,ORTIU
  1. ... S ORPROV="N/A"
  1. ... S ORURG="Moderate"
  1. ... S ORTIU=+$G(ORALRTDAT(2)) D Q:'ORTIU
  1. .... N ORTIUTXT,ORTIUTXT6
  1. .... I ORTIU Q
  1. .... S ORTIUTXT=$P(ALRTXQA,";"),ORTIUTXT6=$E(ORTIUTXT,1,6)
  1. .... I "^TIUADD^TIUERR^"[ORTIUTXT6 S ORTIU=$E(ORTIUTXT,7,999) Q
  1. .... I ORTIUTXT?3A1.99999999N S ORTIU=$E(ORTIUTXT,4,999)
  1. ... S ORIEN=+$P($G(^TIU(8925,ORTIU,12)),U,10) I 'ORIEN D
  1. .... S ORREF=$P($G(^TIU(8925,ORTIU,14)),U,5) Q:ORREF=""
  1. .... I $P(ORREF,";",2)="GMR(123," S ORIEN=$P($G(^GMR(123,+ORREF,0)),U,3) I ORIEN="" S ORPROV="UNKNOWN"
  1. .... I $P(ORREF,";",2)="SRF(" S ORIEN=$P($G(^SRF(+ORREF,0)),U,14) I ORIEN="" S ORPROV="UNKNOWN"
  1. ... I +ORIEN>0 S ORPROV=$$GETPRVNM^ORWORB(ORIEN)
  1. ..I $P(ALRTXQA,",")="OR" D
  1. ...N NOPROV
  1. ...S NOPROV=0
  1. ...S ORN=$P($P(ALRTXQA,";"),",",3)
  1. ...S URG=$G(URGLIST(ORN))
  1. ...S ORURG=$S(URG=1:"HIGH",URG=2:"Moderate",1:"low")
  1. ...S REM=$G(REMLIST(ORN))
  1. ...S ORN0=$G(^ORD(100.9,+ORN,0))
  1. ...S ALRTI=$S(ORN=90:"L",$P(ORN0,U,6)="INFODEL":"I",1:"")
  1. ...S ALRTDFN=$P(ALRTXQA,",",2)
  1. ...S ALRTLOC=$G(^DPT(+$G(ALRTDFN),.1))
  1. ...I $G(ORN)=6,$P(ALRT,U)["Your task #" S ALRTMSG=$E($P(ALRT,U),2,999),NOPROV=1,ORPROV="N/A"
  1. ...; ajb
  1. ... I 'NOPROV S ORPROV=$$GETPROV^ORWORB(ORN,ALRTDFN,.ORALRTDAT)
  1. ...; ajb
  1. ..S ALRTI=$S(ALRTI="I":"I",ALRTI="L":"L",1:"")
  1. ..I (ALRT["): ")!($G(ORN)=27&(ALRT[") CV")) D ;WAT
  1. ...S ALRTPT=$P(ALRT,": ")
  1. ...N ORTRM S ORTRM=$S($E(ALRTPT,1,2)="G ":3,$E(ALRTPT,1,2)="I ":3,1:2)
  1. ...S ALRTPT=$E(ALRTPT,ORTRM,$L(ALRTPT))
  1. ...I $G(ORN)=27&(ALRT[") CV") S ALRTMSG=$P($P(ALRT,U),": ",2) ;WAT
  1. ...E S ALRTMSG=$P($P(ALRT,U),"): ",2) ;WAT
  1. ...I $E(ALRTMSG,1,1)="[" D
  1. ....S:'$L(ALRTLOC) ALRTLOC=$P($P(ALRTMSG,"]"),"[",2)
  1. ....S ALRTMSG=$P(ALRTMSG,"] ",2)
  1. ..I '$L($G(ALRTPT)) S ALRTPT="no patient"
  1. ..S ALRTDT=$P(ALRTXQA,";",3)
  1. ..S ALRTDT=$P(ALRTDT,".")_"."_$E($P(ALRTDT,".",2)_"0000",1,4)
  1. ..S ALRTDT=$E(ALRTDT,4,5)_"/"_$E(ALRTDT,6,7)_"/"_($E(ALRTDT,1,3)+1700)_"@"_$E($P(ALRTDT,".",2),1,2)_":"_$E($P(ALRTDT,".",2),3,4)
  1. ..;S ALRTDT=($E(ALRTDT,1,3)+1700)_"/"_$E(ALRTDT,4,5)_"/"_$E(ALRTDT,6,7)_"@"_$E($P(ALRTDT,".",2),1,2)_":"_$E($P(ALRTDT,".",2),3,4)
  1. ..S J=J+1,^TMP("ORBG",$J,J)=ALRTI_U_ALRTPT_U_ALRTLOC_U_ORURG_U_ALRTDT_U
  1. ..S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_ALRTMSG_U_U_ALRTXQA_U_$G(REM)_U
  1. .;
  1. .;if alert forward info/comment:
  1. .I $E(ALRTMSG,1,5)="-----" D
  1. ..S ALRTMSG=$P(ALRTMSG,"-----",2)
  1. ..I $E(ALRTMSG,1,14)=FWDBY D
  1. ...S J=J+1,^TMP("ORBG",$J,J)=FWDBY_U_$P($P(ALRTMSG,FWDBY,2),"Generated: ")_$P($P(ALRTMSG,FWDBY,2),"Generated: ",2)
  1. ..E S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_""""_ALRTMSG_""""
  1. .S ORHAS=$S($D(ORY2(ALRTXQA)):1,1:0)
  1. .S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_ORHAS
  1. .I $G(ORPROV)'="" S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_ORPROV ; ajb
  1. ;S ^TMP("ORBG",$J)=""
  1. S ^TMP("ORBG",$J,0)=^TMP("ORB2",$J,0)
  1. S ORY=$NA(^TMP("ORBG",$J))
  1. Q
  1. ;
  1. INDNOT(ORY) ;index the user's alerts by the xqaldata, include deferred alerts
  1. N ORY2 D FASTUSER^ORWORB(.ORY2,0)
  1. N ORI S ORI=0 F S ORI=$O(@ORY2@(ORI)) Q:'ORI D
  1. . I $L($P(@ORY2@(ORI),U,8))>0 S ORY($P(@ORY2@(ORI),U,8))=@ORY2@(ORI)
  1. Q
  1. ;
  1. GETNOTIF(RETURN,ALERT) ; Return a notification structure to the SMART Dialog System
  1. Set RETURN=$NA(^TMP($J)) Kill @RETURN
  1. New ORTMP,X,IEN,IENS,DFN
  1. Set DFN=+$Piece(ALERT,",",2)
  1. Set IEN=+$Piece(ALERT,",",3),IENS=IEN_","
  1. Set @RETURN@(0)="PROCESS AS SMART NOTIFICATION="_+$$GET1^DIQ(100.9,IENS,6.1,"I")
  1. Quit:'$Piece(@RETURN@(0),"=",2) ; Flag not set for SMART processing
  1. Set @RETURN@(1)="NOTE TITLE="_$$GET1^DIQ(100.9,IENS,6.2,"E")
  1. Set @RETURN@(2)="NOTE TITLE IEN="_+$$GET1^DIQ(100.9,IENS,6.2,"I")
  1. Set @RETURN@(3)="NOTIFICATION IEN="_IEN
  1. Set @RETURN@(4)="NOTIFICATION NAME="_$$GET1^DIQ(100.9,IENS,.01,"E")
  1. Set @RETURN@(5)="ALLOW ADDENDUM="_+$$GET1^DIQ(100.9,IENS,6.3,"I")
  1. Set @RETURN@(6)="TIU OBJECT="_+$$GET1^DIQ(100.9,IENS,6.4,"I")
  1. Set @RETURN@(7)="DFN="_DFN
  1. Set @RETURN@(8)="ALERT="_ALERT
  1. Set @RETURN@(9)="PATIENT NAME="_$P($G(^DPT(DFN,0)),U)
  1. Quit
  1. ;
  1. GETNOTES(RETURN,DOC,DFN) ; Returns existing notes that can be addended
  1. Set RETURN=$NA(^TMP($J)) Kill @RETURN
  1. New ROOT,STAT,IEN,LOOP
  1. For STAT=7,8 Do
  1. . Set LOOP=$Name(^TIU(8925,"APT",DFN,DOC,STAT))
  1. . Set ROOT=$Extract(LOOP,1,$Length(LOOP)-1)_","
  1. . For Set LOOP=$Query(@LOOP) Quit:$Piece(LOOP,ROOT)'="" Do
  1. . . S IEN=$QSubscript(LOOP,$QLength(LOOP))
  1. . . ; Validate MAKE ADDENDUM
  1. . . Q:'$$CANDO^TIULP(IEN,"MAKE ADDENDUM")
  1. . . Set @RETURN@(0)=$Get(@RETURN@(0))+1
  1. . . Set @RETURN@(@RETURN@(0))=IEN_U_$$GET1^DIQ(8925,IEN,.01)_U_$$GET1^DIQ(8925,IEN,1301)_U_$$GET1^DIQ(8925,IEN,1211)
  1. S @RETURN@(0)="COUNT="_$G(@RETURN@(0))
  1. Quit
  1. ;
  1. GETDESC(RETURN,ALERT) ; Returns notification description
  1. S RETURN=$NA(^TMP($J)) K @RETURN
  1. N ORNOTID S ORNOTID=$P($P(ALERT,";"),",",3)
  1. I 'ORNOTID D Q
  1. .S @RETURN@(0)="UNABLE TO DETERMINE ALERT"
  1. N ORTIUOBJ S ORTIUOBJ=$P($G(^ORD(100.9,ORNOTID,6)),U,4)
  1. I 'ORTIUOBJ D Q
  1. .S @RETURN@(0)="NO DATA OBJECT SETUP"
  1. S ORTIUOBJ=$P($G(^TIU(8925.1,ORTIUOBJ,0)),U,1)
  1. I '$L(ORTIUOBJ) D Q
  1. .S @RETURN@(0)="NO DATA OBJECT SETUP"
  1. N DFN S DFN=$P($P(ALERT,";"),",",2)
  1. I 'DFN D Q
  1. .S @RETURN@(0)="UNABLE TO DETERMINE PATIENT"
  1. ; Value from the TIU OBJECT specified in file 100.9, field 6.4
  1. N ORBOIL S ORBOIL=$$BOIL^TIUSRVD("|"_ORTIUOBJ_"|")
  1. I $E(ORBOIL,0,2)="~@" D
  1. .N ORGLOB S ORGLOB=$P(ORBOIL,"~@",2)
  1. .I $D(@ORGLOB) D
  1. ..N ORGLOBI S ORGLOBI=0 F S ORGLOBI=$O(@ORGLOB@(ORGLOBI)) Q:'ORGLOBI D
  1. ...S @RETURN@(ORGLOBI-1)=@ORGLOB@(ORGLOBI,0)
  1. E S @RETURN@(0)=ORBOIL
  1. Q
  1. ;