| [613] | 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
|
|---|
