source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY142.m@ 846

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1ORY142 ; SLC/MKB - inits for ED pre-patch OR*3*142 ;7/3/02 13:57
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**142**;Dec 17, 1997
3 ;DBIA reference section
4 ;2263 - XPAR
5 ;2058 - ^DIC(9.4,"C"
6 ;10013- DIK
7 ;10014- DIU2
8 ;10112- VASITE
9 ;10103- XLFDT
10 ;
11PRE ; -- preinit
12 I '$O(^ORD(101.41,"AB","OR GTX EVENT",0)) D ;1st install
13 . N DIU ;remove old 100.5, 100.6 DD's
14 . F DIU="^ORYX(""ORTO"",","^ORYX(""ORPAR""," S DIU(0)="DST" D EN^DIU2
15 Q
16 ;
17DLGSEND(X) ; -- Return true if the order dialog should be sent
18 I X="OR GTX EVENT" Q 1
19 I X="OR GXMOVE EVENT" Q 1
20 Q 0
21 ;
22DCSEND(X) ; -- Return true if order reason should be sent
23 I X="ORDEATH" Q 1
24 I X="OROR" Q 1
25 I X="ORPASS" Q 1
26 I X="ORASIH" Q 1
27 Q 0
28 ;
29PRMSEND(X) ; -- Return true if parameter definition should be sent
30 I X="ORWDX WRITE ORDERS EVENT LIST" Q 1
31 I X="OREVNT DEFAULT" Q 1
32 Q 0
33 ;
34POST ; -- postinit to convert old DC parameters to file #100.6
35 ; Creates a set of rules for [primary] division
36 ;
37 Q:$O(^ORD(100.6,0)) ;not 1st install
38 N ORI,ORADMIT,ORDIS,ORTRANS,ORSPEC,ORDEATH,OROR,ORPASS,ORASIH,ORPARM,ORNOW,ORDIV,ORPKG,DIK,ORGLOB,I
39 F ORI="ORADMIT","ORDIS","ORTRANS","ORSPEC","ORDEATH","OROR","ORPASS","ORASIH" S @ORI=+$O(^ORD(100.03,"C",ORI,0))
40 D GETLST^XPAR(.ORPARM,"ALL","OR DC ON SPEC CHANGE")
41 S ORPARM("T")=$$GET^XPAR("ALL","ORPF DC OF GENERIC ORDERS")
42 S ORPARM("A")=$$GET^XPAR("ALL","OR DC GEN ORD ON ADMISSION")
43 S ORI=0,ORNOW=+$$NOW^XLFDT,ORDIV=+$$SITE^VASITE Q:ORDIV<1
44P1 ; -- ADMISSION rule
45 S ORI=ORI+1,^ORD(100.6,ORI,0)="ADMISSION^A^"_ORDIV_U_ORADMIT_"^ADMISSION"
46 D MVTYPES(ORI,"8^9^15^18^28^29^30^36^39")
47 S ORPKG=1,ORPKG(1)=+$O(^DIC(9.4,"C","OR",0))_"^1" D PKGS(ORI,.ORPKG)
48 I ORPARM("A")<1 S ^ORD(100.6,ORI,1)=ORNOW ;inactive
49 E S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW
50P2 ; -- SPECIALTY CHANGE rule
51 S ORI=ORI+1,^ORD(100.6,ORI,0)="SPECIALTY CHANGE^S^"_ORDIV_U_ORSPEC_"^SPECIALTY CHANGE"
52 D MVTYPES(ORI,"20"),PKGS(ORI,.ORPARM)
53 I ORPARM<1 S ^ORD(100.6,ORI,1)=ORNOW ;inactive
54 E S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW
55P3 ; -- WARD TRANSFER rule
56 S ORI=ORI+1,^ORD(100.6,ORI,0)="WARD TRANSFER^T^"_ORDIV_U_ORTRANS_"^WARD TRANSFER"
57 D MVTYPES(ORI,"4")
58 S ORPKG=1,ORPKG(1)=+$O(^DIC(9.4,"C","OR",0))_"^1" D PKGS(ORI,.ORPKG)
59 I ORPARM("T")<1 S ^ORD(100.6,ORI,1)=ORNOW ;inactive
60 E S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW
61P4 ; -- DISCHARGE rule
62 S ORI=ORI+1,^ORD(100.6,ORI,0)="DISCHARGE^D^"_ORDIV_U_ORDIS_"^DISCHARGE"
63 D MVTYPES(ORI,"10^11^16^17^21^27^31^32^33^34^35^37^42^46^47")
64 F I="1^OR","2^FH" S ORPKG(+I)=+$O(^DIC(9.4,"C",$P(I,U,2),0))_"^1"
65 S ORPKG=2 D PKGS(ORI,.ORPKG)
66 S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW ;active
67P5 ; -- DEATH rule
68 S ORI=ORI+1,^ORD(100.6,ORI,0)="DEATH^D^"_ORDIV_U_ORDEATH_"^DEATH"
69 S ORPKG=4 F I="1^OR","2^FH","3^GMRC","4^RA" S ORPKG(+I)=+$O(^DIC(9.4,"C",$P(I,U,2),0))_"^1"
70 D PKGS(ORI,.ORPKG),MVTYPES(ORI,"12^38")
71 S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW ;active
72 ; ** Create the following but leave inactive for now:
73P6 ; -- OR rule
74 S ORI=ORI+1,^ORD(100.6,ORI,0)="SURGERY^O^"_ORDIV_U_OROR_"^SURGERY"
75 S ORPKG=1,ORPKG(1)=+$O(^DIC(9.4,"C","OR",0))_"^1" D PKGS(ORI,.ORPKG)
76 S ^ORD(100.6,ORI,1)=ORNOW
77P7 ; -- ON PASS rule
78 S ORI=ORI+1,^ORD(100.6,ORI,0)="ON PASS^T^"_ORDIV_U_ORPASS_"^ON PASS"
79 D MVTYPES(ORI,"1^2^3") S ^ORD(100.6,ORI,1)=ORNOW
80P8 ; -- FROM PASS rule
81 S ORI=ORI+1,^ORD(100.6,ORI,0)="FROM PASS^T^"_ORDIV_U_ORPASS_"^FROM PASS"
82 D MVTYPES(ORI,"22^23^24^25^26") S ^ORD(100.6,ORI,1)=ORNOW
83P9 ; -- TO ASIH rule
84 S ORI=ORI+1,^ORD(100.6,ORI,0)="TO ASIH^T^"_ORDIV_U_ORASIH_"^TO ASIH"
85 D MVTYPES(ORI,"13") S ^ORD(100.6,ORI,1)=ORNOW
86P10 ; -- FROM ASIH rule
87 S ORI=ORI+1,^ORD(100.6,ORI,0)="FROM ASIH^T^"_ORDIV_U_ORASIH_"^FROM ASIH"
88 D MVTYPES(ORI,"14") S ^ORD(100.6,ORI,1)=ORNOW
89 S $P(^ORD(100.6,0),U,3,4)=ORI_U_ORI
90 S DIK="^ORD(100.6," D IXALL^DIK ;set xrefs
91 ;Set edit history for new rules
92 S ORGLOB="^ORD(100.6,"
93 S ORI=0 F S ORI=$O(^ORD(100.6,ORI)) Q:'+ORI D AUDIT^OREV(ORI,"N")
94 Q
95 ;
96MVTYPES(IEN,TYPES) ; -- save MAS Movement Types
97 N CNT,I S CNT=$L(TYPES,U)
98 S ^ORD(100.6,IEN,3,0)="^100.63P^"_CNT_U_CNT
99 F I=1:1:CNT S ^ORD(100.6,IEN,3,I,0)=+$P(TYPES,U,I)
100 Q
101 ;
102PKGS(IEN,PKGS) ; -- save Included Packages
103 N CNT,I S CNT=+$G(PKGS)
104 S ^ORD(100.6,IEN,7,0)="^100.67P^"_CNT_U_CNT
105 F I=1:1:CNT S ^ORD(100.6,IEN,7,I,0)=+PKGS(I)
106 Q
Note: See TracBrowser for help on using the repository browser.