1 | ORY39 ;SLC/JFR - POST-INSTALL OR*3*39 11/24/98 13:15
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**39**;Dec 17, 1997
|
---|
3 | POST ; task AWID linetag in post-install
|
---|
4 | S ZTDTH=$H,ZTRTN="AWID^ORY39",ZTDESC="Post-install for OR*3*39"
|
---|
5 | S ZTIO="" D ^%ZTLOAD
|
---|
6 | D BMES^XPDUTL($S($G(ZTSK):"Post-install tasked, Task # "_ZTSK,1:"Unable to queue post-install"))
|
---|
7 | K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
|
---|
8 | Q
|
---|
9 | AWID ; loop whole order file
|
---|
10 | ; set "AW" x-ref on NKA allergy orders
|
---|
11 | ; add ID's to existing orders
|
---|
12 | ;Q:$$PATCH^XPDUTL("OR*3.0*39")
|
---|
13 | N NKADLG,ORIFN,ORDLG,ORFTXT,ORFTOI
|
---|
14 | S ORDLG=$$PTR^ORCD("GMRAOR ALLERGY ENTER/EDIT")_";ORD(101.41," Q:'ORDLG
|
---|
15 | S NKADLG=$$PTR^ORCD("OR GTX NKA")
|
---|
16 | S ORFTXT=$$PTR^ORCD("OR GTX FREE TEXT 1")
|
---|
17 | S ORFTOI=$$PTR^ORCD("OR GTX FREE TEXT OI")
|
---|
18 | S ORIFN=0 F S ORIFN=$O(^OR(100,ORIFN)) Q:'ORIFN D
|
---|
19 | . Q:$P($G(^OR(100,ORIFN,0)),"^",5)'=ORDLG I $$NKA(ORIFN) D Q
|
---|
20 | .. N DA
|
---|
21 | .. S DA=ORIFN D WS^ORDD100 ; set logic for "AW" x-ref
|
---|
22 | . D COMMENT(ORIFN)
|
---|
23 | . Q
|
---|
24 | Q
|
---|
25 | NKA(ORDER) ; see if order is an NKA
|
---|
26 | N RESP,NKA
|
---|
27 | S NKA=0
|
---|
28 | S RESP=0 F S RESP=$O(^OR(100,ORDER,4.5,RESP)) Q:'RESP!NKA D
|
---|
29 | . I $P(^OR(100,ORDER,4.5,RESP,0),"^",2)=NKADLG D
|
---|
30 | .. ; set "ID" x-ref for NKA on field 4.5 and NKA flag
|
---|
31 | .. S NKA=1
|
---|
32 | .. S $P(^OR(100,ORDER,4.5,RESP,0),"^",4)="NKA"
|
---|
33 | .. S ^OR(100,ORDER,4.5,"ID","NKA",RESP)=""
|
---|
34 | . Q
|
---|
35 | Q NKA
|
---|
36 | COMMENT(ORDER) ; replace COMMENT prompt with ITEM
|
---|
37 | N RESP,ORX S RESP=0
|
---|
38 | F S RESP=$O(^OR(100,ORDER,4.5,"ID","COMMENT",RESP)) Q:RESP'>0 I $P($G(^OR(100,ORDER,4.5,RESP,0)),U,2)=ORFTXT S ORX=^(0) D
|
---|
39 | . K ^OR(100,ORDER,4.5,"ID","COMMENT",RESP)
|
---|
40 | . S $P(ORX,U,2)=ORFTOI,$P(ORX,U,4)="ITEM",^OR(100,ORDER,4.5,RESP,0)=ORX
|
---|
41 | . S ^OR(100,ORDER,4.5,"ID","ITEM",RESP)=""
|
---|
42 | Q
|
---|