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