ORWORR1 ; SLC/JLI - Utilities for Retrieve Orders for Broker ;Dec 07, 2020@12:26:20
;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,243,456,444,539**;Dec 17, 1997;Build 41
;Called from ORWORR
;EPIP/RTW Modified for the Unified Action Profile 26 Oct 2016
; External References
; DBIA 4834 GETUSER1^XQALDATA
; DBIA 2790 $$CURRSURO^XQALSURO
;
GET1 ;
N ORGROUP
S TOT=^TMP("ORR",$J,ORLIST,"TOT") K ^TMP("ORR",$J,ORLIST,"TOT")
S I=.1 F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:'I S IFN=^(I) D
. ;I $G(ORRECIP)&&($G(FILTER)=12&&($$FLAGRULE(+IFN))) K ^TMP("ORR",$J,ORLIST,I) S TOT=TOT-1 Q
. ;correction above line, error in XINDEX ;OR*405
. I $G(ORRECIP),$G(FILTER)=12,$$FLAGRULE(+IFN) K ^TMP("ORR",$J,ORLIST,I) S TOT=TOT-1 Q
. I ORWTS,(+$P($G(^OR(100,+IFN,0)),U,13)'=ORWTS) K ^TMP("ORR",$J,ORLIST,I) S TOT=TOT-1 Q
. ;EPIP/RTW BEGIN ***UNIFIED ACTION PROFILE Modification*** 9/27/2017
. ;FILTER OUT NON OUTPATIENT ORDERS
. S ORGROUP=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
. I $G(GROUPS),$$GET1^DIQ(100.98,GROUPS,.01)="DISCHARGE MEDS",$P($G(^OR(100,+IFN,0)),U,11)'=ORGROUP K ^TMP("ORR",$J,ORLIST,I) S TOT=TOT-1 Q
. ;END ***UNIFIED ACTION PROFILE Modification*** 9/27/2017
. S PTEVTID=$P($G(^OR(100,+IFN,0)),U,17)
. S:PTEVTID>0 EVTNAME=$$NAME^OREVNTX(PTEVTID)
. S ^TMP("ORR",$J,ORLIST,I)=IFN_U_$P($G(^OR(100,+IFN,0)),U,11)_U_$P($G(^(8,+$P(IFN,";",2),0)),U)_U_PTEVTID_U_EVTNAME
S TXTVW=$S(MULT:0,FILTER=2:2,1:1) D:FILTER=2 ORYD^ORDD100
S ^TMP("ORR",$J,ORLIST,.1)=TOT_U_TXTVW_U_$G(ORYD,0)
;EPIP/RTW BEGIN ***UNIFIED ACTION PROFILE Modification*** 26/OCT/2016
;ALPHABETICAL ORDER SORT FOR UAP View
; Special sort for Discharge View
I $G(GROUPS),$$GET1^DIQ(100.98,GROUPS,.01)="DISCHARGE MEDS" D DCREF^ORTOULT4
I $G(GROUPS),$$GET1^DIQ(100.98,GROUPS,.01)="PHARMACY UAP" D REF^ORTOULT4
; END UAP modification
S REF=$NA(^TMP("ORR",$J,ORLIST))
Q
GET2 ; For AUTO DC/Event Release Orders
N JDND,JDIX,JDCNT,DCSPLIT
S JDCNT=1,DCSPLIT=0
S TOT=^TMP("ORR",$J,ORLIST,"TOT") K ^TMP("ORR",$J,ORLIST,"TOT")
F JDND="RL","DC" D
. S I=.1 F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:'I D
. . I '$D(^TMP("ORR",$J,ORLIST,I,JDND)) Q
. . S JDIX=0 F S JDIX=$O(^TMP("ORR",$J,ORLIST,I,JDND,JDIX)) Q:'JDIX S IFN=^(JDIX) D
. . . I 'DCSPLIT,(JDND="DC") D
. . . . S ^TMP("ORRJD",$J,JDCNT)="DC START"
. . . . S DCSPLIT=1,JDCNT=JDCNT+1,TOT=TOT+1
. . . I ORWTS,(+$P($G(^OR(100,+IFN,0)),U,13)'=ORWTS) S TOT=TOT-1 Q
. . . S PTEVTID=$P($G(^OR(100,+IFN,0)),U,17)
. . . S:PTEVTID>0 EVTNAME=$$NAME^OREVNTX(PTEVTID)
. . . S ^TMP("ORRJD",$J,JDCNT)=IFN_U_$P($G(^OR(100,+IFN,0)),U,11)_U_$P($G(^(8,+$P(IFN,";",2),0)),U)_U_PTEVTID_U_EVTNAME
. . . S JDCNT=JDCNT+1
S TXTVW=$S(MULT:0,FILTER=2:2,1:1) D:FILTER=2 ORYD^ORDD100
S ^TMP("ORRJD",$J,.1)=TOT_U_TXTVW_U_$G(ORYD,0)
S REF=$NA(^TMP("ORRJD",$J))
Q
FLAGRULE(ORNUM,USR) ;
;returns 0 if we should keep ORNUM in the list
;returns 1 if we should remove ORNUM from the list
;determines based on whether the user USR should see these flagged orders
; based on presence in file 100 NODE 8 FIELD 39 and
; based on whether the user should have gotten the flag due to provider recipients
N ORI,ORRET,ORQUIT,I,LST,ORDFN,IEN3,FUSR
I '$G(USR) S USR=DUZ
S ORRET=1,ORQUIT=0
S ORI=0 F S ORI=$O(^OR(100,ORNUM,8,ORI)) Q:'ORI D
.I '$P($G(^OR(100,ORNUM,8,ORI,3)),U,6)&($P($G(^OR(100,ORNUM,8,ORI,3)),U,9)) S LST($P($G(^OR(100,ORNUM,8,ORI,3)),U,9))=""
.;p539 add recipients who received notification for the current order
.I '$P($G(^OR(100,ORNUM,8,ORI,3)),U,6) S IEN3=0 D
..F S IEN3=$O(^OR(100,ORNUM,8,ORI,6,IEN3)) Q:'IEN3 S FUSR=+$G(^(IEN3,0)) I FUSR S LST(FUSR)=""
S ORDFN=+$P($G(^OR(100,ORNUM,0)),U,2)
D START^ORBPRCHK(.LST,ORNUM,6,ORDFN)
;add ordering provider
N ORDPROV
S ORDPROV=$$ORDERER^ORQOR2(ORNUM)
I $G(ORDPROV) S LST(ORDPROV)=""
D ADDSURR(.LST)
;p456 add the current user if they have a notification associated with the current order
N ORNLST,ORI,ORRTN,ORMTCH S ORNLST=0,ORI=0,ORMTCH=0,ORRTN=""
D GETUSER1^XQALDATA("ORNLST",DUZ) I ORNLST D
.F S ORI=$O(ORNLST(ORI)) Q:'ORI D Q:ORMTCH
..D GETDATA^ORWORB(.ORRTN,$P(ORNLST(ORI),U,2))
..I +ORRTN=ORNUM S LST(DUZ)="",ORMTCH=1
I $D(LST(USR)) S ORRET=0
Q ORRET
ADDSURR(LST) ;TAKE LIST OF USERS AND ADD SURROGATES TO THE LIST
N I
S I=0 F S I=$O(LST(I)) Q:'I S LST($$CURRSURO^XQALSURO(I))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWORR1 4394 printed Apr 09, 2024@21:29:09 Page 2
ORWORR1 ; SLC/JLI - Utilities for Retrieve Orders for Broker ;Dec 07, 2020@12:26:20
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,243,456,444,539**;Dec 17, 1997;Build 41
+2 ;Called from ORWORR
+3 ;EPIP/RTW Modified for the Unified Action Profile 26 Oct 2016
+4 ; External References
+5 ; DBIA 4834 GETUSER1^XQALDATA
+6 ; DBIA 2790 $$CURRSURO^XQALSURO
+7 ;
GET1 ;
+1 NEW ORGROUP
+2 SET TOT=^TMP("ORR",$JOB,ORLIST,"TOT")
KILL ^TMP("ORR",$JOB,ORLIST,"TOT")
+3 SET I=.1
FOR
SET I=$ORDER(^TMP("ORR",$JOB,ORLIST,I))
if 'I
QUIT
SET IFN=^(I)
Begin DoDot:1
+4 ;I $G(ORRECIP)&&($G(FILTER)=12&&($$FLAGRULE(+IFN))) K ^TMP("ORR",$J,ORLIST,I) S TOT=TOT-1 Q
+5 ;correction above line, error in XINDEX ;OR*405
+6 IF $GET(ORRECIP)
IF $GET(FILTER)=12
IF $$FLAGRULE(+IFN)
KILL ^TMP("ORR",$JOB,ORLIST,I)
SET TOT=TOT-1
QUIT
+7 IF ORWTS
IF (+$PIECE($GET(^OR(100,+IFN,0)),U,13)'=ORWTS)
KILL ^TMP("ORR",$JOB,ORLIST,I)
SET TOT=TOT-1
QUIT
+8 ;EPIP/RTW BEGIN ***UNIFIED ACTION PROFILE Modification*** 9/27/2017
+9 ;FILTER OUT NON OUTPATIENT ORDERS
+10 SET ORGROUP=$ORDER(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
+11 IF $GET(GROUPS)
IF $$GET1^DIQ(100.98,GROUPS,.01)="DISCHARGE MEDS"
IF $PIECE($GET(^OR(100,+IFN,0)),U,11)'=ORGROUP
KILL ^TMP("ORR",$JOB,ORLIST,I)
SET TOT=TOT-1
QUIT
+12 ;END ***UNIFIED ACTION PROFILE Modification*** 9/27/2017
+13 SET PTEVTID=$PIECE($GET(^OR(100,+IFN,0)),U,17)
+14 if PTEVTID>0
SET EVTNAME=$$NAME^OREVNTX(PTEVTID)
+15 SET ^TMP("ORR",$JOB,ORLIST,I)=IFN_U_$PIECE($GET(^OR(100,+IFN,0)),U,11)_U_$PIECE($GET(^(8,+$PIECE(IFN,";",2),0)),U)_U_PTEVTID_U_EVTNAME
End DoDot:1
+16 SET TXTVW=$SELECT(MULT:0,FILTER=2:2,1:1)
if FILTER=2
DO ORYD^ORDD100
+17 SET ^TMP("ORR",$JOB,ORLIST,.1)=TOT_U_TXTVW_U_$GET(ORYD,0)
+18 ;EPIP/RTW BEGIN ***UNIFIED ACTION PROFILE Modification*** 26/OCT/2016
+19 ;ALPHABETICAL ORDER SORT FOR UAP View
+20 ; Special sort for Discharge View
+21 IF $GET(GROUPS)
IF $$GET1^DIQ(100.98,GROUPS,.01)="DISCHARGE MEDS"
DO DCREF^ORTOULT4
+22 IF $GET(GROUPS)
IF $$GET1^DIQ(100.98,GROUPS,.01)="PHARMACY UAP"
DO REF^ORTOULT4
+23 ; END UAP modification
+24 SET REF=$NAME(^TMP("ORR",$JOB,ORLIST))
+25 QUIT
GET2 ; For AUTO DC/Event Release Orders
+1 NEW JDND,JDIX,JDCNT,DCSPLIT
+2 SET JDCNT=1
SET DCSPLIT=0
+3 SET TOT=^TMP("ORR",$JOB,ORLIST,"TOT")
KILL ^TMP("ORR",$JOB,ORLIST,"TOT")
+4 FOR JDND="RL","DC"
Begin DoDot:1
+5 SET I=.1
FOR
SET I=$ORDER(^TMP("ORR",$JOB,ORLIST,I))
if 'I
QUIT
Begin DoDot:2
+6 IF '$DATA(^TMP("ORR",$JOB,ORLIST,I,JDND))
QUIT
+7 SET JDIX=0
FOR
SET JDIX=$ORDER(^TMP("ORR",$JOB,ORLIST,I,JDND,JDIX))
if 'JDIX
QUIT
SET IFN=^(JDIX)
Begin DoDot:3
+8 IF 'DCSPLIT
IF (JDND="DC")
Begin DoDot:4
+9 SET ^TMP("ORRJD",$JOB,JDCNT)="DC START"
+10 SET DCSPLIT=1
SET JDCNT=JDCNT+1
SET TOT=TOT+1
End DoDot:4
+11 IF ORWTS
IF (+$PIECE($GET(^OR(100,+IFN,0)),U,13)'=ORWTS)
SET TOT=TOT-1
QUIT
+12 SET PTEVTID=$PIECE($GET(^OR(100,+IFN,0)),U,17)
+13 if PTEVTID>0
SET EVTNAME=$$NAME^OREVNTX(PTEVTID)
+14 SET ^TMP("ORRJD",$JOB,JDCNT)=IFN_U_$PIECE($GET(^OR(100,+IFN,0)),U,11)_U_$PIECE($GET(^(8,+$PIECE(IFN,";",2),0)),U)_U_PTEVTID_U_EVTNAME
+15 SET JDCNT=JDCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+16 SET TXTVW=$SELECT(MULT:0,FILTER=2:2,1:1)
if FILTER=2
DO ORYD^ORDD100
+17 SET ^TMP("ORRJD",$JOB,.1)=TOT_U_TXTVW_U_$GET(ORYD,0)
+18 SET REF=$NAME(^TMP("ORRJD",$JOB))
+19 QUIT
FLAGRULE(ORNUM,USR) ;
+1 ;returns 0 if we should keep ORNUM in the list
+2 ;returns 1 if we should remove ORNUM from the list
+3 ;determines based on whether the user USR should see these flagged orders
+4 ; based on presence in file 100 NODE 8 FIELD 39 and
+5 ; based on whether the user should have gotten the flag due to provider recipients
+6 NEW ORI,ORRET,ORQUIT,I,LST,ORDFN,IEN3,FUSR
+7 IF '$GET(USR)
SET USR=DUZ
+8 SET ORRET=1
SET ORQUIT=0
+9 SET ORI=0
FOR
SET ORI=$ORDER(^OR(100,ORNUM,8,ORI))
if 'ORI
QUIT
Begin DoDot:1
+10 IF '$PIECE($GET(^OR(100,ORNUM,8,ORI,3)),U,6)&($PIECE($GET(^OR(100,ORNUM,8,ORI,3)),U,9))
SET LST($PIECE($GET(^OR(100,ORNUM,8,ORI,3)),U,9))=""
+11 ;p539 add recipients who received notification for the current order
+12 IF '$PIECE($GET(^OR(100,ORNUM,8,ORI,3)),U,6)
SET IEN3=0
Begin DoDot:2
+13 FOR
SET IEN3=$ORDER(^OR(100,ORNUM,8,ORI,6,IEN3))
if 'IEN3
QUIT
SET FUSR=+$GET(^(IEN3,0))
IF FUSR
SET LST(FUSR)=""
End DoDot:2
End DoDot:1
+14 SET ORDFN=+$PIECE($GET(^OR(100,ORNUM,0)),U,2)
+15 DO START^ORBPRCHK(.LST,ORNUM,6,ORDFN)
+16 ;add ordering provider
+17 NEW ORDPROV
+18 SET ORDPROV=$$ORDERER^ORQOR2(ORNUM)
+19 IF $GET(ORDPROV)
SET LST(ORDPROV)=""
+20 DO ADDSURR(.LST)
+21 ;p456 add the current user if they have a notification associated with the current order
+22 NEW ORNLST,ORI,ORRTN,ORMTCH
SET ORNLST=0
SET ORI=0
SET ORMTCH=0
SET ORRTN=""
+23 DO GETUSER1^XQALDATA("ORNLST",DUZ)
IF ORNLST
Begin DoDot:1
+24 FOR
SET ORI=$ORDER(ORNLST(ORI))
if 'ORI
QUIT
Begin DoDot:2
+25 DO GETDATA^ORWORB(.ORRTN,$PIECE(ORNLST(ORI),U,2))
+26 IF +ORRTN=ORNUM
SET LST(DUZ)=""
SET ORMTCH=1
End DoDot:2
if ORMTCH
QUIT
End DoDot:1
+27 IF $DATA(LST(USR))
SET ORRET=0
+28 QUIT ORRET
ADDSURR(LST) ;TAKE LIST OF USERS AND ADD SURROGATES TO THE LIST
+1 NEW I
+2 SET I=0
FOR
SET I=$ORDER(LST(I))
if 'I
QUIT
SET LST($$CURRSURO^XQALSURO(I))=""
+3 QUIT
