1 | ORSETUP ; SLC/MKB - OE3 Setup post-init ;7/26/97 15:51
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
|
---|
3 | PARAM ; -- Populate Parameters file
|
---|
4 | D BMES^XPDUTL("Populating Parameters file ...")
|
---|
5 | D ^ORXPAR,^ORPFCNVT
|
---|
6 | Q
|
---|
7 | ;
|
---|
8 | DGROUPS ; -- Update Display Group file
|
---|
9 | D BMES^XPDUTL("Setting up Display Group file ...")
|
---|
10 | D POST^ORSET98
|
---|
11 | Q
|
---|
12 | ;
|
---|
13 | ORDITMS ; -- 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
|
---|
16 | 0 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 "."
|
---|
18 | 1 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 "."
|
---|
20 | 2 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 "."
|
---|
22 | 3 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 "."
|
---|
24 | 4 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 "."
|
---|
26 | 5 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 | ;
|
---|
30 | DIALOGS ; -- Convert protocol menus, quick orders into Dialogs
|
---|
31 | D BMES^XPDUTL("Converting protocol menus ...")
|
---|
32 | D FRMT,^ORCONVRT
|
---|
33 | Q
|
---|
34 | ;
|
---|
35 | FRMT ; -- 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 | ;
|
---|
43 | DLG ;; 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 | ;
|
---|
48 | URG ; -- 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
|
---|