- 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 Feb 19, 2025@00:03:27 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