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

ORWDXA1.m

Go to the documentation of this file.
  1. ORWDXA1 ;SLC/JMC - Utilities for Order Flag Actions ;Dec 14, 2021@08:39:22
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**539,405**;Dec 17, 1997;Build 211
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. FLAGACT(LST,ORIFN,ACTION) ;perform action on flag order
  1. N DA,ORNOW,CNT,X,RES,ORFIENS,ORFDA,FDAIEN,ERR,REC,ORVP,X3,USR
  1. S DA=$P(ORIFN,";",2)
  1. S ACTION=$G(ACTION,"ALL")
  1. ; get recipients
  1. I ACTION="RECIPIENTS"!(ACTION="ALL") D I ACTION'="ALL" Q
  1. . D FLAGRCPT(.LST,ORIFN)
  1. M RES=LST
  1. K LST
  1. ; get comments
  1. I ACTION="COMMENTS"!(ACTION="ALL") D I ACTION'="ALL" Q
  1. . D FLGCOM(.LST,ORIFN)
  1. I $D(RES) S CNT=$O(RES("A"),-1),X=0 F S X=$O(LST(X)) Q:'X S CNT=CNT+1,RES(CNT)=LST(X)
  1. M LST=RES
  1. Q
  1. FLAGRCPT(LST,ORIFN) ; flag recipients
  1. N DA,CNT,X,USR,Y
  1. S DA=$P(ORIFN,";",2),(CNT,X)=0
  1. F S X=$O(^OR(100,+ORIFN,8,DA,6,X)) Q:'X S CNT=CNT+1,Y=$G(^(X,0)),USR=+Y,LST(CNT)=USR_U_$$USER^ORQ20(USR)_" added on "_$$DATE^ORQ20($P(Y,U,2))
  1. Q
  1. FLAGCOM(LST,ORIFN,ORCOM,ORALRP) ; flag comments, add
  1. N ORDA,ORVP,ORNOW,ORFIENS,ORFDA,ORAUSR,ORFERR,ORFNM,USR,X,X3
  1. S ORDA=$P(ORIFN,";",2),ORVP=+$P(^OR(100,+ORIFN,0),U,2)
  1. I $O(ORCOM(""))="" S LST(1)="0^Comments required, no action taken." Q
  1. I '$D(^OR(100,+ORIFN)) S LST(1)="0^No such order, no action taken." Q
  1. S ORNOW=$$NOW^XLFDT
  1. S ORFIENS="?+1"_","_ORDA_","_+ORIFN_","
  1. S ORFDA(100.843,ORFIENS,.01)=ORNOW
  1. S ORFDA(100.843,ORFIENS,1)=DUZ
  1. D UPDATE^DIE("","ORFDA","ORFNM","ORFERR")
  1. I ($G(ORFERR)'="")!('+$G(ORFNM(1))) S LST(1)="0^Error while adding Comment data." K ORFERR Q
  1. ;file comments
  1. K ^TMP($J,"WP")
  1. D WP^DIE(100.843,ORFNM(1)_","_ORDA_","_$P(ORIFN,";")_",",2,,"ORCOM","ORFERR")
  1. I $G(ORFERR)'="" S LST(1)="0^Error adding comments." K ORFERR Q
  1. K ORFIENS,ORFDA
  1. ;get recipients on file
  1. S X=0
  1. F S X=$O(^OR(100,+ORIFN,8,ORDA,6,X)) Q:'X S USR=$P($G(^(X,0)),"^") I USR S ORAUSR(USR)=""
  1. ;File additional alert Recipients
  1. S X=0,ORFIENS="?+1"_","_ORDA_","_+ORIFN_","
  1. F S X=$O(ORALRP(X)) Q:'X S USR=+ORALRP(X) I USR,'$D(ORAUSR(USR)) D I $G(ORFERR)'="" Q
  1. . S ORFDA(100.842,ORFIENS,.01)=USR
  1. . S ORFDA(100.842,ORFIENS,1)=ORNOW
  1. . S ORFDA(100.842,ORFIENS,2)=DUZ
  1. . D UPDATE^DIE("","ORFDA","","ORFERR")
  1. . I $G(ORFERR)'="" S LST(1)="0^Error adding alert recipient "_USR Q
  1. . S ORAUSR(USR)=""
  1. S LST(1)="1^Comments successfully added."
  1. ; send notification to originator and recipients
  1. S X3=$G(^OR(100,+ORIFN,8,ORDA,3)) I $P(X3,U,4)'="" S ORAUSR(+$P(X3,U,4))=""
  1. K ORFDA,ORAUSR(DUZ) ;don't sent alert to user adding comment
  1. D CMTMSG(ORIFN,ORVP,.ORAUSR)
  1. Q
  1. ;
  1. CMTMSG(ORIFN,ORVP,ORAUSR) ; send alert notification information to recipients
  1. N ORCMSG,ORN,ORDFN,OR3,ORYT
  1. S ORCMSG="Comment Added to Flagged Order: "
  1. S ORN=8,ORDFN=+ORVP,OR3=$G(^OR(100,+ORIFN,3))
  1. D TEXT^ORQ12(.ORYT,+ORIFN_";"_+$P(OR3,U,7),20)
  1. S ORCMSG=ORCMSG_$G(ORYT(1))
  1. D EN^ORB3(ORN,ORDFN,+ORIFN,.ORAUSR,ORCMSG)
  1. Q
  1. FLGCOM(LST,ORIFN) ; flag comments, get
  1. N DA,CNT,X,Y,ORZ,DIWL,DIWR,DIWF,DATA,I
  1. S DA=$P(ORIFN,";",2),(CNT,Y)=0
  1. D:$D(^OR(100,+ORIFN,8,DA,3))
  1. . Q:$G(ACTION)=""
  1. . N BFLAG S BFLAG=$G(^OR(100,+ORIFN,8,DA,3))
  1. . S CNT=CNT+1,LST(CNT)="<COMMENT>"
  1. . S CNT=CNT+1,LST(CNT)=$P(BFLAG,U,3)_";"_$$DATE^ORQ20($P(BFLAG,U,3))_U_$P(BFLAG,U,4)_";"_$$USER^ORQ20($P(BFLAG,U,4))
  1. . S CNT=CNT+1,LST(CNT)="Flagged Reason: "_$P(BFLAG,U,5)
  1. . S CNT=CNT+1,LST(CNT)="</COMMENT>"
  1. S DIWL=1,DIWR=70,DIWF="C70" K ^UTILITY($J,"W")
  1. F S Y=$O(^OR(100,+ORIFN,8,DA,9,Y)) Q:'Y D
  1. . S DATA=$G(^OR(100,+ORIFN,8,DA,9,Y,0))
  1. . S CNT=CNT+1,LST(CNT)="<COMMENT>"
  1. . S CNT=CNT+1,LST(CNT)=$P(DATA,U)_";"_$$DATE^ORQ20($P(DATA,U))_U_$P(DATA,U,2)_";"_$$USER^ORQ20($P(DATA,U,2))
  1. . S ORZ=0 F S ORZ=$O(^OR(100,+ORIFN,8,DA,9,Y,"COM",ORZ)) Q:'ORZ S X=^(ORZ,0) D ^DIWP
  1. . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:'I S CNT=CNT+1,LST(CNT)=^(I,0)
  1. . S CNT=CNT+1,LST(CNT)="</COMMENT>"
  1. . K ^UTILITY($J,"W")
  1. Q
  1. FLGHST(ORY,ORIFN) ;archive history of flag order
  1. N X3,F,Y
  1. N ORI,X3,CNT,ORJ
  1. S ORI=$P(ORIFN,";",2),CNT=0
  1. I $D(^OR(100,+ORIFN,8,ORI,3)) D ;Un-/Flagged
  1. . S X3=$G(^OR(100,+ORIFN,8,ORI,3))
  1. . S CNT=CNT+1,ORY(CNT)="Flagged by: "_$$USER^ORQ20(+$P(X3,U,4))_" on "_$$DATE^ORQ20($P(X3,U,3))
  1. . S CNT=CNT+1,ORY(CNT)=" "_$P(X3,U,5)
  1. . I $P(X3,U,10)'="" S CNT=CNT+1,ORY(CNT)="No Action Alert: "_$$DATE^ORQ20($P(X3,U,10))
  1. ;flagged recipients
  1. S ORJ=0,F=0 F S ORJ=$O(^OR(100,+ORIFN,8,ORI,6,ORJ)) Q:'ORJ S Y=^(ORJ,0) D
  1. . S CNT=CNT+1,ORY(CNT)=$S('F:"Recipients: ",1:" ")_$$USER^ORQ20(+Y)_" added on "_$$DATE^ORQ20($P(Y,U,2))_" by "_$$USER^ORQ20(+$P(Y,U,3)),F=1
  1. ;flagged comments
  1. N DIWL,DIWR,DIWF,X,I,ORK
  1. S ORJ=0,F=0 F S ORJ=$O(^OR(100,+ORIFN,8,ORI,9,ORJ)) Q:'ORJ S Y=^(ORJ,0) D
  1. . S CNT=CNT+1,ORY(CNT)=$S('F:"Comments by: ",1:" ")_$$USER^ORQ20($P(Y,U,2))_"on "_$$DATE^ORQ20(+Y),F=1
  1. . S DIWL=19,DIWR=110,DIWF="I19" K ^UTILITY($J,"W")
  1. . S ORK=0 F S ORK=$O(^OR(100,+ORIFN,8,ORI,9,ORJ,"COM",ORK)) Q:'ORK S X=^(ORK,0) D ^DIWP
  1. . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:'I S CNT=CNT+1,ORY(CNT)=^(I,0)
  1. K ^UTILITY($J,"W")
  1. I $P($G(X3),U)=0 D
  1. . S CNT=CNT+1,ORY(CNT)="Unflagged by: "_$$USER^ORQ20(+$P(X3,U,7))_" on "_$$DATE^ORQ20($P(X3,U,6))
  1. . S CNT=CNT+1,ORY(CNT)=" "_$P(X3,U,8)
  1. K ^UTILITY($J,"W")
  1. Q
  1. GETHST(ORFH,ORIFN) ;Get flag order history
  1. N ORI,ORJ,ORK,CNT,Y
  1. S ORI=$P(ORIFN,";",2),CNT=0
  1. I $D(^OR(100,+ORIFN,8,ORI,"FHIS")) D
  1. . S ORJ=0 F S ORJ=$O(^OR(100,+ORIFN,8,ORI,"FHIS",ORJ)) Q:'ORJ S ORK=0 D
  1. . . S ORK=0 F S ORK=$O(^OR(100,+ORIFN,8,ORI,"FHIS",ORJ,"COM",ORK)) Q:'ORK S Y=^(ORK,0),CNT=CNT+1,ORFH(CNT)=Y
  1. Q
  1. SCHALRT(ORVP,ORIFN,OREXP) ;schedule alert in file #100.97
  1. N ORDATA,ORDA3,ORACT,ORYT,ORNAM
  1. I (ORVP="")!(ORIFN="")!(OREXP)="" Q
  1. S ORACT=$P(ORIFN,";",2)
  1. S ORDA3=$G(^OR(100,+ORIFN,8,ORACT,3))
  1. S ORDATA("PATIENT")=ORVP
  1. S ORDATA("WHEN")=OREXP
  1. S ORDATA("WHO")=$P(ORDA3,U,4)
  1. S ORDATA("ALERT")="98;ORD(100.9,"
  1. S ORNAM=$$OI^ORX8(ORIFN)
  1. S ORDATA("TITLE")="Order flag expired for "_$P(ORNAM,"^",2)_" on "_$$DATE^ORQ20(OREXP)
  1. S ORDATA("IFN")=ORIFN
  1. D SCHALRT^ORB3UTL(.ORDATA)
  1. Q
  1. ;
  1. FLAGTXTS(CLST,IFNS) ; get flag reason for list of orders
  1. N L,DA,IFN,CNT
  1. S (CNT,L)=0
  1. F S L=$O(IFNS(L)) Q:'L S IFN=IFNS(L) D
  1. . S DA=$S($P(IFN,";",2):$P(IFN,";",2),1:1),IFN=+IFN
  1. . D FLRSON
  1. Q
  1. ;
  1. FLRSON ; flag reason
  1. N FLAG,I,F,ORUSR,ORCOM,Z
  1. S FLAG=$G(^OR(100,IFN,8,DA,3))
  1. S CNT=CNT+1
  1. S CLST(CNT)="~"_IFN_U_"FLAGGED: "_$$FMTE^XLFDT($P(FLAG,U,3))_" by "_$P($G(^VA(200,+$P(FLAG,U,4),0)),U)
  1. S CNT=CNT+1
  1. S CLST(CNT)=$P(FLAG,U,5) ; reason
  1. I $P(FLAG,U,10)'="" S CNT=CNT+1,CLST(CNT)="NO ACTION ALERT: "_$$FMTE^XLFDT($P(FLAG,U,10))
  1. D FLAGRCPT^ORWDXA1(.ORUSR,IFNS(L)) ; recipients
  1. S (I,F)=0
  1. F S I=$O(ORUSR(I)) Q:'I I ORUSR(I) D
  1. . S CNT=CNT+1,CLST(CNT)=$S('F:"RECIPIENTS:"_$C(9),1:$C(9)_$C(9))_$P(ORUSR(I),U,2),F=1
  1. D FLGCOM^ORWDXA1(.ORCOM,IFNS(L)) ; comments
  1. S (I,F)=0
  1. F S I=$O(ORCOM(I)) Q:'I I ORCOM(I)="<COMMENT>" S I=$O(ORCOM(I)) D
  1. . S CNT=CNT+1,CLST(CNT)=$S('F:"COMMENTS:"_$C(9),1:$C(9)_$C(9))_$P($P(ORCOM(I),U,2),";",2)_" on "_$P($P(ORCOM(I),U),";",2),F=1
  1. . F S I=$O(ORCOM(I)) Q:ORCOM(I)="</COMMENT>" D
  1. . . S CNT=CNT+1,CLST(CNT)=$C(9)_ORCOM(I)
  1. Q
  1. ;
  1. MAP(Y) ; display group mapping
  1. N C,I,X
  1. D GRP(.X)
  1. S C=0,I=0
  1. F S I=$O(X(I)) Q:I="" S C=C+1,Y(I)=X(I)
  1. Q
  1. GRP(BYGRP) ;
  1. N I,ORY,TOPINFO
  1. D GETLST^XPAR(.ORY,"ALL","ORWOR CATEGORY SEQUENCE")
  1. S I=0 F S I=$O(ORY(I)) Q:I="" D
  1. . S BYGRP($P(ORY(I),U,2))=$P(ORY(I),U,2)
  1. S I=0 F S I=$O(BYGRP(I)) Q:I="" S TOPINFO=BYGRP(I) D EXPAND(I)
  1. Q
  1. EXPAND(GROUP) ;
  1. N I,CHILD
  1. S I=0 F S I=$O(^ORD(100.98,GROUP,1,I)) Q:I<1 D
  1. . S CHILD=$P(^ORD(100.98,GROUP,1,I,0),"^",1)
  1. . I '$D(BYGRP(CHILD)) S BYGRP(CHILD)=TOPINFO D EXPAND(CHILD)
  1. Q
  1. ;
  1. CHOREXP(IFN) ;
  1. Q:'$D(^OR(100.97,"E",IFN))
  1. N DA,TD S DA=$O(^OR(100.97,"E",IFN,"")) Q:'DA
  1. S TD=$P($G(^OR(100.97,DA,0)),U,3) Q:'TD!($$NOW^XLFDT()>TD)
  1. S DIK="^OR(100.97," D ^DIK K DIK
  1. Q
  1. ;