source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORDD100A.m@ 1685

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1ORDD100A ;slc/dcm-DD entries for file 100 ;06/18/2004
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**24,138,157**;Dec 17, 1997
3ACT1(ORIFN,ORDA,ORADT,ORVP,ORDG) ; -- set "ACT" x-ref
4 Q:'$G(ORIFN) Q:'$G(ORDA) N OR0
5 S OR0=$G(^OR(100,ORIFN,0)) S:'$G(ORADT) ORADT=$P($G(^(8,ORDA,0)),U)
6 S:'$G(ORVP) ORVP=$P(OR0,U,2) S:'$G(ORDG) ORDG=$P(OR0,U,11)
7 I ORVP,ORADT,ORDG S ^OR(100,"ACT",ORVP,9999999-ORADT,ORDG,ORIFN,ORDA)=""
8 Q
9 ;
10ACT2(ORIFN,ORDA,ORADT,ORVP,ORDG) ; -- kill "ACT" x-ref
11 Q:'$G(ORIFN) Q:'$G(ORDA) N OR0
12 S OR0=$G(^OR(100,ORIFN,0)) S:'$G(ORADT) ORADT=$P($G(^(8,ORDA,0)),U)
13 S:'$G(ORVP) ORVP=$P(OR0,U,2) S:'$G(ORDG) ORDG=$P(OR0,U,11)
14 I ORVP,ORADT,ORDG K ^OR(100,"ACT",ORVP,9999999-ORADT,ORDG,ORIFN,ORDA)
15 Q
16 ;
17ES ; -- set "AE" x-ref
18 N DAES,OI,ORO,ORSTOP,X,X1
19 S ORO=$G(^OR(100,DA,0))
20 S ORSTOP=+$P(ORO,U,9) ;138
21 I ORSTOP,ORSTOP'<DT S ^OR(100,"AE",ORSTOP,DA)="" ;138
22 ;If there is no start date try to get the release date.
23 S X(3)=$P(ORO,U,8)
24 I X(3)="" S X(3)=$$RDATE^ORPXRM(DA)
25 I X(3)="" Q
26 S DAES(1)=DA,X(1)=$P(ORO,U,2),X(4)=ORSTOP
27 S X1(1)=X(1),X1(3)=X(3),X1(4)=""
28 S OI=0 F S OI=$O(^OR(100,DA,.1,OI)) Q:OI'>0 D
29 . S (X(2),X1(2))=+$G(^(OI,0)),DAES=OI
30 .;If there is an entry without a stop date kill it before creating
31 .;the new one.
32 . D KOR^ORPXRM(.X1,.DAES)
33 . D SOR^ORPXRM(.X,.DAES)
34 Q
35EK ; -- kill "AE" x-ref
36 N DAEK,OI,ORSTOP,X
37 S ORO=$G(^OR(100,DA,0))
38 S ORSTOP=$P(ORO,U,9)
39 I ORSTOP K ^OR(100,"AE",ORSTOP,DA)
40 ;If there is no start date try to get the release date.
41 S X(3)=$P(ORO,U,8)
42 I X(3)="" S X(3)=$$RDATE^ORPXRM(DA)
43 I X(3)="" Q
44 S DAEK(1)=DA,X(1)=$P(ORO,U,2),X(4)=ORSTOP
45 S OI=0 F S OI=$O(^OR(100,DA,.1,OI)) Q:OI'>0 D
46 . S X(2)=+$G(^(OI,0)),DAEK=OI
47 . D KOR^ORPXRM(.X,.DAEK)
48 Q
49 ;
50OI1(ORIFN) ; -- set "AOI" x-ref
51 N DA,OI,OR0,ORVP,ORSTRT,ORSTOP,ORIT,X,X1
52 Q:'$D(^OR(100,ORIFN,.1)) S OR0=$G(^(0))
53 S ORVP=$P(OR0,U,2) Q:'ORVP
54 S ORSTRT=$P(OR0,U,8) Q:'ORSTRT
55 S ORSTOP=$P(OR0,U,9)
56 S DA(1)=ORIFN
57 S (X(1),X1(1))=ORVP
58 S X(3)=ORSTRT,X1(3)=$$RDATE^ORPXRM(ORIFN)
59 S (X(4),X1(4))=ORSTOP
60 S OI=0 F S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0 D
61 . S ORIT=+$G(^(OI,0)) S:ORIT ^OR(100,"AOI",ORIT,ORVP,9999999-ORSTRT,ORIFN)=""
62 . S (X(2),X1(2))=ORIT,DA=OI
63 . D KOR^ORPXRM(.X1,.DA)
64 . D SOR^ORPXRM(.X,.DA)
65 Q
66 ;
67OI2(ORIFN) ; -- kill "AOI" x-ref
68 N DA,OI,OR0,ORVP,ORSTRT,ORSTOP,ORIT,X
69 Q:'$D(^OR(100,ORIFN,.1)) S OR0=$G(^(0))
70 S ORVP=$P(OR0,U,2) Q:'ORVP
71 S ORSTRT=$P(OR0,U,8) Q:'ORSTRT
72 S ORSTOP=$P(OR0,U,9)
73 S DA(1)=ORIFN,X(1)=ORVP,X(3)=ORSTRT,X(4)=ORSTOP
74 S OI=0 F S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0 D
75 . S ORIT=+$G(^(OI,0)) K:ORIT ^OR(100,"AOI",ORIT,ORVP,9999999-ORSTRT,ORIFN)
76 . S X(2)=ORIT,DA=OI
77 . D KOR^ORPXRM(.X,.DA)
78 Q
Note: See TracBrowser for help on using the repository browser.