- ORQ13 ;slc/dcm-Get patient orders in context ; 08 May 2002 2:12 PM
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165**;Dec 17, 1997
- ;
- EN ; -- Event Delayed: 24=All Delayed orders, or
- ; 15=Admission, 16=Discharge, 17=Transfer, 25=OR, 26=Manual
- ; or EVENT=ptr to Patient Event in #100.2
- D UNDO I $G(EVENT) D EN1 Q
- N TYPE,EVT,EVENT,IFN,X0,TM,STS
- S TYPE=$S(FLG=15:"A",FLG=16:"D",FLG=17:"T",FLG=25:"O",FLG=26:"M",1:"ADTOM")
- S EVT=0 F S EVT=+$O(^ORE(100.2,"AE",+PAT,EVT)) Q:EVT<1 S EVENT=+$O(^(EVT,0)) D
- . Q:TYPE'[$P($G(^ORD(100.5,EVT,0)),U,2) ;Q:$$LAPSED^OREVNTX(EVENT)
- . S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,EVENT,IFN)) Q:IFN<1 D ADD(IFN)
- S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST
- Q
- ;
- EN1 ; -- Delayed for EVENT [and related Pt Events]
- N DAD,CHLD S DAD=+$P($G(^ORE(100.2,EVENT,1)),U,5) ;EVENT=child
- I DAD<1,$O(^ORE(100.2,"DAD",EVENT,0)) S DAD=EVENT ;EVENT=parent
- D:DAD<1 EVNT(EVENT) I DAD D
- . D EVNT(DAD) S CHLD=0
- . F S CHLD=+$O(^ORE(100.2,"DAD",DAD,CHLD)) Q:CHLD<1 D EVNT(CHLD)
- S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST
- Q
- ;
- EVNT(EVENT) ; -- Orders tied to EVENT in #100.2
- N DONE,IFN,I,X,ORDER
- S DONE=$G(^ORE(100.2,EVENT,1)) D:DONE ;get released, dc'd orders
- . S I=+$O(^ORE(100.2,EVENT,10,"B"),-1),X=$P($G(^(I,0)),U,2) Q:X="LP"!(X="CA") ;skip if lapsed or cancelled
- . S ORDER=+$P($G(^ORE(100.2,EVENT,0)),U,4) D:ORDER ADD(ORDER,"RL")
- . S IFN=0 F S IFN=$O(^ORE(100.2,EVENT,2,IFN)) Q:IFN<1 D ADD(IFN,"RL")
- . S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,EVENT,IFN)) Q:IFN<1 I IFN'=ORDER,'$D(^ORE(100.2,EVENT,2,IFN)) D ADD(IFN,"RL")
- . S IFN=0 F S IFN=$O(^ORE(100.2,EVENT,3,IFN)) Q:IFN<1 D ADD(IFN,"DC")
- I 'DONE S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,EVENT,IFN)) Q:IFN<1 D ADD(IFN)
- Q
- ;
- ADD(IFN,TYPE) ; -- add EVENT order to list?
- N X0,X3,DA,X8,TM,CURR
- S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)) Q:'$D(ORGRP(+$P(X0,U,11)))
- Q:$P(X3,U,8) I $P(X3,U,9),'$P($G(^OR(100,$P(X3,U,9),3)),U,8) Q
- I $P(X3,U,3)=12,$P($G(^OR(100,+$P(X3,U,6),0)),U,17)=EVENT Q ;changed
- S CURR=$P(X3,U,7) S:CURR<1 CURR=+$O(^OR(100,IFN,8,"?"),-1) ;current/last
- S DA=0 F S DA=+$O(^OR(100,IFN,8,DA)) Q:DA<1 S X8=$G(^(DA,0)) D
- . S TM=$P(X8,U) Q:TM<SDATE Q:TM>EDATE
- . I DA'=CURR,$P(X8,U,15)'=11 Q ;current or unrel action
- . I DETAIL<2!'$L($G(TYPE)) D GET^ORQ12(IFN,ORLIST,DETAIL,DA) Q
- . S ORLST=ORLST+1,^TMP("ORGOTIT",$J,IFN,DA)=""
- . S ^TMP("ORR",$J,ORLIST,EVENT,TYPE,ORLST)=IFN_";"_DA
- Q
- ;
- UNDO ; -- un-invert dates from ORQ1
- N X S X=EDATE,EDATE=SDATE,SDATE=X
- S SDATE=9999999-SDATE,EDATE=9999999-EDATE
- Q
- ;
- QUIT ; -- stop
- Q
- ORQ13 ;slc/dcm-Get patient orders in context ; 08 May 2002 2:12 PM
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165**;Dec 17, 1997
- +2 ;
- EN ; -- Event Delayed: 24=All Delayed orders, or
- +1 ; 15=Admission, 16=Discharge, 17=Transfer, 25=OR, 26=Manual
- +2 ; or EVENT=ptr to Patient Event in #100.2
- +3 DO UNDO
- IF $GET(EVENT)
- DO EN1
- QUIT
- +4 NEW TYPE,EVT,EVENT,IFN,X0,TM,STS
- +5 SET TYPE=$SELECT(FLG=15:"A",FLG=16:"D",FLG=17:"T",FLG=25:"O",FLG=26:"M",1:"ADTOM")
- +6 SET EVT=0
- FOR
- SET EVT=+$ORDER(^ORE(100.2,"AE",+PAT,EVT))
- IF EVT<1
- QUIT
- SET EVENT=+$ORDER(^(EVT,0))
- Begin DoDot:1
- +7 ;Q:$$LAPSED^OREVNTX(EVENT)
- IF TYPE'[$PIECE($GET(^ORD(100.5,EVT,0)),U,2)
- QUIT
- +8 SET IFN=0
- FOR
- SET IFN=$ORDER(^OR(100,"AEVNT",PAT,EVENT,IFN))
- IF IFN<1
- QUIT
- DO ADD(IFN)
- End DoDot:1
- +9 SET ^TMP("ORR",$JOB,ORLIST,"TOT")=ORLST
- +10 QUIT
- +11 ;
- EN1 ; -- Delayed for EVENT [and related Pt Events]
- +1 ;EVENT=child
- NEW DAD,CHLD
- SET DAD=+$PIECE($GET(^ORE(100.2,EVENT,1)),U,5)
- +2 ;EVENT=parent
- IF DAD<1
- IF $ORDER(^ORE(100.2,"DAD",EVENT,0))
- SET DAD=EVENT
- +3 IF DAD<1
- DO EVNT(EVENT)
- IF DAD
- Begin DoDot:1
- +4 DO EVNT(DAD)
- SET CHLD=0
- +5 FOR
- SET CHLD=+$ORDER(^ORE(100.2,"DAD",DAD,CHLD))
- IF CHLD<1
- QUIT
- DO EVNT(CHLD)
- End DoDot:1
- +6 SET ^TMP("ORR",$JOB,ORLIST,"TOT")=ORLST
- +7 QUIT
- +8 ;
- EVNT(EVENT) ; -- Orders tied to EVENT in #100.2
- +1 NEW DONE,IFN,I,X,ORDER
- +2 ;get released, dc'd orders
- SET DONE=$GET(^ORE(100.2,EVENT,1))
- IF DONE
- Begin DoDot:1
- +3 ;skip if lapsed or cancelled
- SET I=+$ORDER(^ORE(100.2,EVENT,10,"B"),-1)
- SET X=$PIECE($GET(^(I,0)),U,2)
- IF X="LP"!(X="CA")
- QUIT
- +4 SET ORDER=+$PIECE($GET(^ORE(100.2,EVENT,0)),U,4)
- IF ORDER
- DO ADD(ORDER,"RL")
- +5 SET IFN=0
- FOR
- SET IFN=$ORDER(^ORE(100.2,EVENT,2,IFN))
- IF IFN<1
- QUIT
- DO ADD(IFN,"RL")
- +6 SET IFN=0
- FOR
- SET IFN=$ORDER(^OR(100,"AEVNT",PAT,EVENT,IFN))
- IF IFN<1
- QUIT
- IF IFN'=ORDER
- IF '$DATA(^ORE(100.2,EVENT,2,IFN))
- DO ADD(IFN,"RL")
- +7 SET IFN=0
- FOR
- SET IFN=$ORDER(^ORE(100.2,EVENT,3,IFN))
- IF IFN<1
- QUIT
- DO ADD(IFN,"DC")
- End DoDot:1
- +8 IF 'DONE
- SET IFN=0
- FOR
- SET IFN=$ORDER(^OR(100,"AEVNT",PAT,EVENT,IFN))
- IF IFN<1
- QUIT
- DO ADD(IFN)
- +9 QUIT
- +10 ;
- ADD(IFN,TYPE) ; -- add EVENT order to list?
- +1 NEW X0,X3,DA,X8,TM,CURR
- +2 SET X0=$GET(^OR(100,IFN,0))
- SET X3=$GET(^(3))
- IF '$DATA(ORGRP(+$PIECE(X0,U,11)))
- QUIT
- +3 IF $PIECE(X3,U,8)
- QUIT
- IF $PIECE(X3,U,9)
- IF '$PIECE($GET(^OR(100,$PIECE(X3,U,9),3)),U,8)
- QUIT
- +4 ;changed
- IF $PIECE(X3,U,3)=12
- IF $PIECE($GET(^OR(100,+$PIECE(X3,U,6),0)),U,17)=EVENT
- QUIT
- +5 ;current/last
- SET CURR=$PIECE(X3,U,7)
- IF CURR<1
- SET CURR=+$ORDER(^OR(100,IFN,8,"?"),-1)
- +6 SET DA=0
- FOR
- SET DA=+$ORDER(^OR(100,IFN,8,DA))
- IF DA<1
- QUIT
- SET X8=$GET(^(DA,0))
- Begin DoDot:1
- +7 SET TM=$PIECE(X8,U)
- IF TM<SDATE
- QUIT
- IF TM>EDATE
- QUIT
- +8 ;current or unrel action
- IF DA'=CURR
- IF $PIECE(X8,U,15)'=11
- QUIT
- +9 IF DETAIL<2!'$LENGTH($GET(TYPE))
- DO GET^ORQ12(IFN,ORLIST,DETAIL,DA)
- QUIT
- +10 SET ORLST=ORLST+1
- SET ^TMP("ORGOTIT",$JOB,IFN,DA)=""
- +11 SET ^TMP("ORR",$JOB,ORLIST,EVENT,TYPE,ORLST)=IFN_";"_DA
- End DoDot:1
- +12 QUIT
- +13 ;
- UNDO ; -- un-invert dates from ORQ1
- +1 NEW X
- SET X=EDATE
- SET EDATE=SDATE
- SET SDATE=X
- +2 SET SDATE=9999999-SDATE
- SET EDATE=9999999-EDATE
- +3 QUIT
- +4 ;
- QUIT ; -- stop
- +1 QUIT
