ORX8 ; slc/dcm,MKB - OE/RR Orders file extracts ; 08 May 2002 2:12 PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**13,21,48,68,92,141,163**;Dec 17, 1997
;
EN(ORIFN) ;Returns data from file 100 in the ORUPCHUK array [DBIA#871]
Q:'$D(ORIFN) Q:'$D(^OR(100,+ORIFN,0)) K ORUPCHUK
D A
K ORTX,X0,X3,%X,%Y,J,ORINDX,X
Q
A S X0=^OR(100,ORIFN,0),X3=^(3),ORUPCHUK("ORPK")=$S($D(^(4)):^(4),1:"")
S ORUPCHUK("ORVP")=$P(X0,"^",2),ORUPCHUK("ORPCL")=$P(X0,"^",5),X=$P(X0,"^",6),ORUPCHUK("ORDUZ")=X_"^"_$S($D(^VA(200,+X,0)):$P(^(0),"^"),1:""),ORUPCHUK("ORODT")=$P(X0,"^",7),ORUPCHUK("ORSTOP")=$P(X0,"^",9),ORUPCHUK("ORL")=$P(X0,"^",10)
S X=$P(X0,"^",11),ORUPCHUK("ORTO")=X_"^"_$S($D(^ORD(100.98,+X,0)):$P(^(0),"^"),1:"")
S X=$P(X3,"^",3),ORUPCHUK("ORSTS")=X_"^"_$P(^ORD(100.01,X,0),"^"),ORUPCHUK("ORSTRT")=$P(X0,"^",8),X=$P(X0,"^",4),(ORUPCHUK("ORNP"),ORUPCHUK("ORPV"))=X_"^"_$S(X:$S($D(^VA(200,+X,0)):$P(^(0),"^"),1:""),1:"")
D TEXT^ORQ12(.ORTX,ORIFN,$G(ORLENGTH))
I $O(ORTX(0)) S %X="ORTX(",%Y="ORUPCHUK(""ORTX""," D %XY^%RCR
Q
;
VALUE(IFN,ID,INST,FORMAT) ; -- Returns value of prompt by ID
I '$G(IFN)!('$D(^OR(100,+$G(IFN),0)))!($G(ID)="") Q ""
N I,Y S I=0,Y="" S:'$G(INST) INST=1
F S I=$O(^OR(100,+IFN,4.5,"ID",ID,I)) Q:I'>0 I $P($G(^OR(100,+IFN,4.5,+I,0)),U,3)=INST S PRMT=+$P(^(0),U,2),Y=$G(^(1)) Q
I $L(Y),$G(PRMT),$G(FORMAT)="E" D ; get external form of Y
. N ORDIALOG S ORDIALOG(PRMT,0)=$G(^ORD(101.41,PRMT,1))
. S ORDIALOG(PRMT,1)=Y,Y=$$EXT^ORCD(PRMT,1)
Q Y
;
OI(IFN) ; -- Returns [first] orderable item for order IFN in the format
; ifn ^ name ^ pkg id [DBIA#2467]
I '$G(IFN)!('$D(^OR(100,+$G(IFN),0))) Q ""
N I,X,Y S I=$O(^OR(100,+IFN,.1,0)),X=$G(^(+I,0)),Y=""
I X,$D(^ORD(101.43,+X,0)) S Y=+X_U_$P(^(0),U,1,2)
Q Y
;
LATEST(ORPAT,ORIT,ORY) ; -- Return most recent orders for ORPAT,ORIT as
; ORY = total number of orders found (or 0 if none found)
; ORY(ORSTS) = ORIFN ^ Ord'd By ^ Entered ^ StartDt ^ StopDt ^ Loc ^ Sts
; where ORSTS is the ien in the Order Status file #100.01 [DBIA#2842]
;
N ORVP,ORIDT,ORIFN,OR0,OR3,ORSTS,ORSTSNM
S ORVP=+ORPAT_";DPT(",ORY=0 Q:'$G(ORPAT) Q:'$G(ORIT) ;invalid input
S ORIDT=0 F S ORIDT=$O(^OR(100,"AOI",+ORIT,ORVP,ORIDT)) Q:ORIDT'>0 D
. S ORIFN=0 F S ORIFN=$O(^OR(100,"AOI",+ORIT,ORVP,ORIDT,ORIFN)) Q:ORIFN'>0 D
.. S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORSTS=+$P(OR3,U,3)
.. Q:ORSTS'>0 Q:$G(ORY(ORSTS)) ;return only latest order per status
.. S ORSTSNM=$$LOW^XLFSTR($P($G(^ORD(100.01,ORSTS,0)),U))
.. S ORY=ORY+1,ORY(ORSTS)=ORIFN_U_$P(OR0,U,4)_U_$P(OR0,U,7,10)_U_ORSTSNM
Q
;
DELAYED(ORY,ORDER) ; -- Return delayed order(s) with same OrdItem as ORDER
; in ORY(ORIFN) = PatEventPtr ^ EventName
;
N ORI,ORIT,ORIFN S (ORY,ORI)=0
F S ORI=$O(^OR(100,+ORDER,.1,ORI)) Q:ORI'>0 S ORIT=+$G(^(ORI,0)) D
. S EVT=0 F S EVT=$O(^ORE(100.2,"AE",+ORVP,EVT)) Q:EVT<1 S PTEVT=+$O(^(EVT,0)) D ;pending events
.. S ORIFN=0 F S ORIFN=+$O(^OR(100,"AEVNT",ORVP,PTEVT,ORIFN)) Q:ORIFN<1 D ;delayed orders
... Q:ORIFN=+ORDER Q:'$D(^OR(100,ORIFN,.1,"B",ORIT))
... Q:"^1^2^7^12^13^14^"[(U_$P($G(^OR(100,ORIFN,3)),U,3)_U) ;terminated
... S ORY=ORY+1,ORY(ORIFN)=PTEVT_U_$P($G(^ORD(100.5,EVT,0)),U)
Q
;
PKGID(ORIFN) ; -- Return package identifier for order ORIFN [DBIA#3071]
Q $G(^OR(100,+$G(ORIFN),4))
;
ES(ORDER) ; -- Returns the signature status of ORDER [DBIA#3632]
; -1 = invalid order#
; "" = no signature required
; 0 = not signed (needs ES)
; 1 = electronically or digitally signed
; 2 = signed on chart
; 3 = corrected or canceled order
N X,Y,DA I '$G(ORDER)!'$D(^OR(100,+$G(ORDER),0)) Q -1
S DA=+$P(ORDER,";",2) S:DA<1 DA=+$P($G(^OR(100,+ORDER,3)),U,7)
S X=$P($G(^OR(100,+ORDER,8,DA,0)),U,4)
S Y=$S(X=2:0,X=1!(X=7):1,X=0!(X=4):2,X=5!(X=6):3,1:"")
Q Y
;
AND(DAD) ; -- Return 1 or 0, if all conjunctions are AND [DBIA#3632]
N I,Y S I=0,Y=1
F S I=+$O(^OR(100,+$G(DAD),4.5,"ID","CONJ",I)) Q:I<1 I $E($G(^OR(100,+$G(DAD),4.5,I,1)))'="A" S Y=0 Q
Q Y
ORX8 ; slc/dcm,MKB - OE/RR Orders file extracts ; 08 May 2002 2:12 PM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**13,21,48,68,92,141,163**;Dec 17, 1997
+2 ;
EN(ORIFN) ;Returns data from file 100 in the ORUPCHUK array [DBIA#871]
+1 IF '$DATA(ORIFN)
QUIT
IF '$DATA(^OR(100,+ORIFN,0))
QUIT
KILL ORUPCHUK
+2 DO A
+3 KILL ORTX,X0,X3,%X,%Y,J,ORINDX,X
+4 QUIT
A SET X0=^OR(100,ORIFN,0)
SET X3=^(3)
SET ORUPCHUK("ORPK")=$SELECT($DATA(^(4)):^(4),1:"")
+1 SET ORUPCHUK("ORVP")=$PIECE(X0,"^",2)
SET ORUPCHUK("ORPCL")=$PIECE(X0,"^",5)
SET X=$PIECE(X0,"^",6)
SET ORUPCHUK("ORDUZ")=X_"^"_$SELECT($DATA(^VA(200,+X,0)):$PIECE(^(0),"^"),1:"")
SET ORUPCHUK("ORODT")=$PIECE(X0,"^",7)
SET ORUPCHUK("ORSTOP")=$PIECE(X0,"^",9)
SET ORUPCHUK("ORL")=$PIECE(X0,"^",10)
+2 SET X=$PIECE(X0,"^",11)
SET ORUPCHUK("ORTO")=X_"^"_$SELECT($DATA(^ORD(100.98,+X,0)):$PIECE(^(0),"^"),1:"")
+3 SET X=$PIECE(X3,"^",3)
SET ORUPCHUK("ORSTS")=X_"^"_$PIECE(^ORD(100.01,X,0),"^")
SET ORUPCHUK("ORSTRT")=$PIECE(X0,"^",8)
SET X=$PIECE(X0,"^",4)
SET (ORUPCHUK("ORNP"),ORUPCHUK("ORPV"))=X_"^"_$SELECT(X:$SELECT($DATA(^VA(200,+X,0)):$PIECE(^(0),"^"),1:""),1:"")
+4 DO TEXT^ORQ12(.ORTX,ORIFN,$GET(ORLENGTH))
+5 IF $ORDER(ORTX(0))
SET %X="ORTX("
SET %Y="ORUPCHUK(""ORTX"","
DO %XY^%RCR
+6 QUIT
+7 ;
VALUE(IFN,ID,INST,FORMAT) ; -- Returns value of prompt by ID
+1 IF '$GET(IFN)!('$DATA(^OR(100,+$GET(IFN),0)))!($GET(ID)="")
QUIT ""
+2 NEW I,Y
SET I=0
SET Y=""
IF '$GET(INST)
SET INST=1
+3 FOR
SET I=$ORDER(^OR(100,+IFN,4.5,"ID",ID,I))
IF I'>0
QUIT
IF $PIECE($GET(^OR(100,+IFN,4.5,+I,0)),U,3)=INST
SET PRMT=+$PIECE(^(0),U,2)
SET Y=$GET(^(1))
QUIT
+4 ; get external form of Y
IF $LENGTH(Y)
IF $GET(PRMT)
IF $GET(FORMAT)="E"
Begin DoDot:1
+5 NEW ORDIALOG
SET ORDIALOG(PRMT,0)=$GET(^ORD(101.41,PRMT,1))
+6 SET ORDIALOG(PRMT,1)=Y
SET Y=$$EXT^ORCD(PRMT,1)
End DoDot:1
+7 QUIT Y
+8 ;
OI(IFN) ; -- Returns [first] orderable item for order IFN in the format
+1 ; ifn ^ name ^ pkg id [DBIA#2467]
+2 IF '$GET(IFN)!('$DATA(^OR(100,+$GET(IFN),0)))
QUIT ""
+3 NEW I,X,Y
SET I=$ORDER(^OR(100,+IFN,.1,0))
SET X=$GET(^(+I,0))
SET Y=""
+4 IF X
IF $DATA(^ORD(101.43,+X,0))
SET Y=+X_U_$PIECE(^(0),U,1,2)
+5 QUIT Y
+6 ;
LATEST(ORPAT,ORIT,ORY) ; -- Return most recent orders for ORPAT,ORIT as
+1 ; ORY = total number of orders found (or 0 if none found)
+2 ; ORY(ORSTS) = ORIFN ^ Ord'd By ^ Entered ^ StartDt ^ StopDt ^ Loc ^ Sts
+3 ; where ORSTS is the ien in the Order Status file #100.01 [DBIA#2842]
+4 ;
+5 NEW ORVP,ORIDT,ORIFN,OR0,OR3,ORSTS,ORSTSNM
+6 ;invalid input
SET ORVP=+ORPAT_";DPT("
SET ORY=0
IF '$GET(ORPAT)
QUIT
IF '$GET(ORIT)
QUIT
+7 SET ORIDT=0
FOR
SET ORIDT=$ORDER(^OR(100,"AOI",+ORIT,ORVP,ORIDT))
IF ORIDT'>0
QUIT
Begin DoDot:1
+8 SET ORIFN=0
FOR
SET ORIFN=$ORDER(^OR(100,"AOI",+ORIT,ORVP,ORIDT,ORIFN))
IF ORIFN'>0
QUIT
Begin DoDot:2
+9 SET OR0=$GET(^OR(100,+ORIFN,0))
SET OR3=$GET(^(3))
SET ORSTS=+$PIECE(OR3,U,3)
+10 ;return only latest order per status
IF ORSTS'>0
QUIT
IF $GET(ORY(ORSTS))
QUIT
+11 SET ORSTSNM=$$LOW^XLFSTR($PIECE($GET(^ORD(100.01,ORSTS,0)),U))
+12 SET ORY=ORY+1
SET ORY(ORSTS)=ORIFN_U_$PIECE(OR0,U,4)_U_$PIECE(OR0,U,7,10)_U_ORSTSNM
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
DELAYED(ORY,ORDER) ; -- Return delayed order(s) with same OrdItem as ORDER
+1 ; in ORY(ORIFN) = PatEventPtr ^ EventName
+2 ;
+3 NEW ORI,ORIT,ORIFN
SET (ORY,ORI)=0
+4 FOR
SET ORI=$ORDER(^OR(100,+ORDER,.1,ORI))
IF ORI'>0
QUIT
SET ORIT=+$GET(^(ORI,0))
Begin DoDot:1
+5 ;pending events
SET EVT=0
FOR
SET EVT=$ORDER(^ORE(100.2,"AE",+ORVP,EVT))
IF EVT<1
QUIT
SET PTEVT=+$ORDER(^(EVT,0))
Begin DoDot:2
+6 ;delayed orders
SET ORIFN=0
FOR
SET ORIFN=+$ORDER(^OR(100,"AEVNT",ORVP,PTEVT,ORIFN))
IF ORIFN<1
QUIT
Begin DoDot:3
+7 IF ORIFN=+ORDER
QUIT
IF '$DATA(^OR(100,ORIFN,.1,"B",ORIT))
QUIT
+8 ;terminated
IF "^1^2^7^12^13^14^"[(U_$PIECE($GET(^OR(100,ORIFN,3)),U,3)_U)
QUIT
+9 SET ORY=ORY+1
SET ORY(ORIFN)=PTEVT_U_$PIECE($GET(^ORD(100.5,EVT,0)),U)
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
PKGID(ORIFN) ; -- Return package identifier for order ORIFN [DBIA#3071]
+1 QUIT $GET(^OR(100,+$GET(ORIFN),4))
+2 ;
ES(ORDER) ; -- Returns the signature status of ORDER [DBIA#3632]
+1 ; -1 = invalid order#
+2 ; "" = no signature required
+3 ; 0 = not signed (needs ES)
+4 ; 1 = electronically or digitally signed
+5 ; 2 = signed on chart
+6 ; 3 = corrected or canceled order
+7 NEW X,Y,DA
IF '$GET(ORDER)!'$DATA(^OR(100,+$GET(ORDER),0))
QUIT -1
+8 SET DA=+$PIECE(ORDER,";",2)
IF DA<1
SET DA=+$PIECE($GET(^OR(100,+ORDER,3)),U,7)
+9 SET X=$PIECE($GET(^OR(100,+ORDER,8,DA,0)),U,4)
+10 SET Y=$SELECT(X=2:0,X=1!(X=7):1,X=0!(X=4):2,X=5!(X=6):3,1:"")
+11 QUIT Y
+12 ;
AND(DAD) ; -- Return 1 or 0, if all conjunctions are AND [DBIA#3632]
+1 NEW I,Y
SET I=0
SET Y=1
+2 FOR
SET I=+$ORDER(^OR(100,+$GET(DAD),4.5,"ID","CONJ",I))
IF I<1
QUIT
IF $EXTRACT($GET(^OR(100,+$GET(DAD),4.5,I,1)))'="A"
SET Y=0
QUIT
+3 QUIT Y
