VistA-WorldVistAEHR/r/ORDER_ENTRY_RESULTS_REPORTI.../ORY39.m

43 lines
1.6 KiB
Mathematica

ORY39 ;SLC/JFR - POST-INSTALL OR*3*39 11/24/98 13:15
;;3.0;ORDER ENTRY/RESULTS REPORTING;**39**;Dec 17, 1997
POST ; task AWID linetag in post-install
S ZTDTH=$H,ZTRTN="AWID^ORY39",ZTDESC="Post-install for OR*3*39"
S ZTIO="" D ^%ZTLOAD
D BMES^XPDUTL($S($G(ZTSK):"Post-install tasked, Task # "_ZTSK,1:"Unable to queue post-install"))
K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
Q
AWID ; loop whole order file
; set "AW" x-ref on NKA allergy orders
; add ID's to existing orders
;Q:$$PATCH^XPDUTL("OR*3.0*39")
N NKADLG,ORIFN,ORDLG,ORFTXT,ORFTOI
S ORDLG=$$PTR^ORCD("GMRAOR ALLERGY ENTER/EDIT")_";ORD(101.41," Q:'ORDLG
S NKADLG=$$PTR^ORCD("OR GTX NKA")
S ORFTXT=$$PTR^ORCD("OR GTX FREE TEXT 1")
S ORFTOI=$$PTR^ORCD("OR GTX FREE TEXT OI")
S ORIFN=0 F S ORIFN=$O(^OR(100,ORIFN)) Q:'ORIFN D
. Q:$P($G(^OR(100,ORIFN,0)),"^",5)'=ORDLG I $$NKA(ORIFN) D Q
.. N DA
.. S DA=ORIFN D WS^ORDD100 ; set logic for "AW" x-ref
. D COMMENT(ORIFN)
. Q
Q
NKA(ORDER) ; see if order is an NKA
N RESP,NKA
S NKA=0
S RESP=0 F S RESP=$O(^OR(100,ORDER,4.5,RESP)) Q:'RESP!NKA D
. I $P(^OR(100,ORDER,4.5,RESP,0),"^",2)=NKADLG D
.. ; set "ID" x-ref for NKA on field 4.5 and NKA flag
.. S NKA=1
.. S $P(^OR(100,ORDER,4.5,RESP,0),"^",4)="NKA"
.. S ^OR(100,ORDER,4.5,"ID","NKA",RESP)=""
. Q
Q NKA
COMMENT(ORDER) ; replace COMMENT prompt with ITEM
N RESP,ORX S RESP=0
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
. K ^OR(100,ORDER,4.5,"ID","COMMENT",RESP)
. S $P(ORX,U,2)=ORFTOI,$P(ORX,U,4)="ITEM",^OR(100,ORDER,4.5,RESP,0)=ORX
. S ^OR(100,ORDER,4.5,"ID","ITEM",RESP)=""
Q