source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORDD100.m@ 1753

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1ORDD100 ; slc/dcm - DD entries for file 100 ;06/18/2004 10:00
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,157,255**;Dec 17, 1997
3SETALL(ORIFN) ; -- set "AC" xref for all actions
4 N ORYD,ORVP,ORSTOP,OR3,ORSTS,ORLOG,ORACT,ORACT0,ORCACT D ORYD
5 S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),ORSTOP=$P($G(^(0)),U,9) Q:'ORVP
6 S OR3=$G(^OR(100,ORIFN,3)),ORSTS=$P(OR3,U,3),ORCACT=$P(OR3,U,7)
7 S ORACT=0 F S ORACT=$O(^OR(100,ORIFN,8,ORACT)) Q:ORACT'>0 D SET1
8 Q
9SET(ORIFN,ORACT) ; -- set "AC" xref by action
10 N ORYD,ORVP,ORSTOP,OR3,ORSTS,ORLOG,ORACT0,ORCACT D ORYD
11 S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),ORSTOP=$P($G(^(0)),U,9) Q:'ORVP
12 S OR3=$G(^OR(100,ORIFN,3)),ORSTS=$P(OR3,U,3),ORCACT=$P(OR3,U,7)
13SET1 S ORACT0=$G(^OR(100,ORIFN,8,ORACT,0)),ORLOG=$P(ORACT0,U)
14 K ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT) ; reset
15 I ORACT'=ORCACT D Q ; not Current action
16 . I $P(ORACT0,U,15)=11 S ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)="" Q
17 . I ORYD,$P(ORACT0,U,15)=13,ORLOG'<ORYD S ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)=""
18 . I $P(ORACT0,U,15)="",ORACT=1,$P($G(^OR(100,ORIFN,8,ORCACT,0)),U,2)="RL",$S('ORYD:1,$P($G(^(0)),U,16)<ORYD:1,1:0) S $P(^OR(100,ORIFN,3),U,7)=1,^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,1)="" ;Replace RL w/NW
19 I ORSTS,ORSTS'=1,ORSTS'=2,ORSTS'=7,ORSTS'=10,ORSTS'=12,ORSTS'=13,ORSTS'=14,ORSTS'=99 S ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)=""
20 I ORYD,(ORSTS=1!(ORSTS=2)!(ORSTS=7)!(ORSTS=13)),ORSTOP'<ORYD S ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)=""
21 Q
22KILALL(ORIFN) ; -- kill "AC" xref for all actions
23 N ORVP,ORACT,ORLOG
24 S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),ORACT=0 Q:'ORVP
25 F S ORACT=$O(^OR(100,ORIFN,8,ORACT)) Q:ORACT'>0 S ORLOG=$P(^(ORACT,0),U) K:ORLOG ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)
26 Q
27KIL(ORIFN,ORACT) ; -- kill "AC" xref
28 N ORVP,ORLOG
29 S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),ORLOG=$P($G(^(8,ORACT,0)),U) Q:'ORVP
30 K:ORLOG ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)
31 Q
32 ;
33ORYD ; -- Return Current Orders context hours in ORYD
34 N X,X1,X2,X3,%,%H
35 S ORYD=$$GET^XPAR("SYS","ORPF ACTIVE ORDERS CONTEXT HRS",1,"I")
36YD1 I ORYD S X=$H,X=+X*24+($P(X,",",2)/3600),X2=ORYD,X1=X-X2,X3=X1#24,X1=X1\24,X2=$J(X3*3600,0,0),%H=X1_","_X2 D YMD^%DTC S ORYD=+(X_%)
37 Q
38 ;
39SS ; -- set "AD" xref
40 N ORSTRT S ORSTRT=$P($G(^OR(100,DA,0)),U,8)
41 I ORSTRT,ORSTRT>$$NOW^XLFDT S ^OR(100,"AD",ORSTRT,DA)=""
42 Q
43SK ; -- kill "AD" xref
44 N ORSTRT S ORSTRT=$P($G(^OR(100,DA,0)),U,8)
45 I ORSTRT K ^OR(100,"AD",ORSTRT,DA)
46 Q
47 ;
48WS ; -- set "AW" xref
49 N ORVP,ORDG,ORSTRT,X,X0
50 S X0=$G(^OR(100,DA,0)),ORVP=$P(X0,U,2),ORDG=$P(X0,U,11)
51 S ORSTRT=$P(X0,U,8),X=$S(ORSTRT:ORSTRT,1:9999999)
52 I ORVP,ORDG S ^OR(100,"AW",ORVP,ORDG,X,DA)=""
53 Q
54WK ; -- kill "AW" xref
55 N ORVP,ORDG,ORSTRT,X,X0
56 S X0=$G(^OR(100,DA,0)),ORVP=$P(X0,U,2),ORDG=$P(X0,U,11)
57 S ORSTRT=$P(X0,U,8),X=$S(ORSTRT:ORSTRT,1:9999999)
58 I ORVP,ORDG K ^OR(100,"AW",ORVP,ORDG,X,DA)
59 Q
60 ;
61S1(ORIFN,ORACT,ORVP,ORLOG) ; -- set "AS" xref
62 N OR0 S OR0=$G(^OR(100,ORIFN,8,ORACT,0)) Q:$P(OR0,U,4)'=2 ;unsigned
63 S:'$G(ORLOG) ORLOG=$P(OR0,U) S:'$G(ORVP) ORVP=$P(^OR(100,ORIFN,0),U,2)
64 I ORVP,ORLOG S ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,ORACT)=""
65 Q
66S2(ORIFN,ORACT,ORVP,ORLOG) ; -- kill "AS" xref
67 N OR0 S:'$G(ORVP) ORVP=$P(^OR(100,ORIFN,0),U,2)
68 S:'$G(ORLOG) ORLOG=$P($G(^OR(100,ORIFN,8,ORACT,0)),U)
69 I ORLOG,ORVP K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,ORACT)
70 Q
71 ;
72RS(ORIFN,ORACT,ORVP,ORRDT) ; -- set "AR" xref
73 N OR80
74 Q:'$G(ORIFN) Q:'$G(ORACT)
75 S:'$G(ORVP) ORVP=$P($G(^OR(100,ORIFN,0)),U,2)
76 S OR80=$G(^OR(100,ORIFN,8,ORACT,0))
77 S:'$G(ORRDT) ORRDT=$P(OR80,U,16)
78 I ORVP,ORRDT S ^OR(100,"AR",ORVP,(9999999-ORRDT),ORIFN,ORACT)=""
79 I ORVP'["DPT"!ORRDT="" Q
80 I $P(OR80,U,2)="NW" D PXRMADD(ORIFN,ORVP,ORRDT)
81 Q
82 ;
83PXRMADD(ORIFN,ORVP,ORRDT) ; -- set "PXRM" xref
84 N DAES,OI,OR0,START,X
85 S DAES(1)=ORIFN
86 S X(1)=ORVP
87 S OR0=^OR(100,ORIFN,0)
88 S START=$P(OR0,U,8)
89 S X(3)=$S(START="":ORRDT,1:START)
90 S X(4)=$P(OR0,U,9)
91 S OI=0 F S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0 D
92 . S X(2)=+$G(^(OI,0)),DAES=OI
93 . D SOR^ORPXRM(.X,.DAES)
94 Q
95 ;
96RK(ORIFN,ORACT,ORVP,ORRDT) ; -- kill "AR" xref
97 N OR80
98 Q:'$G(ORIFN) Q:'$G(ORACT)
99 S:'$G(ORVP) ORVP=$P($G(^OR(100,ORIFN,0)),U,2)
100 S OR80=$G(^OR(100,ORIFN,8,ORACT,0))
101 S:'$G(ORRDT) ORRDT=$P(OR80,U,16)
102 I ORVP,ORRDT K ^OR(100,"AR",ORVP,(9999999-ORRDT),ORIFN,ORACT)
103 I ORVP'["DPT"!ORRDT="" Q
104 I $P(OR80,U,2)="NW" D PXRMKILL(ORIFN,ORVP,ORRDT)
105 Q
106 ;
107PXRMKILL(ORIFN,ORVP,ORRDT) ; -- kill "PXRM" xref
108 N DAES,OI,OR0,START,X
109 S DAES(1)=ORIFN
110 S X(1)=ORVP
111 S OR0=^OR(100,ORIFN,0)
112 S START=$P(OR0,U,8)
113 S X(3)=$S(START="":ORRDT,1:START)
114 S X(4)=$P(OR0,U,9)
115 S OI=0 F S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0 D
116 . S X(2)=+$G(^(OI,0)),DAES=OI
117 . D KOR^ORPXRM(.X,.DAES)
118 Q
119 ;
120VS ; -- set "AEVNT" xref
121 N ORVP,OREVNT
122 S ORVP=$P($G(^OR(100,DA,0)),U,2),OREVNT=$P($G(^(0)),U,17)
123 I ORVP,$L(OREVNT) S ^OR(100,"AEVNT",ORVP,OREVNT,DA)=""
124 Q
125 ;
126VK ; -- kill "AEVNT" xref
127 N ORVP,OREVNT
128 S ORVP=$P($G(^OR(100,DA,0)),U,2),OREVNT=$P($G(^(0)),U,17)
129 I ORVP,$L(OREVNT) K ^OR(100,"AEVNT",ORVP,OREVNT,DA)
130 Q
131 ;
132UP(X) ; -- Convert X to upper case
133 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Note: See TracBrowser for help on using the repository browser.