source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORSETUP.m@ 1042

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1ORSETUP ; SLC/MKB - OE3 Setup post-init ;7/26/97 15:51
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3PARAM ; -- Populate Parameters file
4 D BMES^XPDUTL("Populating Parameters file ...")
5 D ^ORXPAR,^ORPFCNVT
6 Q
7 ;
8DGROUPS ; -- Update Display Group file
9 D BMES^XPDUTL("Setting up Display Group file ...")
10 D POST^ORSET98
11 Q
12 ;
13ORDITMS ; -- Populate Orderable Items file
14 N ORP S ORP=+$$PARCP^XPDUTL(ORCP) Q:ORP<0 ; already completed
15 D BMES^XPDUTL("Populating Orderable Items file ...") G @ORP
160 D OI^ORSETUP1 I '$D(^ORD(101.43,"S.NURS")) S XPDQUIT=1 Q
17 S ORP=$$UPCP^XPDUTL(ORCP,1) W:IOST?1"C-".E "."
181 D EN^GMRCPOS1 I '$D(^ORD(101.43,"S.CSLT")) S XPDQUIT=1 Q
19 S ORP=$$UPCP^XPDUTL(ORCP,2) W:IOST?1"C-".E "."
202 D ^FHWORI I '$D(^ORD(101.43,"S.DIET")) S XPDQUIT=1 Q
21 S ORP=$$UPCP^XPDUTL(ORCP,3) W:IOST?1"C-".E "."
223 D ALL^LR7OV2 I '$D(^ORD(101.43,"S.LAB")) S XPDQUIT=1 Q
23 S ORP=$$UPCP^XPDUTL(ORCP,4) W:IOST?1"C-".E "."
244 D EN1^PSSHL1 I '$D(^ORD(101.43,"S.RX")) S XPDQUIT=1 Q
25 S ORP=$$UPCP^XPDUTL(ORCP,5) W:IOST?1"C-".E "."
265 D ENALL^RAO7MFN I '$D(^ORD(101.43,"S.XRAY")) S XPDQUIT=1 Q
27 S ORP=$$UPCP^XPDUTL(ORCP,-1) W:IOST?1"C-".E "."
28 Q
29 ;
30DIALOGS ; -- Convert protocol menus, quick orders into Dialogs
31 D BMES^XPDUTL("Converting protocol menus ...")
32 D FRMT,^ORCONVRT
33 Q
34 ;
35FRMT ; -- resolve format code ptrs for LR,PS dlgs
36 N ORI,X,DLG,DA
37 F ORI=1:1 S X=$T(DLG+ORI),X=$P(X,";",3) Q:X="ZZZZ" D
38 . S DLG=+$O(^ORD(101.41,"AB",$P(X,U),0)) Q:'DLG
39 . S DA=+$O(^ORD(101.41,DLG,10,"B",$P(X,U,2),0)) Q:'DA
40 . S $P(^ORD(101.41,DLG,10,DA,2),U,2)=$P(X,U,3)_+$O(^ORD(101.41,"AB",$P(X,U,4),0))
41 Q
42 ;
43DLG ;; dialog^item position^item to use instead
44 ;;LR OTHER LAB TESTS^4^=^OR GTX COLLECTION SAMPLE
45 ;;PSO OERR^1^@^OR GTX INSTRUCTIONS
46 ;;ZZZZ
47 ;
48URG ; -- set GMRCURGENCY protocols into 101.42
49 N LAST,NAME,X,Y,DIC,DINUM,DLAYGO,I,CODE
50 D BMES^XPDUTL("Adding Consult/Request urgencies to Order Urgency file ...")
51 S DIC="^ORD(101.42,",DIC(0)="LX",DLAYGO=101.42
52 S LAST=$O(^ORD(101.42,99),-1),NAME="GMRCURGENCY - "
53 F S NAME=$O(^ORD(101,"B",NAME)) Q:NAME'?1"GMRCURGENCY - ".E S X=$P(NAME," - ",2) I '$D(^ORD(101.42,"B",X)) D
54 . S DINUM=LAST+1 D FILE^DICN S:+Y>0 LAST=+Y S CODE=""
55 . I Y'>0 D MES^XPDUTL(">>> Unable to add "_X_" urgency") Q
56 . F I=1:1:4 I '$D(^ORD(101.42,"C","Z"_$E(X,1,I))) S CODE="Z"_$E(X,1,I) Q
57 . S:$L(CODE) $P(^ORD(101.42,+Y,0),U,2)=CODE,^ORD(101.42,"C",CODE,+Y)=""
58 Q
Note: See TracBrowser for help on using the repository browser.