| 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
 | 
|---|