source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORX8.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1ORX8 ; slc/dcm,MKB - OE/RR Orders file extracts ; 08 May 2002 2:12 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**13,21,48,68,92,141,163**;Dec 17, 1997
3 ;
4EN(ORIFN) ;Returns data from file 100 in the ORUPCHUK array [DBIA#871]
5 Q:'$D(ORIFN) Q:'$D(^OR(100,+ORIFN,0)) K ORUPCHUK
6 D A
7 K ORTX,X0,X3,%X,%Y,J,ORINDX,X
8 Q
9A S X0=^OR(100,ORIFN,0),X3=^(3),ORUPCHUK("ORPK")=$S($D(^(4)):^(4),1:"")
10 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)
11 S X=$P(X0,"^",11),ORUPCHUK("ORTO")=X_"^"_$S($D(^ORD(100.98,+X,0)):$P(^(0),"^"),1:"")
12 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:"")
13 D TEXT^ORQ12(.ORTX,ORIFN,$G(ORLENGTH))
14 I $O(ORTX(0)) S %X="ORTX(",%Y="ORUPCHUK(""ORTX""," D %XY^%RCR
15 Q
16 ;
17VALUE(IFN,ID,INST,FORMAT) ; -- Returns value of prompt by ID
18 I '$G(IFN)!('$D(^OR(100,+$G(IFN),0)))!($G(ID)="") Q ""
19 N I,Y S I=0,Y="" S:'$G(INST) INST=1
20 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
21 I $L(Y),$G(PRMT),$G(FORMAT)="E" D ; get external form of Y
22 . N ORDIALOG S ORDIALOG(PRMT,0)=$G(^ORD(101.41,PRMT,1))
23 . S ORDIALOG(PRMT,1)=Y,Y=$$EXT^ORCD(PRMT,1)
24 Q Y
25 ;
26OI(IFN) ; -- Returns [first] orderable item for order IFN in the format
27 ; ifn ^ name ^ pkg id [DBIA#2467]
28 I '$G(IFN)!('$D(^OR(100,+$G(IFN),0))) Q ""
29 N I,X,Y S I=$O(^OR(100,+IFN,.1,0)),X=$G(^(+I,0)),Y=""
30 I X,$D(^ORD(101.43,+X,0)) S Y=+X_U_$P(^(0),U,1,2)
31 Q Y
32 ;
33LATEST(ORPAT,ORIT,ORY) ; -- Return most recent orders for ORPAT,ORIT as
34 ; ORY = total number of orders found (or 0 if none found)
35 ; ORY(ORSTS) = ORIFN ^ Ord'd By ^ Entered ^ StartDt ^ StopDt ^ Loc ^ Sts
36 ; where ORSTS is the ien in the Order Status file #100.01 [DBIA#2842]
37 ;
38 N ORVP,ORIDT,ORIFN,OR0,OR3,ORSTS,ORSTSNM
39 S ORVP=+ORPAT_";DPT(",ORY=0 Q:'$G(ORPAT) Q:'$G(ORIT) ;invalid input
40 S ORIDT=0 F S ORIDT=$O(^OR(100,"AOI",+ORIT,ORVP,ORIDT)) Q:ORIDT'>0 D
41 . S ORIFN=0 F S ORIFN=$O(^OR(100,"AOI",+ORIT,ORVP,ORIDT,ORIFN)) Q:ORIFN'>0 D
42 .. S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORSTS=+$P(OR3,U,3)
43 .. Q:ORSTS'>0 Q:$G(ORY(ORSTS)) ;return only latest order per status
44 .. S ORSTSNM=$$LOW^XLFSTR($P($G(^ORD(100.01,ORSTS,0)),U))
45 .. S ORY=ORY+1,ORY(ORSTS)=ORIFN_U_$P(OR0,U,4)_U_$P(OR0,U,7,10)_U_ORSTSNM
46 Q
47 ;
48DELAYED(ORY,ORDER) ; -- Return delayed order(s) with same OrdItem as ORDER
49 ; in ORY(ORIFN) = PatEventPtr ^ EventName
50 ;
51 N ORI,ORIT,ORIFN S (ORY,ORI)=0
52 F S ORI=$O(^OR(100,+ORDER,.1,ORI)) Q:ORI'>0 S ORIT=+$G(^(ORI,0)) D
53 . S EVT=0 F S EVT=$O(^ORE(100.2,"AE",+ORVP,EVT)) Q:EVT<1 S PTEVT=+$O(^(EVT,0)) D ;pending events
54 .. S ORIFN=0 F S ORIFN=+$O(^OR(100,"AEVNT",ORVP,PTEVT,ORIFN)) Q:ORIFN<1 D ;delayed orders
55 ... Q:ORIFN=+ORDER Q:'$D(^OR(100,ORIFN,.1,"B",ORIT))
56 ... Q:"^1^2^7^12^13^14^"[(U_$P($G(^OR(100,ORIFN,3)),U,3)_U) ;terminated
57 ... S ORY=ORY+1,ORY(ORIFN)=PTEVT_U_$P($G(^ORD(100.5,EVT,0)),U)
58 Q
59 ;
60PKGID(ORIFN) ; -- Return package identifier for order ORIFN [DBIA#3071]
61 Q $G(^OR(100,+$G(ORIFN),4))
62 ;
63ES(ORDER) ; -- Returns the signature status of ORDER [DBIA#3632]
64 ; -1 = invalid order#
65 ; "" = no signature required
66 ; 0 = not signed (needs ES)
67 ; 1 = electronically or digitally signed
68 ; 2 = signed on chart
69 ; 3 = corrected or canceled order
70 N X,Y,DA I '$G(ORDER)!'$D(^OR(100,+$G(ORDER),0)) Q -1
71 S DA=+$P(ORDER,";",2) S:DA<1 DA=+$P($G(^OR(100,+ORDER,3)),U,7)
72 S X=$P($G(^OR(100,+ORDER,8,DA,0)),U,4)
73 S Y=$S(X=2:0,X=1!(X=7):1,X=0!(X=4):2,X=5!(X=6):3,1:"")
74 Q Y
75 ;
76AND(DAD) ; -- Return 1 or 0, if all conjunctions are AND [DBIA#3632]
77 N I,Y S I=0,Y=1
78 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
79 Q Y
Note: See TracBrowser for help on using the repository browser.