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

ORWORR.m

Go to the documentation of this file.
  1. ORWORR ; SLC/KCM/JLI - Retrieve Orders for Broker ; Nov 18, 2022@12:08:57
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,92,116,110,132,141,163,189,195,215,243,280,306,471,444,515,405,577**;Dec 17, 1997;Build 12
  1. ;
  1. ; Reference to ^SC in ICR #10040
  1. ; Reference to ^DPT( in ICR #10035
  1. ; Reference to ^VA(200 in ICR #10060
  1. ; Reference to ^%DTC in ICR #10000
  1. ; Reference to GET^XPAR in ICR #2263
  1. ; Reference to XUSER in ICR #2343
  1. ; Reference to PSO52EX in ICR #4902
  1. ;
  1. GET(LST,DFN,FILTER,GROUPS) ; procedure
  1. Q ; don't call until using same treating specialty logic as AGET
  1. ; & until MULT, ORWARD, & ORIGVIEW implemented
  1. ; & until the date ranges implemented
  1. ; Get orders for patient
  1. ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
  1. ; .LST=~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^^Schedule
  1. ; .LST=tOrder Text (repeating as necessary)
  1. ; DFN=Patient ID
  1. ; FILTER=# indicates which orders to return, default=2 (current)
  1. ; GROUPS=display grp of orders to show (default=ALL)
  1. ; -- section uses ORQ1 to get orders list rather than XGET --
  1. N ORLIST,ORIFN,X0,X3,X8,IDX,IFN,ACT,PRV,LN,TXT,STRT,STOP,CSTS,EYE,DEA ;PKI
  1. K ^TMP("ORR",$J)
  1. S (IDX,LST)=0 S:'$D(GROUPS) GROUPS=1 S:'$D(FILTER) FILTER=2
  1. D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"","","",0,1)
  1. S EYE=0 F S EYE=$O(^TMP("ORR",$J,ORLIST,EYE)) Q:'EYE S IFN=^(EYE) D
  1. . S ACT=$P(IFN,";",2),IFN=+IFN,X0=^OR(100,IFN,0),X3=^(3),X8=^(8,ACT,0)
  1. . D GETFLDS
  1. K ^TMP("ORR",$J)
  1. G EXIT
  1. AGET(REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT,ORRECIP) ;Get abbrev. event delayed order list for patient
  1. ; returns ^TMP("ORR",$J,ORLIST,n)=IFN^DGrp^ActTm
  1. ; see input parameters above
  1. ; -- from ORWORR
  1. ; -- section uses ORQ1 to get orders list rather than XGET --
  1. K ORUGROUP ;RTW UAP Pharmacist modify indication removal for UAP
  1. N ORLIST,ORIFN,IFN,I,ORWTS,TOT,MULT,ORWARD,TXTVW,ORYD,PTEVTID,EVTNAME
  1. S (PTEVTID,EVTNAME)=""
  1. K ^TMP("ORR",$J),^TMP("ORRJD",$J)
  1. S:'$D(GROUPS) GROUPS=1 S:'$D(FILTER) FILTER=2
  1. I $G(GROUPS),($$GET1^DIQ(100.98,GROUPS,.01)="PHARMACY UAP")!($$GET1^DIQ(100.98,GROUPS,.01)="DISCHARGE MEDS") S ORUGROUP=GROUPS ;Capturing GROUPS for later UAP use GETFLDS
  1. S ORWTS=+$P(FILTER,U,2),FILTER=+FILTER
  1. S MULT=$S("^1^6^8^9^10^11^13^14^20^22^29^30^31^32^"[(U_FILTER_U):1,1:0)
  1. I DFN="" D Q
  1. .S ^TMP("ORR",$J,$H)=""
  1. .S ^TMP("ORR",$J,$H,.1)="0^0^0"
  1. I $L($G(^DPT(DFN,.1))) S ORWARD=1 ; normally ptr to 42
  1. S:'$L($G(DTFROM)) DTFROM=0
  1. S:'$L($G(DTTHRU)) DTTHRU=0
  1. I $P(DTFROM,".")=$P(DTTHRU,"."),$P(DTFROM,".",2)>$P(DTTHRU,".",2),$P(DTTHRU,".",2)="" S $P(DTTHRU,".",2)=2359
  1. S:'$L($G(EVENT)) EVENT=0
  1. I $G(EVTDCREL)="TRUE" D
  1. . D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"",DTFROM,DTTHRU,2,MULT,"",1,EVENT)
  1. . D GET2^ORWORR1
  1. E D
  1. . D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"",DTFROM,DTTHRU,0,MULT,"",1,EVENT)
  1. . D GET1^ORWORR1
  1. Q
  1. RGET(REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT) ;Orders of AutoDC/Release Event
  1. N EVTDCREL
  1. S EVTDCREL="TRUE"
  1. D AGET(.REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT)
  1. Q
  1. XGET ; retrieval algorithm before all the AC xref changes
  1. N X,X0,X3,IDX,IFN,LN,TIME,DGRP,MASK,TXT,ACT,PRV,ID,DEA,PASS ;PKI
  1. S DFN=DFN_";DPT(",IDX=0,LST=0
  1. I '$G(FILTER) S FILTER=2 ; Default: Current/Active
  1. I $D(GROUPS)=1 D
  1. . S:'GROUPS GROUPS=$O(^ORD(100.98,"B",GROUPS,0))
  1. . D XPND(GROUPS)
  1. I FILTER=1 D DOALL G EXIT ; All
  1. I FILTER=2 D DOCUR G EXIT ; Current
  1. I FILTER=3 S PASS=";1;" ; Discontinued
  1. I FILTER=4 S PASS=";2;7;" ; Comp/Expired
  1. I FILTER=5 S PASS=";3;4;5;6;8;9;" ; Expiring
  1. I FILTER=6 S PASS=";1;2;3;4;5;6;7;8;9;11;" ; New Activity
  1. I FILTER=7 S PASS=";5;" ; Pending
  1. I FILTER=8 Q ; Expanded
  1. I FILTER=9 S PASS=";3;4;5;6;8;9;11;" ; Unverified by Nurse
  1. I FILTER=10 S PASS=";3;4;5;6;8;9;11;" ; Unverified by Clerk
  1. I FILTER=11 S PASS=";3;4;5;6;7;8;11;" ; Unsigned
  1. I FILTER=12 S PASS=";4;" ; Flagged
  1. I FILTER=13 S PASS="" ; Verbal/Phone
  1. I FILTER=14 S PASS="" ; Verbal/Phone Unsigned
  1. D DOGET
  1. EXIT I LST=0 D
  1. . N %,X,%I D NOW^%DTC
  1. . S LST(1)="~0^0^"_%_"^^^97",LST(2)="tNo Orders Found."
  1. Q
  1. DOGET ; Here to filter orders
  1. S TIME=0 F S TIME=$O(^OR(100,"AO",DFN,TIME)) Q:'TIME D
  1. . S DGRP=0 F S DGRP=$O(^OR(100,"AO",DFN,TIME,DGRP)) Q:'DGRP D
  1. . . I $D(GROUPS)>1 Q:'$D(GROUPS(DGRP)) ;filter by display grp
  1. . . S IFN=0 F S IFN=$O(^OR(100,"AO",DFN,TIME,DGRP,IFN)) Q:'IFN D
  1. . . . S X0=^OR(100,IFN,0),X3=^(3) ;get main nodes
  1. . . . I $P(X3,U,8)!$P(X3,U,9)!($P(X3,U,3)=99) Q ;skip veil,chld,sts=99
  1. . . . I $L(PASS),(PASS'[(";"_$P(X3,U,3)_";")) Q ;filter by status
  1. . . . ; any other filtering
  1. . . . D GETFLDS
  1. Q
  1. DOALL ; Here to get all orders (no filter by status)
  1. S TIME=0 F S TIME=$O(^OR(100,"AO",DFN,TIME)) Q:'TIME D
  1. . S DGRP=0 F S DGRP=$O(^OR(100,"AO",DFN,TIME,DGRP)) Q:'DGRP D
  1. . . I $D(GROUPS)>1 Q:'$D(GROUPS(DGRP)) ;filter by display grp
  1. . . S IFN=0 F S IFN=$O(^OR(100,"AO",DFN,TIME,DGRP,IFN)) Q:'IFN D
  1. . . . S X0=^OR(100,IFN,0),X3=^(3) ;get main nodes
  1. . . . I $P(X3,U,8)!$P(X3,U,9)!($P(X3,U,3)=99) Q ;skip veil,chld,sts=99
  1. . . . D GETFLDS
  1. Q
  1. DOCUR ; Here to get all current orders
  1. N AOCTXT,STS,STOP,%
  1. S X=-$$GET^XPAR("ALL","ORPF ACTIVE ORDERS CONTEXT HRS")
  1. S %H=$H,X=(%H*86400+$P(%H,",",2))+(X*3600),%H=(X\86400)_","_(X#86400)
  1. D YMD^%DTC S AOCTXT=X_%
  1. S MASK="110000100101110" ; mask out STS=1,2,7,10,12,13,14
  1. S TIME=0 F S TIME=$O(^OR(100,"AC",DFN,TIME)) Q:'TIME D
  1. . S IFN=0 F S IFN=$O(^OR(100,"AC",DFN,TIME,IFN)) Q:'IFN D
  1. . . ; filter out display groups here
  1. . . S ACT=0 F S ACT=$O(^OR(100,"AC",DFN,TIME,IFN,ACT)) Q:'ACT D
  1. . . . S X0=^OR(100,IFN,0),X3=^(3),X8=^(8,ACT,0)
  1. . . . S STS=$P(X3,U,3),STOP=$P(X0,U,9)
  1. . . . I $P(X3,U,8)!$P(X3,U,9)!(STS=99) Q
  1. . . . I $P(X8,U,15)=13,($P(X8,U)<AOCTXT) D ACKILL Q
  1. . . . I $P(X8,U,15)=13!($P(X8,U,15)=""),("RN^XX"[$P(X8,U,2)) D ACKILL Q
  1. . . . I $E(MASK,STS),STOP<AOCTXT D ACKILL Q
  1. . . . D GETFLDS
  1. Q
  1. ACKILL ; called only from DOCUR - kill AC xref
  1. ; K ^OR(100,"AC",DFN,TIME,IFN,ACT) ; let ORQ1 kill if for now
  1. Q
  1. GET4V11(LST,TXTVW,ORYD,IFNLST) ; get order fields TEMP
  1. G GET41
  1. GET4LST(LST,IFNLST) ; get order fields for list of orders
  1. GET41 N ACT,ACTID,IDX,X0,X3,X8,PRV,ID,LN,TXT,STRT,STOP,CSTS,IFN,IFNIDX,ORIGVIEW,DEA,ORIND ;PKI;*405-IND
  1. N LOC ;IMO
  1. S (IDX,LST,IFNIDX)=0
  1. F S IFNIDX=$O(IFNLST(IFNIDX)) Q:'IFNIDX S IFN=IFNLST(IFNIDX) D
  1. . S ACT=$S($P(IFN,";",2):$P(IFN,";",2),1:1),IFN=+IFN
  1. . S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)),X8=$G(^(8,ACT,0))
  1. . D GETFLDS
  1. Q
  1. GETBYIFN(LST,IFN) ; procedure
  1. ; get fields for single order
  1. ; .LST(n)=described above in GET
  1. ; IFN=internal entry # for order
  1. I 'IFN Q
  1. N ACT,IDX,X0,X3,X8,PRV,ID,LN,TXT,STRT,STOP,CSTS,ACTID,ORIGVIEW,ORYD,TXTVW,DEA ;PKI
  1. S IDX=0,LST=0,ORYD=0
  1. S X0=$G(^OR(100,+IFN,0)),X3=$G(^(3))
  1. S ACT=$S($P(IFN,";",2):$P(IFN,";",2),$P(X3,U,7):$P(X3,U,7),1:1)
  1. S IFN=+IFN,X8=$G(^OR(100,IFN,8,ACT,0))
  1. GETFLDS ; used by entry points to place order fields into list
  1. ; expects IDX=sequence #, IFN=order, X0=node 0, X3=node 3, LST=results
  1. ; LST(IDX)=~IFN^Grp^OrdTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^Act^Flagged[^DCType]^ChartRev^DEA#^^DigSig^LOC^[DCORIGNAL]^IsPendingDCorder^IsDelayOrder^ParkedStatus^^PackagePrefix
  1. S PRV=$P(X8,U,5) S:'PRV PRV=$P(X8,U,3) S PRV=PRV_U
  1. I PRV S PRV=PRV_$P(^VA(200,+PRV,0),U)
  1. S DEA=$$DEA^XUSER(,+PRV) ; get user DEA info - PKI
  1. S IDX=IDX+1,LST=LST+1,ID=IFN_";"_ACT,ACTID=$P(X8,U,2)
  1. S CSTS=$S($P(X8,U,15):$P(X8,U,15),1:$P(X3,U,3))
  1. I $P(X8,U,15)=10,$P(X3,U,3)=14 S CSTS=14 ;delayed-lapsed order
  1. S STRT=$S($P(X3,U,3)=11:$$RSTRT,ACTID="NW"!(ACTID="XX")!(ACTID="RL"):$P(X0,U,8),ACTID="DC":"",1:$P(X8,U)) ;110
  1. S STOP=$S($P(X3,U,3)=11:$$RSTOP,ACTID="HD":$P($G(^OR(100,+IFN,8,ACT,2)),U),1:$P(X0,U,9))
  1. S LST(IDX)="~"_ID_U_$P(X0,U,11)_U_$P(X8,U)_U_STRT_U_STOP_U_CSTS_U_$P(X8,U,4)_U_$P(X8,U,8)_U_$P(X8,U,10)_U_PRV
  1. I '$D(ORUGROUP) S ORUGROUP="" ;RTW Pharmacist modify indication removal for UAP, first time entering CPRS all services view
  1. I $$PARK^PSO52EX(+IFN),ACT=$P(X3,U,7) S $P(LST(IDX),U,25)="active/parked" ;405 set status of prescription tied to current action if it is "PARKED"
  1. I $$SUSP^PSO52EX(+IFN),ACT=$P(X3,U,7) S $P(LST(IDX),U,25)="active/susp" ;405 set status of prescription tied to current action if it is "Suspended"
  1. S $P(LST(IDX),U,13)=+$G(^OR(100,IFN,8,ACT,3)) ; flagged
  1. I +$P(X8,U,8) S $P(LST(IDX),U,8)=$$INITIALS^ORCHTAB2(+$P(X8,U,8)) ;nurse
  1. I +$P(X8,U,10) S $P(LST(IDX),U,9)=$$INITIALS^ORCHTAB2(+$P(X8,U,10)) ;clerk
  1. I +$P(X8,U,18) S $P(LST(IDX),U,15)=$$INITIALS^ORCHTAB2(+$P(X8,U,18)) ;chart review
  1. I $L($G(DEA)) S $P(LST(IDX),U,16)=DEA ;PKI
  1. I $P($G(^OR(100,IFN,8,ACT,2)),"^",5) S $P(LST(IDX),U,18)=$P(^(2),"^",4)
  1. I '$P($G(^OR(100,IFN,8,ACT,2)),"^",5),$P(X0,"^",5) D ;Copy orders PKI fix
  1. . N OI,ORVP,ORCAT,PKG,ORPKIU
  1. . S OI=+$O(^OR(100,IFN,4.5,"ID","ORDERABLE",0)),OI=+$G(^OR(100,IFN,4.5,OI,1)) Q:'OI
  1. . S ORVP=$P(X0,"^",2),PKG=$P(X0,"^",14)
  1. . S ORCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O")
  1. . I PKG'=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",0)) Q
  1. . S ORPKIU=0 I $D(^ORD(100.7,"C",DUZ)) S ORPKIU=1
  1. . D PKI^ORWDPS1(.ORY,OI,ORCAT,+ORVP,ORPKIU)
  1. . I $E($G(ORY))=2 S $P(LST(IDX),U,18)=ORY
  1. ; Change to display location for Clinic Orders, Inpatients, & IV infusion orders.
  1. N DGID,DGNAM
  1. S LOC=""
  1. S DGID=$P(X0,U,11)
  1. I $L(DGID) D
  1. .S DGNAM=$P($G(^ORD(100.98,DGID,0)),U)
  1. .;I DGNAM="CLINIC ORDERS"!(DGNAM="INPATIENT MEDICATIONS")!(DGNAM="IV MEDICATIONS")!(DGNAM="UNIT DOSE MEDICATIONS") D
  1. .S LOC=$P(X0,U,10) ;IMO
  1. .S:+LOC LOC=$P($G(^SC(+LOC,0)),U)_":"_+LOC ;IMO
  1. S $P(LST(IDX),U,19)=LOC ;IMO
  1. S $P(LST(IDX),U,20)=$P($G(^OR(100,IFN,6)),"^",9)
  1. ;need a way to determine if order is in an unsigned DC state.
  1. S $P(LST(IDX),U,21)=$S(ACTID="DC":1,1:0)
  1. S $P(LST(IDX),U,22)=$$CHKORD^OREVNTX1(IFN)
  1. D
  1. . N OI,ORVP,ORCAT,PKG,ORCONSUB,ORCSPKG,ORYD
  1. . S ORCSPKG=""
  1. . S OI=+$O(^OR(100,IFN,4.5,"ID","ORDERABLE",0)),OI=+$G(^OR(100,IFN,4.5,OI,1)) Q:'OI
  1. . S ORVP=$P(X0,"^",2),PKG=$P(X0,"^",14)
  1. . S ORCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O")
  1. . I PKG=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",0)) S ORCSPKG="O"
  1. . I PKG=$O(^DIC(9.4,"B","UNIT DOSE MEDICATIONS",0)) S ORCSPKG="I"
  1. . I PKG=$O(^DIC(9.4,"B","INPATIENT MEDICATIONS",0)) S ORCSPKG="I"
  1. . I PKG=$O(^DIC(9.4,"B","IV MEDICATIONS",0)) S ORCSPKG="I"
  1. . I ORCSPKG="" S $P(LST(IDX),U,23,24)="0^0" Q
  1. . D CSCHECK^ORDEA(.ORCONSUB,OI,ORCSPKG)
  1. . S $P(LST(IDX),U,23)=$P(ORCONSUB,U)
  1. . S $P(LST(IDX),U,24)=$P(ORCONSUB,U,2)
  1. ;
  1. D
  1. . N PKGID
  1. . S PKGID=$P(X0,U,14)
  1. . I PKGID>0 S $P(LST(IDX),U,26)=$P($G(^DIC(9.4,PKGID,0)),U,2)
  1. S ORIGVIEW=$S($G(TXTVW)=0:0,$G(TXTVW)=1:1,ORYD=-1:1,'ORYD:1,$P(X8,U)'<ORYD:0,1:1)
  1. K TXT D TEXT^ORQ12(.TXT,ID,255,ORUGROUP) ; optimize later ;RTW PASSING ORUGROUP
  1. I $O(^OR(100,+IFN,2,0)) S LN=$O(TXT(0)),TXT(LN)="+"_TXT(LN)
  1. I $O(^OR(100,+IFN,8,"C","XX",0)),'$G(ORUGROUP) S LN=$O(TXT(0)),TXT(LN)="*"_TXT(LN) ;RTW ORUGROUP
  1. S (LN,ORIND)=0 F S LN=$O(TXT(LN)) Q:'LN S IDX=IDX+1,LST(IDX)="t"_TXT(LN) S:LST(IDX)["Indication" ORIND=IDX ;*405-IND
  1. I $$ISTITR^ORUTL3(+IFN) D
  1. . S ORX="** This Rx contains a separate titration and maintenance component to its schedule and instructions **"
  1. . S IDX=IDX+1
  1. . S LST(IDX)="t"_ORX
  1. I $O(^OR(100,+IFN,8,1,.2,0)) S IDX=IDX+1,LST(IDX)="|" D ;PKI XMLText
  1. . S I=0 F S I=$O(^OR(100,+IFN,8,1,.2,I)) Q:'I S IDX=IDX+1,LST(IDX)="x"_^(I,0)
  1. ;*405-IND
  1. D:$O(^OR(100,IFN,4.5,"ID","INDICATION",0))
  1. . N Z S Z=$O(^OR(100,IFN,4.5,"ID","INDICATION",0))
  1. . S Z=$P($G(^OR(100,IFN,4.5,Z,1)),"^")
  1. . I Z]"" S Z="tIndication: "_Z D
  1. . . I $G(ORIND) S LST(ORIND)=Z
  1. . . E S IDX=IDX+1,LST(IDX)=Z
  1. Q
  1. RSTRT() ; return start date from responses
  1. Q $G(^OR(100,IFN,4.5,+$O(^OR(100,IFN,4.5,"ID","START",0)),1))
  1. RSTOP() ; return stop date from responses
  1. Q $G(^OR(100,IFN,4.5,+$O(^OR(100,IFN,4.5,"ID","STOP",0)),1))
  1. GETTXT(LST,IFN) ; get text of an order
  1. I $L(IFN,";")=1 S IFN=IFN_";1"
  1. D TEXT^ORQ12(.LST,IFN,255)
  1. Q
  1. XPND(AGRP) ; procedure
  1. ; Expand display group (GROUPS defined outside of call)
  1. N I,CHLD
  1. S GROUPS(AGRP)=^ORD(100.98,AGRP,0),I=0
  1. F S I=$O(^ORD(100.98,AGRP,1,I)) Q:'I S CHLD=$P(^(I,0),U) D XPND(CHLD)
  1. Q
  1. GETPKG(Y,IFN) ; get order pkg
  1. N ORDERID,PKGID
  1. Q:+IFN<1
  1. S ORDERID=+IFN,Y=""
  1. S PKGID=$P(OR(100,ORDERID,0),U,14)
  1. S:PKGID>0 Y=$P(^DIC(9.4,PKGID,0),U,2)
  1. Q