[623] | 1 | ORMPS3 ;SLC/MKB - Process Pharmacy ORM msgs cont ;12/3/03 10:32
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**213**;Dec 17, 1997
|
---|
| 3 | ;
|
---|
| 4 | PTR(X) ; -- Return ptr to prompt OR GTX X
|
---|
| 5 | Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
|
---|
| 6 | ;
|
---|
| 7 | PARENT ; -- create parent order for backdoor complex renewals
|
---|
| 8 | ; Expects ORIFN, ORIG, ORDIALOG()
|
---|
| 9 | ;Q:'$$PATCH^XPDUTL("PSJ*5.0*110")
|
---|
| 10 | N ORIGDAD,ORIFNDAD,HDR S ORIGDAD=$P($G(^OR(100,ORIG,3)),U,9)
|
---|
| 11 | Q:ORIGDAD<1 Q:$$DOSES^ORCACT4(ORIGDAD)'>1 ;cont if complex
|
---|
| 12 | S ORIFNDAD=$P($G(^OR(100,ORIGDAD,3)),U,6) I ORIFNDAD<1 D G P1
|
---|
| 13 | . N ORIFN D EN^ORCSAVE Q:ORIFN<1
|
---|
| 14 | . S $P(^OR(100,ORIFN,3),U,5)=ORIGDAD,$P(^(3),U,8)=1,$P(^(3),U,11)=2
|
---|
| 15 | . S $P(^OR(100,ORIGDAD,3),U,6)=ORIFN,ORIFNDAD=ORIFN
|
---|
| 16 | . D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR)
|
---|
| 17 | . D SIGSTS^ORCSAVE2(ORIFN,1),DATES^ORCSAVE2(ORIFN,ORSTRT)
|
---|
| 18 | . 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
|
---|
| 19 | . ;STATUS updated in SN2^ORMPS from child orders
|
---|
| 20 | P0 ; -- just add conjunction, new dose if DAD already exists
|
---|
| 21 | N INST,DA,PTR,ID,P,I,J,X
|
---|
| 22 | S INST=$$DOSES^ORCACT4(ORIFNDAD),DA=$O(^OR(100,ORIFNDAD,4.5,"A"),-1)
|
---|
| 23 | S PTR=$$PTR("AND/THEN"),ID="CONJ",DA=DA+1
|
---|
| 24 | S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)="A"
|
---|
| 25 | S ^OR(100,ORIFNDAD,4.5,"ID","CONJ",DA)="",INST=INST+1
|
---|
| 26 | F P="INSTRUCTIONS","ROUTE","SCHEDULE","DURATION","DOSE","DISPENSE DRUG" D
|
---|
| 27 | . S PTR=$$PTR(P) Q:'$L($G(ORDIALOG(PTR,1)))
|
---|
| 28 | . S DA=DA+1,ID=$P($G(^ORD(101.41,PTR,1)),U,3)
|
---|
| 29 | . S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)=ORDIALOG(PTR,1)
|
---|
| 30 | . S ^OR(100,ORIFNDAD,4.5,"ID",ID,DA)=""
|
---|
| 31 | S $P(^OR(100,ORIFNDAD,4.5,0),U,3,4)=DA_U_DA
|
---|
| 32 | S P=$$PTR("SIG"),DA=+$O(^OR(100,ORIFNDAD,4.5,"ID","SIG",0))
|
---|
| 33 | S I=+$O(^OR(100,ORIFNDAD,4.5,DA,2,""),-1),X=$G(^(I,0)) S:$L(X) X=X_" AND",^(0)=X
|
---|
| 34 | 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)
|
---|
| 35 | S $P(^OR(100,ORIFNDAD,4.5,DA,2,0),U,3,4)=I_U_I
|
---|
| 36 | ; -- rebuild order text w/new SIG
|
---|
| 37 | K ^TMP("ORWORD",$J,PTR) M ^TMP("ORWORD",$J,PTR,1)=^OR(100,ORIFNDAD,4.5,DA,2)
|
---|
| 38 | K ^OR(100,ORIFNDAD,8,1,.1) D ORDTEXT^ORCSAVE1(ORIFNDAD_";1")
|
---|
| 39 | P1 ; -- set up links
|
---|
| 40 | S $P(^OR(100,ORIFN,3),U,9)=ORIFNDAD
|
---|
| 41 | S HDR=$G(^OR(100,ORIFNDAD,2,0)),^(0)="^100.002PA^"_ORIFN_U_($P(HDR,U,4)+1),^(ORIFN,0)=ORIFN
|
---|
| 42 | Q
|
---|