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