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

ORRCXQ.m

Go to the documentation of this file.
  1. ORRCXQ ;SLC/MKB - Alert utilities for CM ; 25 Jul 2003 9:31 AM
  1. ;;1.0;CARE MANAGEMENT;;Jul 15, 2003
  1. ;
  1. USER(ORY,ORDUZ) ; -- Return user's current alerts in @ORY@(PKGID,AID)=DATA
  1. ;
  1. N ORXQ,X,I,PKGID,AID,TM,DATA
  1. S ORDUZ=$G(ORDUZ,DUZ),ORY=$NA(^TMP($J,"ORY")) K @ORY
  1. S ORXQ="^TMP($J,""ORXQ"")" D USER^XQALERT(ORXQ,ORDUZ)
  1. S I=0 F S I=$O(@ORXQ@(I)) Q:I<1 D
  1. . S X=$P(@ORXQ@(I),U,2),PKGID=$P(X,";"),AID=$P(X,";",2,3),TM=$P(X,";",3)
  1. . S DATA=$G(^XTV(8992,ORDUZ,"XQA",TM,1)) ;IA#2689
  1. . S @ORY@(PKGID,AID)=DATA
  1. K @ORXQ
  1. Q
  1. ;
  1. PAT(ORY,ORPAT,ORUSR) ; -- Return non-ADT alerts for ORPAT to ORUSR
  1. ; in @ORY@(#) = Item=ID^Text^Date in HL7 format
  1. ; where ID is "NOT:<XQAID>"
  1. ; RPC = ORRC ALERTS BY PATIENT
  1. N ORXQ,ORN,I,TEXT,XQAID,DATE,NOT,ACTDT
  1. S ORUSR=+$G(ORUSR),ACTDT=$$PARAM^ORRCACK(ORUSR)
  1. S ORXQ="^TMP($J,""ORXQ"")" D USER^XQALERT(ORXQ,ORUSR)
  1. S ORY=$NA(^TMP($J,"ORRCNOT")),ORN=0 K @ORY
  1. S I=0 F S I=$O(@ORXQ@(I)) Q:I<1 D
  1. . S TEXT=$P(@ORXQ@(I),U),XQAID=$P(@ORXQ@(I),U,2),DATE=$P(XQAID,";",3)
  1. . Q:XQAID'?1"OR,".E I $G(ORPAT) Q:+$P(XQAID,",",2)'=ORPAT
  1. . S NOT=+$P(XQAID,",",3) Q:"^18^19^20^35^36^"[(U_NOT_U) ;skip ADT ones
  1. . I ACTDT,ACTDT'>DT,$$INCLD(NOT) Q ;skip results ones already included
  1. . S ORN=ORN+1,@ORY@(ORN)="Item=NOT:"_XQAID_U_$E(TEXT,23,99)_U_$$FMTHL7^XLFDT(DATE)
  1. K @ORXQ
  1. Q
  1. ;
  1. INCLD(NIEN) ; -- Order already in Results column?
  1. ; [from PAT - uses ORUSR]
  1. N X,Y,DATA,NMSP,PKG S X=U_NIEN_U,Y=0
  1. S NMSP=$S("^3^14^24^57^58^"[X:"LR","^21^22^25^53^"[X:"RA","^23^"[X:"GMRC","^32^33^44^60^"[X:"X",1:"") I NMSP="" Q 0
  1. S DATA=$G(^XTV(8992,ORUSR,"XQA",DATE,1)),PKG=$P($P(DATA,"|",2),"@",2)
  1. S ORIFN=0 F S ORIFN=$O(^ORA(102.4,"ACK",ORUSR,ORIFN)) Q:ORIFN<1 D Q:Y
  1. . S OR0=$G(^OR(100,+ORIFN,0)),PKGIFN=+$G(^(4))
  1. . S ORVP=$P(OR0,U,2) Q:+ORVP'=ORPAT
  1. . S ORPKG=$$NMSP^ORCD($P(OR0,U,14)) I ORPKG'=NMSP,'(NMSP="X"&(PKG[ORPKG)) Q
  1. . S:$$MATCH Y=1
  1. Q Y
  1. ;
  1. RSLT(ORDER,ORUSR) ; -- clear alerts for ORDERs results
  1. N ORY,ORN,ORIFN,OR0,ORVP,ORPKG,PKGIFN,NIEN,PKGID,AID,DATA
  1. D USER(.ORY,ORUSR),ORN ;notifs by pkg
  1. S ORIFN=0 F S ORIFN=$O(ORDER(ORIFN)) Q:ORIFN<1 D
  1. . S OR0=$G(^OR(100,+ORIFN,0)),PKGIFN=+$G(^(4))
  1. . S ORPKG=$$NMSP^ORCD($P(OR0,U,14)) Q:"^LR^RA^GMRC^"'[(U_ORPKG_U)
  1. . S ORVP=$P(OR0,U,2),PKGID="OR,"_+ORVP
  1. . F S PKGID=$O(@ORY@(PKGID)) Q:$P(PKGID,",",1,2)'=("OR,"_+ORVP) D
  1. .. S NIEN=$P(PKGID,",",3) Q:'$D(ORN(ORPKG,NIEN)) ;alert not for ORPKG
  1. .. S AID="" F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" D
  1. ... S DATA=@ORY@(PKGID,AID) Q:'$$MATCH
  1. ... D DELETE(PKGID_";"_AID)
  1. K @ORY
  1. Q
  1. ;
  1. ORN ; -- List result notifications by pkg in ORN(NMSP,IEN)
  1. N X,Y,I,N K ORN
  1. F X="LR","RA","GMRC" D
  1. . S Y=$S(X="LR":"3^14^24^57^58",X="RA":"21^22^25^53",X="GMRC":"23",1:"")
  1. . F I=1:1:$L(Y,U) S N=$P(Y,U,I),ORN(X,N)=""
  1. . F I=32,33,44,60 S ORN(X,I)="" ;flagged or stat results, for any pkg
  1. Q
  1. ;
  1. MATCH() ; -- Return 1 or 0, if alert matches current order
  1. ; Called from RSLT & $$INCLD, so expects those var's to be defined
  1. N Y,APKG,ADATA S Y=0
  1. S ADATA=$P(DATA,"|"),APKG=$P($P(DATA,"|",2),"@",2)
  1. I ORPKG="LR",APKG["LR",+DATA=+ORIFN S Y=1 G MQ
  1. I "^32^33^44^60^"[(U_NIEN_U) D G MQ
  1. . I ORPKG="RA",APKG["RA",$D(^RADPT("AO",PKGIFN,+ORVP,+$P(ADATA,"~",2),+$P(ADATA,"~",3))) S Y=1 ;IA#2588
  1. . I ORPKG="GMRC",APKG["GMRC",PKGIFN=+ADATA S Y=1
  1. I ORPKG="RA",$D(^RADPT("AO",PKGIFN,+ORVP,+ADATA,+$P(ADATA,"~",2))) S Y=1 ;IA#2588
  1. I ORPKG="GMRC",PKGIFN=+ADATA S Y=1
  1. MQ Q Y
  1. ;
  1. SIGN(ID) ; -- clear alerts for signatures
  1. N ORY,ORNKILL,ORVP,PKGID,AID
  1. D USER(.ORY,DUZ) I ID["OR" D G SIGQ
  1. . S ORVP=$P($G(^OR(100,+ID,0)),U,2) Q:$O(^OR(100,"AS",ORVP,0))
  1. . S PKGID="OR,"_+ORVP_",12",AID=""
  1. . F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" S ORNKILL(PKGID_";"_AID)=""
  1. I ID["TIU" D G SIGQ
  1. . S PKGID="TIU"_+ID,AID=""
  1. . F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" S ORNKILL(PKGID_";"_AID)=""
  1. . ;ck w/Joel: possible alerts + formats, kill conditions
  1. SIGQ I $D(ORNKILL) D DELETE
  1. K @ORY
  1. Q
  1. ;
  1. DELETE(XQAID) ; -- Delete alert XQAID
  1. Q:'$L($G(XQAID)) N XQAKILL,ORN
  1. S ORN=+$P($P(XQAID,";"),",",3),XQAKILL=$S(ORN:$$XQAKILL^ORB3F1(ORN),1:0)
  1. D DELETE^XQALERT ;for DUZ
  1. Q
  1. ;
  1. MSGTXT(ID) ; -- Return message text of alert ID
  1. N IDX,D0,D1,Y
  1. S IDX="^XTV(8992,""AXQA"","""_ID_""")",IDX=$Q(@IDX)
  1. S D0=+$P(IDX,",",6),D1=+$P(IDX,",",7)
  1. S Y=$P($G(^XTV(8992,D0,"XQA",D1,0)),U,3),Y=$E(Y,20,999)
  1. Q Y
  1. ;
  1. MSGDT(ADT,ATXT) ; -- Return event date from alert date and text
  1. N I,X,Y,%DT
  1. I ATXT?1"Transfer".E S Y=ADT G MDQ ;no date in text
  1. S I=$F(ATXT," on "),X="" S:I X=$E(ATXT,I,999)
  1. I ATXT?1"Admit".E S I=$F(X," "),X=$E(X,1,I-3) ;strip off ward,rm-bed
  1. S:X?2N1"/"2N1" "2N1":"2N X=$TR(X," ","@")
  1. S %DT="TS" D ^%DT I Y<0 S Y=ADT
  1. MDQ Q Y