43 lines
2.2 KiB
Mathematica
43 lines
2.2 KiB
Mathematica
ORMPS3 ;SLC/MKB - Process Pharmacy ORM msgs cont ;12/3/03 10:32
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**213**;Dec 17, 1997
|
|
;
|
|
PTR(X) ; -- Return ptr to prompt OR GTX X
|
|
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
|
|
;
|
|
PARENT ; -- create parent order for backdoor complex renewals
|
|
; Expects ORIFN, ORIG, ORDIALOG()
|
|
;Q:'$$PATCH^XPDUTL("PSJ*5.0*110")
|
|
N ORIGDAD,ORIFNDAD,HDR S ORIGDAD=$P($G(^OR(100,ORIG,3)),U,9)
|
|
Q:ORIGDAD<1 Q:$$DOSES^ORCACT4(ORIGDAD)'>1 ;cont if complex
|
|
S ORIFNDAD=$P($G(^OR(100,ORIGDAD,3)),U,6) I ORIFNDAD<1 D G P1
|
|
. N ORIFN D EN^ORCSAVE Q:ORIFN<1
|
|
. S $P(^OR(100,ORIFN,3),U,5)=ORIGDAD,$P(^(3),U,8)=1,$P(^(3),U,11)=2
|
|
. S $P(^OR(100,ORIGDAD,3),U,6)=ORIFN,ORIFNDAD=ORIFN
|
|
. D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR)
|
|
. D SIGSTS^ORCSAVE2(ORIFN,1),DATES^ORCSAVE2(ORIFN,ORSTRT)
|
|
. I $P(^OR(100,ORIFN,8,1,0),U,4)=2 S $P(^(0),U,4)="" K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;sign children instead
|
|
. ;STATUS updated in SN2^ORMPS from child orders
|
|
P0 ; -- just add conjunction, new dose if DAD already exists
|
|
N INST,DA,PTR,ID,P,I,J,X
|
|
S INST=$$DOSES^ORCACT4(ORIFNDAD),DA=$O(^OR(100,ORIFNDAD,4.5,"A"),-1)
|
|
S PTR=$$PTR("AND/THEN"),ID="CONJ",DA=DA+1
|
|
S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)="A"
|
|
S ^OR(100,ORIFNDAD,4.5,"ID","CONJ",DA)="",INST=INST+1
|
|
F P="INSTRUCTIONS","ROUTE","SCHEDULE","DURATION","DOSE","DISPENSE DRUG" D
|
|
. S PTR=$$PTR(P) Q:'$L($G(ORDIALOG(PTR,1)))
|
|
. S DA=DA+1,ID=$P($G(^ORD(101.41,PTR,1)),U,3)
|
|
. S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)=ORDIALOG(PTR,1)
|
|
. S ^OR(100,ORIFNDAD,4.5,"ID",ID,DA)=""
|
|
S $P(^OR(100,ORIFNDAD,4.5,0),U,3,4)=DA_U_DA
|
|
S P=$$PTR("SIG"),DA=+$O(^OR(100,ORIFNDAD,4.5,"ID","SIG",0))
|
|
S I=+$O(^OR(100,ORIFNDAD,4.5,DA,2,""),-1),X=$G(^(I,0)) S:$L(X) X=X_" AND",^(0)=X
|
|
S J=0 F S J=$O(^TMP("ORWORD",$J,PTR,1,J)) Q:J<1 S I=I+1,^OR(100,ORIFNDAD,4.5,DA,2,I,0)=^TMP("ORWORD",$J,PTR,1,J,0)
|
|
S $P(^OR(100,ORIFNDAD,4.5,DA,2,0),U,3,4)=I_U_I
|
|
; -- rebuild order text w/new SIG
|
|
K ^TMP("ORWORD",$J,PTR) M ^TMP("ORWORD",$J,PTR,1)=^OR(100,ORIFNDAD,4.5,DA,2)
|
|
K ^OR(100,ORIFNDAD,8,1,.1) D ORDTEXT^ORCSAVE1(ORIFNDAD_";1")
|
|
P1 ; -- set up links
|
|
S $P(^OR(100,ORIFN,3),U,9)=ORIFNDAD
|
|
S HDR=$G(^OR(100,ORIFNDAD,2,0)),^(0)="^100.002PA^"_ORIFN_U_($P(HDR,U,4)+1),^(ORIFN,0)=ORIFN
|
|
Q
|