- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXR.m
r613 r623 1 ORWDXR ; SLC/KCM/JDL - Utilites for Order Actions ;5/30/06 14:50 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,134,141,149,187,190,213,243**;Dec 17, 1997;Build 242 3 ; 4 ACTDCREA(DCIEN) ; Valid DC Reason 5 N X 6 S X=$G(^ORD(100.03,DCIEN,0)) 7 I $P(X,U,4) Q 0 8 I $P(X,U,5)'=+$O(^DIC(9.4,"C","OR",0)) Q 0 9 I $P(X,U,7)=+$O(^ORD(100.02,"C","A",0)) Q 0 10 Q 1 11 ; 12 ISREL(VAL,ORIFN) ; Return true if an order has been released 13 N STS S STS=$P(^OR(100,+ORIFN,3),U,3) 14 S VAL=$S(STS=10:0,STS=11:0,1:1) ; false if delayed or unreleased order 15 Q 16 RENEW(REC,ORIFN,ORVP,ORNP,ORL,FLDS,CPLX,ORAPPT) ; Renew an order 17 N ORDG 18 N ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORNEW,ORCHECK,ORLOG,ORPKG 19 N ORDIALOG,PRMT,X0 20 N FSTDOSE,FST 21 S (FSTDOSE,FST)=0 22 I '$D(CPLX) S CPLX=0 23 I '$G(ORAPPT) S ORAPPT="" 24 S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2) 25 S X0=^OR(100,+ORIFN,0) 26 S ORDG=$P(X0,U,11) 27 S ORPKG=$P(X0,U,14) 28 I $D(FLDS("ORCHECK")) M ORCHECK=FLDS("ORCHECK") 29 I $P(X0,U,5)["101.41," D ; version 3 30 . S ORDIALOG=+$P(X0,U,5),ORCAT=$P(^OR(100,+ORIFN,0),U,12) 31 . D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN) 32 . I CPLX S FSTDOSE=$P($G(ORDIALOG("B","FIRST DOSE")),U,2) S:'FSTDOSE FSTDOSE=$$PTR^ORCD("OR GTX NOW") 33 . I FSTDOSE,$G(ORDIALOG(FSTDOSE,1)) K ORDIALOG(FSTDOSE,1) 34 E D ; version 2.5 generic 35 . S ORDIALOG=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDE",0)) 36 . D GETDLG^ORCD(ORDIALOG) 37 . S PRMT=$O(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0)) 38 . S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1)) 39 . M ^TMP("ORWORD",$J,PRMT,1)=^OR(100,+ORIFN,1) 40 . S PRMT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0)) 41 . I $P(X0,U,9) S ORDIALOG(PRMT,1)=$P(X0,U,9) 42 I +FLDS(1)=999 D ; generic order 43 . S ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)=$P(FLDS(1),U,2) 44 . S ORDIALOG($$PTR^ORCD("OR GTX STOP DATE/TIME"),1)=$P(FLDS(1),U,3) 45 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 46 . N ORDOSE,ORDRUG,ORCAT,ORWPSOI,PROMPT,DRUG 47 . S ORCAT=$P($G(^OR(100,+ORIFN,0)),U,12) 48 . S PROMPT=$$PTR^ORCD("OR GTX INSTRUCTIONS") 49 . S ORDRUG=$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1)) 50 . S ORWPSOI=+$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)) 51 . I ORWPSOI S ORWPSOI=+$P($G(^ORD(101.43,+ORWPSOI,0)),U,2) 52 . D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,$S(ORCAT="I":"U",1:"O"),ORVP) ; dflt doses 53 . D D1^ORCDPS2 ; set up ORDOSE 54 . S DRUG=$G(ORDOSE("DD",+ORDRUG)) 55 . I DRUG,ORCAT="O" D RESETID^ORCDPS 56 . D SIG^ORCDPS2 57 I +FLDS(1)=140 D ; outpatient meds 58 . K ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1) ; remove effective dt 59 . S ORDIALOG($$PTR^ORCD("OR GTX REFILLS"),1)=$P(FLDS(1),U,4) 60 . S ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)=$P(FLDS(1),U,5) 61 . S PRMT=$$PTR^ORCD("OR GTX WORD PROCESSING 1") 62 . K ^TMP("ORWORD",$J,PRMT,1) 63 . S I=1 F S I=$O(FLDS(I)) Q:'I S ^TMP("ORWORD",$J,PRMT,1,I-1,0)=FLDS(I) 64 . S ^TMP("ORWORD",$J,PRMT,1,0)=U_U_(I-1)_U_(I-1)_U_DT_U 65 . S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1)) 66 . N SIG,PI,X S SIG=$$PTR^ORCD("OR GTX SIG") 67 . S PI=$$PTR^ORCD("OR GTX PATIENT INSTRUCTIONS"),X=$$STR(PI) 68 . I $L(X),$$STR(SIG)[X S ORDIALOG(PI,"FORMAT")="@" ;PI in Sig 69 D RN^ORCSAVE 70 S REC="" S ORIFN=+ORIFN_";"_ORDA D GETBYIFN^ORWORR(.REC,ORIFN) 71 Q 72 RNWFLDS(LST,ORIFN) ; Return fields for renew action 73 ; LST(0)=RenewType^Start^Stop^Refills^Pickup LST(n)=Comments 74 N X0,DG,PKG,RNWTYPE,START,STOP,REFILLS,OROI 75 S ORIFN=+ORIFN,X0=^OR(100,ORIFN,0),DG=$P(X0,U,11),PKG=$P(X0,U,14) 76 S PKG=$E($P(^DIC(9.4,PKG,0),U,2),1,2),DG=$P(^ORD(100.98,DG,0),U,3) 77 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) 78 I +LST(0)=140 D 79 . S LST(0)=LST(0)_U_U_U_+$$VAL(ORIFN,"REFILLS")_U_$$VAL(ORIFN,"PICKUP") 80 . ;D WPVAL(.LST,ORIFN,"COMMENT") 81 I +LST(0)=999 S LST(0)=LST(0)_U_$$VAL(ORIFN,"START")_U_$$VAL(ORIFN,"STOP") 82 ; make sure start/stop times are relative times, otherwise use NOW, no Stop 83 I +$P(LST(0),U,2) S $P(LST(0),U,2)="NOW" 84 I +$P(LST(0),U,3)!($P(LST(0),U,3)="0") S $P(LST(0),U,3)="" 85 ;NEW STUFF AFTER THIS LINE OR*3*243 86 S $P(LST(0),U,9)=0 87 S OROI=$O(^OR(100,+ORIFN,4.5,"ID","ORDERABLE",0)) 88 Q:'OROI 89 S OROI=$G(^OR(100,+ORIFN,4.5,OROI,1)) 90 Q:'OROI 91 S $P(LST(0),U,9)=$$ISCLOZ^ORALWORD(OROI) 92 ; add to LST node specifying if patient of ORIFN passes clozapine lab tests 93 I $P(LST(0),U,9) D 94 .N ORY,ORDFN,ORTMP 95 .S ORTMP=LST(0) 96 .K LST 97 .S LST(0)=ORTMP 98 .S ORDFN=$P(^OR(100,ORIFN,0),U,2) 99 .I $P(ORDFN,";",2)'="DPT(" Q 100 .S ORDFN=+ORDFN 101 .D ALLWORD^ORALWORD(.ORY,ORDFN,ORIFN,"E") 102 .M LST(1)=ORY 103 Q 104 VAL(ORIFN,ID) ; Return value for order response 105 N DA S DA=+$O(^OR(100,ORIFN,4.5,"ID",ID,0)) 106 Q $G(^OR(100,ORIFN,4.5,DA,1)) 107 WPVAL(TXT,ORIFN,ID) ; Return word processing value 108 N DA S DA=+$O(^OR(100,ORIFN,4.5,"ID",ID,0)) 109 S I=0 F S I=$O(^OR(100,ORIFN,4.5,DA,2,I)) Q:'I S TXT(I)=^(I,0) 110 Q 111 STR(PTR) ; -- Return word processing text as long string for comparison 112 N X,Y,I,ARRY 113 S ARRY=$G(ORDIALOG(+$G(PTR),1)) Q:'$L(ARRY) "" 114 S I=+$O(@ARRY@(0)),Y=$$UP^XLFSTR($G(@ARRY@(I,0))) 115 F S I=+$O(@ARRY@(I)) Q:'I S X=$G(@ARRY@(I,0)),Y=Y_$$UP^XLFSTR(X) 116 S Y=$TR(Y," ") ;remove all spaces, compare only text 117 Q Y 118 CHKACT(ORDERID,ORWSIG,ORWREL,ORWNATR) ; Return error if can't sign/release order 119 N ORACT,ORWERR 120 ; begin case 121 S ORACT="" 122 I (ORWSIG=1),$D(^XUSEC("ORES",DUZ)) S ORACT="ES" G XC1 123 I (ORWSIG=7),$D(^XUSEC("ORES",DUZ)) S ORACT="DS" G XC1 124 I ORWREL,(ORWNATR="W") S ORACT="OC" G XC1 125 I ORWREL S ORACT="RS" S:$P($G(^OR(100,+ORDERID,0)),U,16)<2 ORACT="ES" 126 XC1 ; end case 127 S ORWERR="" 128 I $L(ORACT),$$VALID^ORCACT0(ORDERID,ORACT,.ORWERR,ORWNATR) S ORWERR="" 129 Q ORWERR 130 GTORITM(Y,ORIFN) ;-- Get back the orderable item IEN 131 S ORIFN=+ORIFN 132 S Y=$$VALUE^ORCSAVE2(ORIFN,"ORDERABLE") 133 Q 134 GETPKG(Y,IFN) ;Get package for an order 135 N ORDERID,PKGID 136 Q:+IFN<1 137 S ORDERID=+IFN,Y="" 138 S PKGID=$P(^OR(100,ORDERID,0),U,14) 139 S:PKGID>0 Y=$P(^DIC(9.4,PKGID,0),U,2) 140 Q 141 ISCPLX(ORY,ORID) ; 1: is complex order 0: is not 142 Q:'$D(^OR(100,+ORID,0)) 143 N PKG 144 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 145 S PKG=$$NMSP^ORCD(PKG) 146 I PKG'="PS" Q 147 N NUMCHDS,NOWID,NOWVAL 148 S (NOWVAL,NOWID)=0 149 S NUMCHDS=$P($G(^OR(100,+ORID,2,0)),U,4) 150 I NUMCHDS>2 S ORY=1 Q 151 I NUMCHDS=2 D 152 . S ORY=1 153 . S:$D(^OR(100,+ORID,4.5,"ID","NOW")) NOWID=$O(^("NOW",0)) 154 . S:NOWID NOWVAL=$G(^OR(100,+ORID,4.5,NOWID,1)) 155 I NOWVAL=1 S ORY=0 Q 156 Q 157 ORCPLX(ORY,ORID,ORACT) ;Return children orders of the complex order 158 Q:'$D(^OR(100,+ORID,0)) 159 N PKG,LACT,OELACT,ISNOW 160 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 161 S PKG=$$NMSP^ORCD(PKG) 162 I PKG'="PS" Q 163 N CHLDCNT,IDX,X3 164 S (CHLDCNT,IDX)=0 165 S:$L($G(^OR(100,+ORID,2,0))) CHLDCNT=$P(^(0),U,4) 166 I 'CHLDCNT Q 167 F S IDX=$O(^OR(100,+ORID,2,IDX)) Q:'IDX D 168 . S (LACT,OELACT,ISNOW)=0 169 . D ISNOW(.ISNOW,IDX) 170 . Q:ISNOW 171 . S X3=$G(^OR(100,IDX,3)) 172 . S LACT=$P(X3,U,7) 173 . F S OELACT=$O(^OR(100,IDX,8,OELACT),-1) Q:OELACT 174 . S:OELACT>LACT LACT=OELACT 175 . S ORY(IDX)=IDX_";"_LACT 176 Q 177 CANRN(ORY,ORID) ; Check conjunction for renew. 178 ; All conjunctioni = "And" return 1 179 ; Has a "Then" return 0 180 Q:'$G(^OR(100,+ORID,0)) 181 N PKG 182 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 183 S PKG=$$NMSP^ORCD(PKG) 184 I PKG'="PS" Q 185 N INDX,INDY,CANRENEW 186 S INDX=0 187 S CANRENEW=1 188 N CHID 189 S CHID=0 F S CHID=$O(^OR(100,+ORID,2,CHID)) Q:'CHID D 190 . N ORSTS,ACTIVE S ORSTS=0 191 . S ORSTS=$P($G(^OR(100,CHID,3)),U,3) 192 . S ACTIVE=$O(^ORD(100.01,"B","ACTIVE",0)) 193 . I ACTIVE'=ORSTS S CANRENEW=0 194 I 'CANRENEW S ORY=CANRENEW Q 195 F S INDX=$O(^OR(100,+ORID,4.5,"ID","CONJ",INDX)) Q:'INDX D 196 . S INDY=0 F S INDY=$O(^OR(100,+ORID,4.5,INDX,INDY)) Q:'INDY D 197 . . I $G(^(INDY))="T" S CANRENEW=0 Q 198 . I CANRENEW=0 Q 199 S ORY=CANRENEW 200 Q 201 ISNOW(ORY,ORID) ; Is first time now order? 202 N SCH 203 Q:'$D(^OR(100,+ORID,0)) 204 S SCH="" 205 S SCH=$O(^OR(100,+ORID,4.5,"ID","SCHEDULE",0)) 206 S:SCH SCH=$G(^OR(100,+ORID,4.5,SCH,1)) 207 S:SCH="NOW" ORY=1 208 Q 1 ORWDXR ; SLC/KCM/JDL - Utilites for Order Actions ;5/6/04 14:50 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,134,141,149,187,190,213**;Dec 17, 1997 3 ; 4 ISREL(VAL,ORIFN) ; Return true if an order has been released 5 N STS S STS=$P(^OR(100,+ORIFN,3),U,3) 6 S VAL=$S(STS=10:0,STS=11:0,1:1) ; false if delayed or unreleased order 7 Q 8 RENEW(REC,ORIFN,ORVP,ORNP,ORL,FLDS,CPLX,ORAPPT) ; Renew an order 9 N ORDG 10 N ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORNEW,ORCHECK,ORLOG,ORPKG 11 N ORDIALOG,PRMT,X0 12 N FSTDOSE,FST 13 S (FSTDOSE,FST)=0 14 I '$D(CPLX) S CPLX=0 15 I '$G(ORAPPT) S ORAPPT="" 16 S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2) 17 S X0=^OR(100,+ORIFN,0) 18 S ORDG=$P(X0,U,11) 19 S ORPKG=$P(X0,U,14) 20 I $D(FLDS("ORCHECK")) M ORCHECK=FLDS("ORCHECK") 21 I $P(X0,U,5)["101.41," D ; version 3 22 . S ORDIALOG=+$P(X0,U,5),ORCAT=$P(^OR(100,+ORIFN,0),U,12) 23 . D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN) 24 . I CPLX S FSTDOSE=$P($G(ORDIALOG("B","FIRST DOSE")),U,2) S:'FSTDOSE FSTDOSE=$$PTR^ORCD("OR GTX NOW") 25 . I FSTDOSE,$G(ORDIALOG(FSTDOSE,1)) K ORDIALOG(FSTDOSE,1) 26 E D ; version 2.5 generic 27 . S ORDIALOG=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDE",0)) 28 . D GETDLG^ORCD(ORDIALOG) 29 . S PRMT=$O(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0)) 30 . S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1)) 31 . M ^TMP("ORWORD",$J,PRMT,1)=^OR(100,+ORIFN,1) 32 . S PRMT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0)) 33 . I $P(X0,U,9) S ORDIALOG(PRMT,1)=$P(X0,U,9) 34 I +FLDS(1)=999 D ; generic order 35 . S ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)=$P(FLDS(1),U,2) 36 . S ORDIALOG($$PTR^ORCD("OR GTX STOP DATE/TIME"),1)=$P(FLDS(1),U,3) 37 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 38 . N ORDOSE,ORDRUG,ORCAT,ORWPSOI,PROMPT,DRUG 39 . S ORCAT=$P($G(^OR(100,+ORIFN,0)),U,12) 40 . S PROMPT=$$PTR^ORCD("OR GTX INSTRUCTIONS") 41 . S ORDRUG=$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1)) 42 . S ORWPSOI=+$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)) 43 . I ORWPSOI S ORWPSOI=+$P($G(^ORD(101.43,+ORWPSOI,0)),U,2) 44 . D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,$S(ORCAT="I":"U",1:"O"),ORVP) ; dflt doses 45 . D D1^ORCDPS2 ; set up ORDOSE 46 . S DRUG=$G(ORDOSE("DD",+ORDRUG)) 47 . I DRUG,ORCAT="O" D RESETID^ORCDPS 48 . D SIG^ORCDPS2 49 I +FLDS(1)=140 D ; outpatient meds 50 . K ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1) ; remove effective dt 51 . S ORDIALOG($$PTR^ORCD("OR GTX REFILLS"),1)=$P(FLDS(1),U,4) 52 . S ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)=$P(FLDS(1),U,5) 53 . S PRMT=$$PTR^ORCD("OR GTX WORD PROCESSING 1") 54 . K ^TMP("ORWORD",$J,PRMT,1) 55 . S I=1 F S I=$O(FLDS(I)) Q:'I S ^TMP("ORWORD",$J,PRMT,1,I-1,0)=FLDS(I) 56 . S ^TMP("ORWORD",$J,PRMT,1,0)=U_U_(I-1)_U_(I-1)_U_DT_U 57 . S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1)) 58 D RN^ORCSAVE 59 S REC="" S ORIFN=+ORIFN_";"_ORDA D GETBYIFN^ORWORR(.REC,ORIFN) 60 Q 61 RNWFLDS(LST,ORIFN) ; Return fields for renew action 62 ; LST(0)=RenewType^Start^Stop^Refills^Pickup LST(n)=Comments 63 N X0,DG,PKG,RNWTYPE,START,STOP,REFILLS 64 S ORIFN=+ORIFN,X0=^OR(100,ORIFN,0),DG=$P(X0,U,11),PKG=$P(X0,U,14) 65 S PKG=$E($P(^DIC(9.4,PKG,0),U,2),1,2),DG=$P(^ORD(100.98,DG,0),U,3) 66 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) 67 I +LST(0)=140 D 68 . S LST(0)=LST(0)_U_U_U_+$$VAL(ORIFN,"REFILLS")_U_$$VAL(ORIFN,"PICKUP") 69 . D WPVAL(.LST,ORIFN,"COMMENT") 70 I +LST(0)=999 S LST(0)=LST(0)_U_$$VAL(ORIFN,"START")_U_$$VAL(ORIFN,"STOP") 71 ; make sure start/stop times are relative times, otherwise use NOW, no Stop 72 I +$P(LST(0),U,2) S $P(LST(0),U,2)="NOW" 73 I +$P(LST(0),U,3)!($P(LST(0),U,3)="0") S $P(LST(0),U,3)="" 74 Q 75 VAL(ORIFN,ID) ; Return value for order response 76 N DA S DA=+$O(^OR(100,ORIFN,4.5,"ID",ID,0)) 77 Q $G(^OR(100,ORIFN,4.5,DA,1)) 78 WPVAL(TXT,ORIFN,ID) ; Return word processing value 79 N DA S DA=+$O(^OR(100,ORIFN,4.5,"ID",ID,0)) 80 S I=0 F S I=$O(^OR(100,ORIFN,4.5,DA,2,I)) Q:'I S TXT(I)=^(I,0) 81 Q 82 CHKACT(ORDERID,ORWSIG,ORWREL,ORWNATR) ; Return error if can't sign/release order 83 N ORACT,ORWERR 84 ; begin case 85 S ORACT="" 86 I (ORWSIG=1),$D(^XUSEC("ORES",DUZ)) S ORACT="ES" G XC1 87 I (ORWSIG=7),$D(^XUSEC("ORES",DUZ)) S ORACT="DS" G XC1 88 I ORWREL,(ORWNATR="W") S ORACT="OC" G XC1 89 I ORWREL S ORACT="RS" S:$P($G(^OR(100,+ORDERID,0)),U,16)<2 ORACT="ES" 90 XC1 ; end case 91 S ORWERR="" 92 I $L(ORACT),$$VALID^ORCACT0(ORDERID,ORACT,.ORWERR,ORWNATR) S ORWERR="" 93 Q ORWERR 94 GTORITM(Y,ORIFN) ;-- Get back the orderable item IEN 95 S ORIFN=+ORIFN 96 S Y=$$VALUE^ORCSAVE2(ORIFN,"ORDERABLE") 97 Q 98 GETPKG(Y,IFN) ;Get package for an order 99 N ORDERID,PKGID 100 Q:+IFN<1 101 S ORDERID=+IFN,Y="" 102 S PKGID=$P(^OR(100,ORDERID,0),U,14) 103 S:PKGID>0 Y=$P(^DIC(9.4,PKGID,0),U,2) 104 Q 105 ISCPLX(ORY,ORID) ; 1: is complex order 0: is not 106 Q:'$D(^OR(100,+ORID,0)) 107 N PKG 108 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 109 S PKG=$$NMSP^ORCD(PKG) 110 I PKG'="PS" Q 111 N NUMCHDS,NOWID,NOWVAL 112 S (NOWVAL,NOWID)=0 113 S NUMCHDS=$P($G(^OR(100,+ORID,2,0)),U,4) 114 I NUMCHDS>2 S ORY=1 Q 115 I NUMCHDS=2 D 116 . S ORY=1 117 . S:$D(^OR(100,+ORID,4.5,"ID","NOW")) NOWID=$O(^("NOW",0)) 118 . S:NOWID NOWVAL=$G(^OR(100,+ORID,4.5,NOWID,1)) 119 I NOWVAL=1 S ORY=0 Q 120 Q 121 ORCPLX(ORY,ORID,ORACT) ;Return children orders of the complex order 122 Q:'$D(^OR(100,+ORID,0)) 123 N PKG,LACT,OELACT,ISNOW 124 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 125 S PKG=$$NMSP^ORCD(PKG) 126 I PKG'="PS" Q 127 N CHLDCNT,IDX,X3 128 S (CHLDCNT,IDX)=0 129 S:$L($G(^OR(100,+ORID,2,0))) CHLDCNT=$P(^(0),U,4) 130 I 'CHLDCNT Q 131 F S IDX=$O(^OR(100,+ORID,2,IDX)) Q:'IDX D 132 . S (LACT,OELACT,ISNOW)=0 133 . D ISNOW(.ISNOW,IDX) 134 . Q:ISNOW 135 . S X3=$G(^OR(100,IDX,3)) 136 . S LACT=$P(X3,U,7) 137 . F S OELACT=$O(^OR(100,IDX,8,OELACT),-1) Q:OELACT 138 . S:OELACT>LACT LACT=OELACT 139 . S ORY(IDX)=IDX_";"_LACT 140 Q 141 CANRN(ORY,ORID) ; Check conjunction for renew. 142 ; All conjunctioni = "And" return 1 143 ; Has a "Then" return 0 144 Q:'$G(^OR(100,+ORID,0)) 145 N PKG 146 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 147 S PKG=$$NMSP^ORCD(PKG) 148 I PKG'="PS" Q 149 N INDX,INDY,CANRENEW 150 S INDX=0 151 S CANRENEW=1 152 N CHID 153 S CHID=0 F S CHID=$O(^OR(100,+ORID,2,CHID)) Q:'CHID D 154 . N ORSTS,ACTIVE S ORSTS=0 155 . S ORSTS=$P($G(^OR(100,CHID,3)),U,3) 156 . S ACTIVE=$O(^ORD(100.01,"B","ACTIVE",0)) 157 . I ACTIVE'=ORSTS S CANRENEW=0 158 I 'CANRENEW S ORY=CANRENEW Q 159 F S INDX=$O(^OR(100,+ORID,4.5,"ID","CONJ",INDX)) Q:'INDX D 160 . S INDY=0 F S INDY=$O(^OR(100,+ORID,4.5,INDX,INDY)) Q:'INDY D 161 . . I $G(^(INDY))="T" S CANRENEW=0 Q 162 . I CANRENEW=0 Q 163 S ORY=CANRENEW 164 Q 165 ISNOW(ORY,ORID) ; Is first time now order? 166 N SCH 167 Q:'$D(^OR(100,+ORID,0)) 168 S SCH="" 169 S SCH=$O(^OR(100,+ORID,4.5,"ID","SCHEDULE",0)) 170 S:SCH SCH=$G(^OR(100,+ORID,4.5,SCH,1)) 171 S:SCH="NOW" ORY=1 172 Q
Note:
See TracChangeset
for help on using the changeset viewer.
