Index: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXR.m
===================================================================
--- WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXR.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXR.m	(revision 623)
@@ -1,208 +1,172 @@
-ORWDXR	; SLC/KCM/JDL - Utilites for Order Actions ;5/30/06  14:50
-	;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,134,141,149,187,190,213,243**;Dec 17, 1997;Build 242
-	;
-ACTDCREA(DCIEN)	; Valid DC Reason
-	N X
-	S X=$G(^ORD(100.03,DCIEN,0))
-	I $P(X,U,4) Q 0
-	I $P(X,U,5)'=+$O(^DIC(9.4,"C","OR",0)) Q 0
-	I $P(X,U,7)=+$O(^ORD(100.02,"C","A",0)) Q 0
-	Q 1
-	;
-ISREL(VAL,ORIFN)	; Return true if an order has been released
-	N STS S STS=$P(^OR(100,+ORIFN,3),U,3)
-	S VAL=$S(STS=10:0,STS=11:0,1:1)  ; false if delayed or unreleased order
-	Q
-RENEW(REC,ORIFN,ORVP,ORNP,ORL,FLDS,CPLX,ORAPPT)	; Renew an order
-	N ORDG
-	N ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORNEW,ORCHECK,ORLOG,ORPKG
-	N ORDIALOG,PRMT,X0
-	N FSTDOSE,FST
-	S (FSTDOSE,FST)=0
-	I '$D(CPLX) S CPLX=0
-	I '$G(ORAPPT) S ORAPPT=""
-	S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2)
-	S X0=^OR(100,+ORIFN,0)
-	S ORDG=$P(X0,U,11)
-	S ORPKG=$P(X0,U,14)
-	I $D(FLDS("ORCHECK")) M ORCHECK=FLDS("ORCHECK")
-	I $P(X0,U,5)["101.41," D                        ; version 3
-	. S ORDIALOG=+$P(X0,U,5),ORCAT=$P(^OR(100,+ORIFN,0),U,12)
-	. D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN)
-	. I CPLX S FSTDOSE=$P($G(ORDIALOG("B","FIRST DOSE")),U,2) S:'FSTDOSE FSTDOSE=$$PTR^ORCD("OR GTX NOW")
-	. I FSTDOSE,$G(ORDIALOG(FSTDOSE,1)) K ORDIALOG(FSTDOSE,1)
-	E  D                                            ; version 2.5 generic
-	. S ORDIALOG=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDE",0))
-	. D GETDLG^ORCD(ORDIALOG)
-	. S PRMT=$O(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0))
-	. S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1))
-	. M ^TMP("ORWORD",$J,PRMT,1)=^OR(100,+ORIFN,1)
-	. S PRMT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
-	. I $P(X0,U,9) S ORDIALOG(PRMT,1)=$P(X0,U,9)
-	I +FLDS(1)=999 D  ; generic order
-	. S ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)=$P(FLDS(1),U,2)
-	. S ORDIALOG($$PTR^ORCD("OR GTX STOP DATE/TIME"),1)=$P(FLDS(1),U,3)
-	I ($O(^ORD(101.41,"AB","PS MEDS",0))>0),(+FLDS(1)=130)!(+FLDS(1)=135)!(+FLDS(1)=140),'$L($G(ORDIALOG($$PTR^ORCD("OR GTX SIG"),1))) D
-	. N ORDOSE,ORDRUG,ORCAT,ORWPSOI,PROMPT,DRUG
-	. S ORCAT=$P($G(^OR(100,+ORIFN,0)),U,12)
-	. S PROMPT=$$PTR^ORCD("OR GTX INSTRUCTIONS")
-	. S ORDRUG=$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1))
-	. S ORWPSOI=+$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
-	. I ORWPSOI S ORWPSOI=+$P($G(^ORD(101.43,+ORWPSOI,0)),U,2)
-	. D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,$S(ORCAT="I":"U",1:"O"),ORVP)       ; dflt doses
-	. D D1^ORCDPS2  ; set up ORDOSE
-	. S DRUG=$G(ORDOSE("DD",+ORDRUG))
-	. I DRUG,ORCAT="O" D RESETID^ORCDPS
-	. D SIG^ORCDPS2
-	I +FLDS(1)=140 D  ; outpatient meds
-	. K ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1) ; remove effective dt
-	. S ORDIALOG($$PTR^ORCD("OR GTX REFILLS"),1)=$P(FLDS(1),U,4)
-	. S ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)=$P(FLDS(1),U,5)
-	. S PRMT=$$PTR^ORCD("OR GTX WORD PROCESSING 1")
-	. K ^TMP("ORWORD",$J,PRMT,1)
-	. S I=1 F  S I=$O(FLDS(I)) Q:'I  S ^TMP("ORWORD",$J,PRMT,1,I-1,0)=FLDS(I)
-	. S ^TMP("ORWORD",$J,PRMT,1,0)=U_U_(I-1)_U_(I-1)_U_DT_U
-	. S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1))
-	. N SIG,PI,X S SIG=$$PTR^ORCD("OR GTX SIG")
-	. S PI=$$PTR^ORCD("OR GTX PATIENT INSTRUCTIONS"),X=$$STR(PI)
-	. I $L(X),$$STR(SIG)[X S ORDIALOG(PI,"FORMAT")="@" ;PI in Sig
-	D RN^ORCSAVE
-	S REC="" S ORIFN=+ORIFN_";"_ORDA D GETBYIFN^ORWORR(.REC,ORIFN)
-	Q
-RNWFLDS(LST,ORIFN)	; Return fields for renew action
-	; LST(0)=RenewType^Start^Stop^Refills^Pickup  LST(n)=Comments
-	N X0,DG,PKG,RNWTYPE,START,STOP,REFILLS,OROI
-	S ORIFN=+ORIFN,X0=^OR(100,ORIFN,0),DG=$P(X0,U,11),PKG=$P(X0,U,14)
-	S PKG=$E($P(^DIC(9.4,PKG,0),U,2),1,2),DG=$P(^ORD(100.98,DG,0),U,3)
-	S LST(0)=$S(PKG="OR":999,PKG="PS"&(DG="O RX"):140,PKG="PS"&(DG="UD RX"):130,PKG="PS"&(DG="NV RX"):145,1:0)
-	I +LST(0)=140 D
-	. S LST(0)=LST(0)_U_U_U_+$$VAL(ORIFN,"REFILLS")_U_$$VAL(ORIFN,"PICKUP")
-	. ;D WPVAL(.LST,ORIFN,"COMMENT")
-	I +LST(0)=999 S LST(0)=LST(0)_U_$$VAL(ORIFN,"START")_U_$$VAL(ORIFN,"STOP")
-	; make sure start/stop times are relative times, otherwise use NOW, no Stop
-	I +$P(LST(0),U,2) S $P(LST(0),U,2)="NOW"
-	I +$P(LST(0),U,3)!($P(LST(0),U,3)="0") S $P(LST(0),U,3)=""
-	;NEW STUFF AFTER THIS LINE OR*3*243
-	S $P(LST(0),U,9)=0
-	S OROI=$O(^OR(100,+ORIFN,4.5,"ID","ORDERABLE",0))
-	Q:'OROI
-	S OROI=$G(^OR(100,+ORIFN,4.5,OROI,1))
-	Q:'OROI
-	S $P(LST(0),U,9)=$$ISCLOZ^ORALWORD(OROI)
-	; add to LST node specifying if patient of ORIFN passes clozapine lab tests
-	I $P(LST(0),U,9) D
-	.N ORY,ORDFN,ORTMP
-	.S ORTMP=LST(0)
-	.K LST
-	.S LST(0)=ORTMP
-	.S ORDFN=$P(^OR(100,ORIFN,0),U,2)
-	.I $P(ORDFN,";",2)'="DPT(" Q
-	.S ORDFN=+ORDFN
-	.D ALLWORD^ORALWORD(.ORY,ORDFN,ORIFN,"E")
-	.M LST(1)=ORY
-	Q
-VAL(ORIFN,ID)	; Return value for order response
-	N DA S DA=+$O(^OR(100,ORIFN,4.5,"ID",ID,0))
-	Q $G(^OR(100,ORIFN,4.5,DA,1))
-WPVAL(TXT,ORIFN,ID)	; Return word processing value
-	N DA S DA=+$O(^OR(100,ORIFN,4.5,"ID",ID,0))
-	S I=0 F  S I=$O(^OR(100,ORIFN,4.5,DA,2,I)) Q:'I  S TXT(I)=^(I,0)
-	Q
-STR(PTR)	; -- Return word processing text as long string for comparison
-	N X,Y,I,ARRY
-	S ARRY=$G(ORDIALOG(+$G(PTR),1)) Q:'$L(ARRY) ""
-	S I=+$O(@ARRY@(0)),Y=$$UP^XLFSTR($G(@ARRY@(I,0)))
-	F  S I=+$O(@ARRY@(I)) Q:'I  S X=$G(@ARRY@(I,0)),Y=Y_$$UP^XLFSTR(X)
-	S Y=$TR(Y," ") ;remove all spaces, compare only text
-	Q Y
-CHKACT(ORDERID,ORWSIG,ORWREL,ORWNATR)	; Return error if can't sign/release order
-	N ORACT,ORWERR
-	; begin case
-	S ORACT=""
-	I (ORWSIG=1),$D(^XUSEC("ORES",DUZ)) S ORACT="ES" G XC1
-	I (ORWSIG=7),$D(^XUSEC("ORES",DUZ)) S ORACT="DS" G XC1
-	I ORWREL,(ORWNATR="W") S ORACT="OC" G XC1
-	I ORWREL S ORACT="RS" S:$P($G(^OR(100,+ORDERID,0)),U,16)<2 ORACT="ES"
-XC1	; end case
-	S ORWERR=""
-	I $L(ORACT),$$VALID^ORCACT0(ORDERID,ORACT,.ORWERR,ORWNATR) S ORWERR=""
-	Q ORWERR
-GTORITM(Y,ORIFN)	;-- Get back the orderable item IEN
-	S ORIFN=+ORIFN
-	S Y=$$VALUE^ORCSAVE2(ORIFN,"ORDERABLE")
-	Q
-GETPKG(Y,IFN)	;Get package for an order
-	N ORDERID,PKGID
-	Q:+IFN<1
-	S ORDERID=+IFN,Y=""
-	S PKGID=$P(^OR(100,ORDERID,0),U,14)
-	S:PKGID>0 Y=$P(^DIC(9.4,PKGID,0),U,2)
-	Q
-ISCPLX(ORY,ORID)	; 1: is complex order 0: is not
-	Q:'$D(^OR(100,+ORID,0))
-	N PKG
-	S PKG=$P($G(^OR(100,+ORID,0)),U,14)
-	S PKG=$$NMSP^ORCD(PKG)
-	I PKG'="PS" Q
-	N NUMCHDS,NOWID,NOWVAL
-	S (NOWVAL,NOWID)=0
-	S NUMCHDS=$P($G(^OR(100,+ORID,2,0)),U,4)
-	I NUMCHDS>2 S ORY=1 Q
-	I NUMCHDS=2 D
-	. S ORY=1
-	. S:$D(^OR(100,+ORID,4.5,"ID","NOW")) NOWID=$O(^("NOW",0))
-	. S:NOWID NOWVAL=$G(^OR(100,+ORID,4.5,NOWID,1))
-	I NOWVAL=1 S ORY=0 Q
-	Q
-ORCPLX(ORY,ORID,ORACT)	;Return children orders of the complex order
-	Q:'$D(^OR(100,+ORID,0))
-	N PKG,LACT,OELACT,ISNOW
-	S PKG=$P($G(^OR(100,+ORID,0)),U,14)
-	S PKG=$$NMSP^ORCD(PKG)
-	I PKG'="PS" Q
-	N CHLDCNT,IDX,X3
-	S (CHLDCNT,IDX)=0
-	S:$L($G(^OR(100,+ORID,2,0))) CHLDCNT=$P(^(0),U,4)
-	I 'CHLDCNT Q
-	F  S IDX=$O(^OR(100,+ORID,2,IDX)) Q:'IDX  D
-	. S (LACT,OELACT,ISNOW)=0
-	. D ISNOW(.ISNOW,IDX)
-	. Q:ISNOW
-	. S X3=$G(^OR(100,IDX,3))
-	. S LACT=$P(X3,U,7)
-	. F  S OELACT=$O(^OR(100,IDX,8,OELACT),-1) Q:OELACT
-	. S:OELACT>LACT LACT=OELACT
-	. S ORY(IDX)=IDX_";"_LACT
-	Q
-CANRN(ORY,ORID)	; Check conjunction for renew.
-	; All conjunctioni = "And" return 1
-	; Has a "Then" return 0
-	Q:'$G(^OR(100,+ORID,0))
-	N PKG
-	S PKG=$P($G(^OR(100,+ORID,0)),U,14)
-	S PKG=$$NMSP^ORCD(PKG)
-	I PKG'="PS" Q
-	N INDX,INDY,CANRENEW
-	S INDX=0
-	S CANRENEW=1
-	N CHID
-	S CHID=0 F  S CHID=$O(^OR(100,+ORID,2,CHID)) Q:'CHID  D
-	. N ORSTS,ACTIVE S ORSTS=0
-	. S ORSTS=$P($G(^OR(100,CHID,3)),U,3)
-	. S ACTIVE=$O(^ORD(100.01,"B","ACTIVE",0))
-	. I ACTIVE'=ORSTS S CANRENEW=0
-	I 'CANRENEW S ORY=CANRENEW Q
-	F  S INDX=$O(^OR(100,+ORID,4.5,"ID","CONJ",INDX)) Q:'INDX  D
-	. S INDY=0 F  S INDY=$O(^OR(100,+ORID,4.5,INDX,INDY)) Q:'INDY  D
-	. . I $G(^(INDY))="T" S CANRENEW=0 Q
-	. I CANRENEW=0 Q
-	S ORY=CANRENEW
-	Q
-ISNOW(ORY,ORID)	; Is first time now order?
-	N SCH
-	Q:'$D(^OR(100,+ORID,0))
-	S SCH=""
-	S SCH=$O(^OR(100,+ORID,4.5,"ID","SCHEDULE",0))
-	S:SCH SCH=$G(^OR(100,+ORID,4.5,SCH,1))
-	S:SCH="NOW" ORY=1
-	Q
+ORWDXR ; SLC/KCM/JDL - Utilites for Order Actions ;5/6/04  14:50
+ ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,134,141,149,187,190,213**;Dec 17, 1997
+ ;
+ISREL(VAL,ORIFN) ; Return true if an order has been released
+ N STS S STS=$P(^OR(100,+ORIFN,3),U,3)
+ S VAL=$S(STS=10:0,STS=11:0,1:1)  ; false if delayed or unreleased order
+ Q
+RENEW(REC,ORIFN,ORVP,ORNP,ORL,FLDS,CPLX,ORAPPT) ; Renew an order
+ N ORDG
+ N ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORNEW,ORCHECK,ORLOG,ORPKG
+ N ORDIALOG,PRMT,X0
+ N FSTDOSE,FST
+ S (FSTDOSE,FST)=0
+ I '$D(CPLX) S CPLX=0
+ I '$G(ORAPPT) S ORAPPT=""
+ S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2)
+ S X0=^OR(100,+ORIFN,0)
+ S ORDG=$P(X0,U,11)
+ S ORPKG=$P(X0,U,14)
+ I $D(FLDS("ORCHECK")) M ORCHECK=FLDS("ORCHECK")
+ I $P(X0,U,5)["101.41," D                        ; version 3
+ . S ORDIALOG=+$P(X0,U,5),ORCAT=$P(^OR(100,+ORIFN,0),U,12)
+ . D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN)
+ . I CPLX S FSTDOSE=$P($G(ORDIALOG("B","FIRST DOSE")),U,2) S:'FSTDOSE FSTDOSE=$$PTR^ORCD("OR GTX NOW")
+ . I FSTDOSE,$G(ORDIALOG(FSTDOSE,1)) K ORDIALOG(FSTDOSE,1)
+ E  D                                            ; version 2.5 generic
+ . S ORDIALOG=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDE",0))
+ . D GETDLG^ORCD(ORDIALOG)
+ . S PRMT=$O(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0))
+ . S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1))
+ . M ^TMP("ORWORD",$J,PRMT,1)=^OR(100,+ORIFN,1)
+ . S PRMT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
+ . I $P(X0,U,9) S ORDIALOG(PRMT,1)=$P(X0,U,9)
+ I +FLDS(1)=999 D  ; generic order
+ . S ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)=$P(FLDS(1),U,2)
+ . S ORDIALOG($$PTR^ORCD("OR GTX STOP DATE/TIME"),1)=$P(FLDS(1),U,3)
+ I ($O(^ORD(101.41,"AB","PS MEDS",0))>0),(+FLDS(1)=130)!(+FLDS(1)=135)!(+FLDS(1)=140),'$L($G(ORDIALOG($$PTR^ORCD("OR GTX SIG"),1))) D
+ . N ORDOSE,ORDRUG,ORCAT,ORWPSOI,PROMPT,DRUG
+ . S ORCAT=$P($G(^OR(100,+ORIFN,0)),U,12)
+ . S PROMPT=$$PTR^ORCD("OR GTX INSTRUCTIONS")
+ . S ORDRUG=$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1))
+ . S ORWPSOI=+$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
+ . I ORWPSOI S ORWPSOI=+$P($G(^ORD(101.43,+ORWPSOI,0)),U,2)
+ . D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,$S(ORCAT="I":"U",1:"O"),ORVP)       ; dflt doses
+ . D D1^ORCDPS2  ; set up ORDOSE
+ . S DRUG=$G(ORDOSE("DD",+ORDRUG))
+ . I DRUG,ORCAT="O" D RESETID^ORCDPS
+ . D SIG^ORCDPS2
+ I +FLDS(1)=140 D  ; outpatient meds
+ . K ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1) ; remove effective dt
+ . S ORDIALOG($$PTR^ORCD("OR GTX REFILLS"),1)=$P(FLDS(1),U,4)
+ . S ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)=$P(FLDS(1),U,5)
+ . S PRMT=$$PTR^ORCD("OR GTX WORD PROCESSING 1")
+ . K ^TMP("ORWORD",$J,PRMT,1)
+ . S I=1 F  S I=$O(FLDS(I)) Q:'I  S ^TMP("ORWORD",$J,PRMT,1,I-1,0)=FLDS(I)
+ . S ^TMP("ORWORD",$J,PRMT,1,0)=U_U_(I-1)_U_(I-1)_U_DT_U
+ . S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1))
+ D RN^ORCSAVE
+ S REC="" S ORIFN=+ORIFN_";"_ORDA D GETBYIFN^ORWORR(.REC,ORIFN)
+ Q
+RNWFLDS(LST,ORIFN)      ; Return fields for renew action
+ ; LST(0)=RenewType^Start^Stop^Refills^Pickup  LST(n)=Comments
+ N X0,DG,PKG,RNWTYPE,START,STOP,REFILLS
+ S ORIFN=+ORIFN,X0=^OR(100,ORIFN,0),DG=$P(X0,U,11),PKG=$P(X0,U,14)
+ S PKG=$E($P(^DIC(9.4,PKG,0),U,2),1,2),DG=$P(^ORD(100.98,DG,0),U,3)
+ S LST(0)=$S(PKG="OR":999,PKG="PS"&(DG="O RX"):140,PKG="PS"&(DG="UD RX"):130,PKG="PS"&(DG="NV RX"):145,1:0)
+ I +LST(0)=140 D
+ . S LST(0)=LST(0)_U_U_U_+$$VAL(ORIFN,"REFILLS")_U_$$VAL(ORIFN,"PICKUP")
+ . D WPVAL(.LST,ORIFN,"COMMENT")
+ I +LST(0)=999 S LST(0)=LST(0)_U_$$VAL(ORIFN,"START")_U_$$VAL(ORIFN,"STOP")
+ ; make sure start/stop times are relative times, otherwise use NOW, no Stop
+ I +$P(LST(0),U,2) S $P(LST(0),U,2)="NOW"
+ I +$P(LST(0),U,3)!($P(LST(0),U,3)="0") S $P(LST(0),U,3)=""
+ Q
+VAL(ORIFN,ID)   ; Return value for order response
+ N DA S DA=+$O(^OR(100,ORIFN,4.5,"ID",ID,0))
+ Q $G(^OR(100,ORIFN,4.5,DA,1))
+WPVAL(TXT,ORIFN,ID)    ; Return word processing value
+ N DA S DA=+$O(^OR(100,ORIFN,4.5,"ID",ID,0))
+ S I=0 F  S I=$O(^OR(100,ORIFN,4.5,DA,2,I)) Q:'I  S TXT(I)=^(I,0)
+ Q
+CHKACT(ORDERID,ORWSIG,ORWREL,ORWNATR) ; Return error if can't sign/release order
+ N ORACT,ORWERR
+ ; begin case
+ S ORACT=""
+ I (ORWSIG=1),$D(^XUSEC("ORES",DUZ)) S ORACT="ES" G XC1
+ I (ORWSIG=7),$D(^XUSEC("ORES",DUZ)) S ORACT="DS" G XC1
+ I ORWREL,(ORWNATR="W") S ORACT="OC" G XC1
+ I ORWREL S ORACT="RS" S:$P($G(^OR(100,+ORDERID,0)),U,16)<2 ORACT="ES"
+XC1 ; end case
+ S ORWERR=""
+ I $L(ORACT),$$VALID^ORCACT0(ORDERID,ORACT,.ORWERR,ORWNATR) S ORWERR=""
+ Q ORWERR
+GTORITM(Y,ORIFN)        ;-- Get back the orderable item IEN
+ S ORIFN=+ORIFN
+ S Y=$$VALUE^ORCSAVE2(ORIFN,"ORDERABLE")
+ Q
+GETPKG(Y,IFN) ;Get package for an order
+ N ORDERID,PKGID
+ Q:+IFN<1
+ S ORDERID=+IFN,Y=""
+ S PKGID=$P(^OR(100,ORDERID,0),U,14)
+ S:PKGID>0 Y=$P(^DIC(9.4,PKGID,0),U,2)
+ Q
+ISCPLX(ORY,ORID) ; 1: is complex order 0: is not
+ Q:'$D(^OR(100,+ORID,0))
+ N PKG
+ S PKG=$P($G(^OR(100,+ORID,0)),U,14)
+ S PKG=$$NMSP^ORCD(PKG)
+ I PKG'="PS" Q
+ N NUMCHDS,NOWID,NOWVAL
+ S (NOWVAL,NOWID)=0
+ S NUMCHDS=$P($G(^OR(100,+ORID,2,0)),U,4)
+ I NUMCHDS>2 S ORY=1 Q
+ I NUMCHDS=2 D
+ . S ORY=1
+ . S:$D(^OR(100,+ORID,4.5,"ID","NOW")) NOWID=$O(^("NOW",0))
+ . S:NOWID NOWVAL=$G(^OR(100,+ORID,4.5,NOWID,1))
+ I NOWVAL=1 S ORY=0 Q
+ Q
+ORCPLX(ORY,ORID,ORACT) ;Return children orders of the complex order
+ Q:'$D(^OR(100,+ORID,0))
+ N PKG,LACT,OELACT,ISNOW
+ S PKG=$P($G(^OR(100,+ORID,0)),U,14)
+ S PKG=$$NMSP^ORCD(PKG)
+ I PKG'="PS" Q
+ N CHLDCNT,IDX,X3
+ S (CHLDCNT,IDX)=0
+ S:$L($G(^OR(100,+ORID,2,0))) CHLDCNT=$P(^(0),U,4)
+ I 'CHLDCNT Q
+ F  S IDX=$O(^OR(100,+ORID,2,IDX)) Q:'IDX  D
+ . S (LACT,OELACT,ISNOW)=0
+ . D ISNOW(.ISNOW,IDX)
+ . Q:ISNOW
+ . S X3=$G(^OR(100,IDX,3))
+ . S LACT=$P(X3,U,7)
+ . F  S OELACT=$O(^OR(100,IDX,8,OELACT),-1) Q:OELACT
+ . S:OELACT>LACT LACT=OELACT
+ . S ORY(IDX)=IDX_";"_LACT
+ Q
+CANRN(ORY,ORID) ; Check conjunction for renew.
+ ; All conjunctioni = "And" return 1
+ ; Has a "Then" return 0
+ Q:'$G(^OR(100,+ORID,0))
+ N PKG
+ S PKG=$P($G(^OR(100,+ORID,0)),U,14)
+ S PKG=$$NMSP^ORCD(PKG)
+ I PKG'="PS" Q
+ N INDX,INDY,CANRENEW
+ S INDX=0
+ S CANRENEW=1
+ N CHID
+ S CHID=0 F  S CHID=$O(^OR(100,+ORID,2,CHID)) Q:'CHID  D
+ . N ORSTS,ACTIVE S ORSTS=0
+ . S ORSTS=$P($G(^OR(100,CHID,3)),U,3)
+ . S ACTIVE=$O(^ORD(100.01,"B","ACTIVE",0))
+ . I ACTIVE'=ORSTS S CANRENEW=0
+ I 'CANRENEW S ORY=CANRENEW Q
+ F  S INDX=$O(^OR(100,+ORID,4.5,"ID","CONJ",INDX)) Q:'INDX  D
+ . S INDY=0 F  S INDY=$O(^OR(100,+ORID,4.5,INDX,INDY)) Q:'INDY  D
+ . . I $G(^(INDY))="T" S CANRENEW=0 Q
+ . I CANRENEW=0 Q
+ S ORY=CANRENEW
+ Q
+ISNOW(ORY,ORID) ; Is first time now order?
+ N SCH
+ Q:'$D(^OR(100,+ORID,0))
+ S SCH=""
+ S SCH=$O(^OR(100,+ORID,4.5,"ID","SCHEDULE",0))
+ S:SCH SCH=$G(^OR(100,+ORID,4.5,SCH,1))
+ S:SCH="NOW" ORY=1
+ Q
