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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY39 1692 printed Dec 13, 2024@02:41:41 Page 2
ORY39 ;SLC/JFR - POST-INSTALL OR*3*39 11/24/98 13:15
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**39**;Dec 17, 1997
POST ; task AWID linetag in post-install
+1 SET ZTDTH=$HOROLOG
SET ZTRTN="AWID^ORY39"
SET ZTDESC="Post-install for OR*3*39"
+2 SET ZTIO=""
DO ^%ZTLOAD
+3 DO BMES^XPDUTL($SELECT($GET(ZTSK):"Post-install tasked, Task # "_ZTSK,1:"Unable to queue post-install"))
+4 KILL ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
+5 QUIT
AWID ; loop whole order file
+1 ; set "AW" x-ref on NKA allergy orders
+2 ; add ID's to existing orders
+3 ;Q:$$PATCH^XPDUTL("OR*3.0*39")
+4 NEW NKADLG,ORIFN,ORDLG,ORFTXT,ORFTOI
+5 SET ORDLG=$$PTR^ORCD("GMRAOR ALLERGY ENTER/EDIT")_";ORD(101.41,"
if 'ORDLG
QUIT
+6 SET NKADLG=$$PTR^ORCD("OR GTX NKA")
+7 SET ORFTXT=$$PTR^ORCD("OR GTX FREE TEXT 1")
+8 SET ORFTOI=$$PTR^ORCD("OR GTX FREE TEXT OI")
+9 SET ORIFN=0
FOR
SET ORIFN=$ORDER(^OR(100,ORIFN))
if 'ORIFN
QUIT
Begin DoDot:1
+10 if $PIECE($GET(^OR(100,ORIFN,0)),"^",5)'=ORDLG
QUIT
IF $$NKA(ORIFN)
Begin DoDot:2
+11 NEW DA
+12 ; set logic for "AW" x-ref
SET DA=ORIFN
DO WS^ORDD100
End DoDot:2
QUIT
+13 DO COMMENT(ORIFN)
+14 QUIT
End DoDot:1
+15 QUIT
NKA(ORDER) ; see if order is an NKA
+1 NEW RESP,NKA
+2 SET NKA=0
+3 SET RESP=0
FOR
SET RESP=$ORDER(^OR(100,ORDER,4.5,RESP))
if 'RESP!NKA
QUIT
Begin DoDot:1
+4 IF $PIECE(^OR(100,ORDER,4.5,RESP,0),"^",2)=NKADLG
Begin DoDot:2
+5 ; set "ID" x-ref for NKA on field 4.5 and NKA flag
+6 SET NKA=1
+7 SET $PIECE(^OR(100,ORDER,4.5,RESP,0),"^",4)="NKA"
+8 SET ^OR(100,ORDER,4.5,"ID","NKA",RESP)=""
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT NKA
+1 NEW RESP,ORX
SET RESP=0
+2 FOR
SET RESP=$ORDER(^OR(100,ORDER,4.5,"ID","COMMENT",RESP))
if RESP'>0
QUIT
IF $PIECE($GET(^OR(100,ORDER,4.5,RESP,0)),U,2)=ORFTXT
SET ORX=^(0)
Begin DoDot:1
+3 KILL ^OR(100,ORDER,4.5,"ID","COMMENT",RESP)
+4 SET $PIECE(ORX,U,2)=ORFTOI
SET $PIECE(ORX,U,4)="ITEM"
SET ^OR(100,ORDER,4.5,RESP,0)=ORX
+5 SET ^OR(100,ORDER,4.5,"ID","ITEM",RESP)=""
End DoDot:1
+6 QUIT
