- 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/ORCSEND1.m
r613 r623 1 ORCSEND1 ;SLC/MKB-Release cont ;11/22/06 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,29,45,61,79,94,116,138,158,149,187,215,243**;Dec 17, 1997;Build 242 3 ; 4 PKGSTUFF(PKG) ; Package code 5 S PKG=$$GET1^DIQ(9.4,+PKG_",",1) Q:'$L(PKG) 6 D:$L($T(@PKG)) @PKG 7 Q 8 LR ; Spawn child orders if continuous schedule 9 N ORSTRT,ORPARENT,OR0,ORNP,ORDIALOG,ORL,ORX,ORTIME,ORPITEM,ORPSAMP,ORPSPEC,ORPURG,ORPCOMM,ORPTYPE,ORPCOLL,ORS1,ORS2,P,ORCHLD,ORDG,ORLAST,ORDUZ,ORLOG,ORCOLLCT,STS 10 S ORPARENT=+ORIFN,OR0=$G(^OR(100,ORIFN,0)),ORL=$P(OR0,U,10) 11 D SCHEDULE(ORIFN,"LR",.ORSTRT) I ORSTRT'>1 D Q 12 . N START S START=$O(ORSTRT(0)) Q:START=$P($G(^OR(100,+ORIFN,0)),U,8) 13 . D DATES^ORCSAVE2(+ORIFN,START) ;update start date from schedule 14 S ORNP=+$P(OR0,U,4),ORDIALOG=+$P(OR0,U,5),ORDUZ=+$P(OR0,U,6),ORLOG=$P(OR0,U,7),ORDG=+$P(OR0,U,11) 15 D GETDLG1^ORCD(ORDIALOG),GETORDER(ORIFN),GETIMES^ORCDLR1 16 K ORDIALOG($$PTR^ORCD("OR GTX ADMIN SCHEDULE"),1),ORDIALOG($$PTR^ORCD("OR GTX DURATION"),1) 17 S ORPITEM=$$PTR^ORCD("OR GTX ORDERABLE ITEM") 18 S ORPSAMP=$$PTR^ORCD("OR GTX COLLECTION SAMPLE") 19 S ORPSPEC=$$PTR^ORCD("OR GTX SPECIMEN") 20 S ORPURG=$$PTR^ORCD("OR GTX LAB URGENCY") 21 S ORPCOMM=$$PTR^ORCD("OR GTX WORD PROCESSING 1") 22 S ORPTYPE=$$PTR^ORCD("OR GTX COLLECTION TYPE") 23 S ORPCOLL=$$PTR^ORCD("OR GTX START DATE/TIME") 24 LR1 S ORS1=0 F S ORS1=$O(ORX(ORS1)) Q:ORS1'>0 D 25 . F P=ORPITEM,ORPSAMP,ORPSPEC,ORPURG,ORPCOMM,ORPTYPE S ORDIALOG(P,1)=$G(ORX(ORS1,P)) ;set values to next instance 26 . S ORCOLLCT=$G(ORDIALOG(ORPTYPE,1)) 27 . S ORS2=0 F S ORS2=$O(ORSTRT(ORS2)) Q:ORS2'>0 D 28 .. S ORDIALOG(ORPCOLL,1)=ORS2 ;,ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12) 29 .. I ORCOLLCT="LC" S ORDIALOG(ORPTYPE,1)=$S($$LABCOLL^ORCDLR1(ORS2):"LC",1:"WC") 30 .. I ORCOLLCT="I" S ORDIALOG(ORPTYPE,1)=$S($$IMMCOLL^ORCDLR1(ORS2):"I",1:"WC") 31 .. D CHILD^ORCSEND3() 32 S:$G(ORCHLD) ^OR(100,ORPARENT,2,0)="^100.002PA^"_ORLAST_U_ORCHLD 33 S ORIFN=ORPARENT,ORQUIT=1,STS=$P(^OR(100,ORIFN,3),U,3) 34 I (STS=1)!(STS=13)!(STS=11) S ORERR="1^Unable to release orders" 35 D RELEASE^ORCSAVE2(ORPARENT,1,ORNOW,DUZ,$G(NATURE)) 36 Q 37 SCHEDULE(IFN,PKG,ORY,STRT) ; Returns list of start time(s) from schedule 38 N I,X,PSJSD,PSJFD,PSJW,PSJNE,PSJPP,PSJX,PSJAT,PSJM,PSJTS,PSJY,PSJAX,PSJSCH,PSJOSD,PSJOFD,PSJC,ORDUR 39 S PSJSD=$S(+$G(STRT):STRT,1:$P($G(^OR(100,+IFN,0)),U,8)) I 'PSJSD S ORY=-1 Q 40 S ORY=1,ORY(PSJSD)="" ;1st occurrance 41 S I=$O(^OR(100,+IFN,4.5,"ID","SCHEDULE",0)) Q:'I Q:'$L($G(PKG)) 42 S X=$G(^OR(100,+IFN,4.5,I,1)),PSJX=$S(X:$$GET1^DIQ(51.1,+X_",",.01),1:X) 43 S PSJW=+$G(ORL),PSJNE="",PSJPP=PKG D ENSV^PSJEEU Q:'$L($G(PSJX)) 44 I $G(PSJTS)'="C",$G(PSJTS)'="D" Q ;not continuous or day-of-week 45 S PSJSCH=PSJX,I=$O(^OR(100,+IFN,4.5,"ID","DAYS",0)) Q:'I 46 S ORDUR=$G(^OR(100,+IFN,4.5,+I,1)) 47 S:ORDUR PSJFD=$$FMADD^XLFDT(PSJSD,+ORDUR,,-1) 48 I 'ORDUR S X=+$E(ORDUR,2,9) D 49 . I PSJM S PSJFD=$$FMADD^XLFDT(PSJSD,,,(PSJM*X)-1) ;X_#times 50 . E D ;no freq in minutes --> day of week 51 .. N DAYS,LOCMX,SCHMX 52 .. S LOCMX=$$GET^XPAR("ALL^LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q") 53 .. K ^TMP($J,"ORCSEND1 SCHEDULE") 54 .. D ZERO^PSS51P1(PSJY,,,,"ORCSEND1 SCHEDULE") 55 .. S SCHMX=+$G(^TMP($J,"ORCSEND1 SCHEDULE",PSJY,2.5)) 56 .. K ^TMP($J,"ORCSEND1 SCHEDULE") 57 .. ;S SCHMX=$P(^PS(51.1,PSJY,0),U,7) 58 .. S DAYS=$S('SCHMX:LOCMX,LOCMX<SCHMX:LOCMX,1:SCHMX) 59 .. S PSJFD=$$FMADD^XLFDT(PSJSD,DAYS,,-1) 60 D ENSPU^PSJEEU K ORY 61 I ORDUR M ORY=PSJC Q 62 S ORY=$S(PSJC<$E(ORDUR,2,9):PSJC,1:$E(ORDUR,2,9)) 63 N NXT 64 S NXT=0 F I=1:1:ORY S NXT=$O(PSJC(NXT)) Q:'NXT S ORY(NXT)=PSJC(NXT) 65 Q 66 GETORDER(IFN) ; Set ORX(Inst,Ptr)=Value 67 N I,X,Y,PTR,INST,TYPE 68 S I=0 F S I=$O(^OR(100,IFN,4.5,I)) Q:I'>0 S X=$G(^(I,0)),Y=$G(^(1)) D 69 . S PTR=+$P(X,U,2),INST=+$P(X,U,3),TYPE=$P($G(^ORD(101.41,PTR,1)),U) 70 . I TYPE'="W" S ORX(INST,PTR)=Y Q 71 . S ORX(INST,PTR)="^OR(100,"_IFN_",4.5,"_I_",2)" 72 Q 73 PTR(X) ; Returns ptr of prompt X in Order Dialog file 74 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0)) 75 PS ; spawn child orders if multiple doses 76 PSJ ; (Inpt only) 77 PSS ; 78 N ORPARENT,OR0,ORNP,ORDIALOG,ORDUZ,ORLOG,ORL,ORDG,ORCAT,ORX,ORP,ORI,STS 79 N ORDOSE,ORT,ORSCH,ORDUR,ORSTRT,ORFRST,ORCONJ,ORID,ORDD,ORSTR,ORDGNM 80 N ORSTART,ORCHLD,ORLAST,ORSIG,OROI,ID,OR3,ORIG,CODE,ORPKG,ORENEW,I,ORADMIN 81 S ORPARENT=+ORIFN,OR0=$G(^OR(100,ORPARENT,0)),OR3=$G(^(3)) 82 Q:$P(OR0,U,12)'="I" S ORCAT="I",ORNP=+$P(OR0,U,4) 83 S ORDIALOG=+$P(OR0,U,5),ORDUZ=+$P(OR0,U,6),ORLOG=$P(OR0,U,7) 84 S ORL=$P(OR0,U,10),ORDG=+$P(OR0,U,11),ORPKG=+$P(OR0,U,14) 85 D GETDLG1^ORCD(ORDIALOG),GETORDER(ORPARENT) 86 S ORDOSE=$$PTR("INSTRUCTIONS"),ORT=$$PTR("ROUTE") 87 S ORSCH=$$PTR("SCHEDULE"),ORDUR=$$PTR("DURATION") 88 S ORCONJ=$$PTR("AND/THEN") D STRT S ORSTART=$G(ORSTRT("BEG")) 89 S ORADMIN=$$PTR("ADMIN TIMES") 90 D DATES^ORCSAVE2(ORPARENT,ORSTART) Q:$$DOSES(ORPARENT)'>1 91 S ORFRST=$$PTR("NOW"),ORSIG=$$PTR("SIG") 92 S ORID=$$PTR("DOSE"),ORDD=$$PTR("DISPENSE DRUG") 93 S ORSTR=$$PTR("STRENGTH"),ORDGNM=$$PTR("DRUG NAME") 94 I $P(OR3,U,11)=2,$O(^OR(100,+$P(OR3,U,5),2,0)) D 95 . S ORENEW=+$P(OR3,U,5),I=0 96 . I $$VALUE^ORX8(ORENEW,"NOW") S I=$O(^OR(100,ORENEW,2,0)) 97 . F S I=$O(^OR(100,ORENEW,2,I)) Q:I<1 S ORENEW(I)="" 98 PS1 F ORP="ORDERABLE ITEM","URGENCY","WORD PROCESSING 1" D 99 . N PTR S PTR=$$PTR(ORP) Q:PTR'>0 Q:'$D(ORX(1,PTR)) 100 . S ORDIALOG(PTR,1)=ORX(1,PTR) S:$E(ORP)="O" OROI=ORX(1,PTR) 101 S ORI=$$FRSTDOSE I $G(ORX(1,ORFRST)) D 102 . F ORP=ORDOSE,ORT,ORID S:$D(ORX(ORI,ORP)) ORDIALOG(ORP,1)=ORX(ORI,ORP) 103 . S ID=$G(ORX(ORI,ORID)) S:$P(ID,"&",6) ORDIALOG(ORDD,1)=$P(ID,"&",6) 104 . S ORDIALOG(ORSCH,1)="NOW",ORSTART=$$NOW^XLFDT 105 . D SIG,CHILD^ORCSEND3(ORSTART) 106 F D S ORI=$O(ORX(ORI)) Q:ORI'>0 107 . F ORP=ORDOSE,ORT,ORSCH,ORDUR,ORID,ORADMIN S:$D(ORX(ORI,ORP)) ORDIALOG(ORP,1)=ORX(ORI,ORP) K:'$D(ORX(ORI,ORP)) ORDIALOG(ORP,1) 108 . K ORDIALOG(ORDD,1) S ID=$G(ORX(ORI,ORID)) 109 . S:$P(ID,"&",6) ORDIALOG(ORDD,1)=$P(ID,"&",6) 110 . S ORSTART=$G(ORSTRT(ORI)) 111 . D SIG,CHILD^ORCSEND3(ORSTART) 112 S:$G(ORCHLD) ^OR(100,ORPARENT,2,0)="^100.002PA^"_ORLAST_U_ORCHLD 113 S ORIFN=ORPARENT,ORQUIT=1,OR3=$G(^OR(100,ORIFN,3)),STS=$P(OR3,U,3) 114 I (STS=1)!(STS=13)!(STS=11) S ORERR="1^Unable to release orders" 115 D RELEASE^ORCSAVE2(ORIFN,1,ORNOW,DUZ,$G(NATURE)) K ^TMP("ORWORD",$J) 116 S $P(^OR(100,ORIFN,3),U,8)=1 ;veil parent order - set stop date/time? 117 Q:(STS=1)!(STS=13)!(STS=11) ;unsuccessful 118 PS2 ; ck if parent is unsigned or edit 119 I $P($G(^OR(100,ORIFN,8,1,0)),U,4)=2 S $P(^(0),U,4)="" K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;clear ES 120 Q:$P(OR3,U,11)'=1 S ORIG=$P(OR3,U,5) Q:ORIG'>0 121 S CODE=$S($P($G(^OR(100,ORIG,3)),U,3)=5:"CA",1:"DC") 122 D MSG^ORMBLD(ORIG,CODE) I "^1^13^"[(U_$P($G(^OR(100,ORIG,3)),U,3)_U) D 123 . N NATR S NATR=+$O(^ORD(100.02,"C","C",0)) 124 . S $P(^OR(100,ORIG,3),U,3)=12,$P(^(3),U,7)=0,^(6)=NATR_U_DUZ_U_ORNOW 125 . D CANCEL^ORCSEND(ORIG) ;ck for unrel actions 126 Q 127 DOSES(IFN) ; count number of doses in order 128 N I,CNT S CNT=0 129 S I=0 F S I=$O(^OR(100,+$G(IFN),4.5,"ID","INSTR",I)) Q:I'>0 I $L($G(^OR(100,+$G(IFN),4.5,I,1))) S CNT=CNT+1 130 S I=+$O(^OR(100,+$G(IFN),4.5,"ID","NOW",0)) I I,$G(^OR(100,+$G(IFN),4.5,I,1)) S CNT=CNT+1 131 Q CNT 132 FRSTDOSE() ; Return instance of first dose 133 N I,Y S I=0,Y=1 134 F S I=$O(ORX(I)) Q:I'>0 I $D(ORX(I,ORDOSE)) S Y=I Q 135 Q Y 136 SIG ; Build text of instructions 137 N ORDRUG,ID,DOSE,ORI,ORX K ^TMP("ORWORD",$J,ORSIG,1) 138 S ORDRUG=$G(ORDIALOG(ORDD,1)),ID=$G(ORDIALOG(ORID,1)) 139 S DOSE=$G(ORDIALOG(ORDOSE,1)),ORI=1 140 S ORX=$$DOSE^ORCDPS2_$$RTE^ORCDPS2_$$SCH^ORCDPS2_$$DUR^ORCDPS2 141 S ^TMP("ORWORD",$J,ORSIG,1,0)="^^1^1^"_DT_U,^(1,0)=ORX 142 S ORDIALOG(ORSIG,1)=$NA(^TMP("ORWORD",$J,ORSIG,1)) 143 S ORDIALOG(ORDOSE,"FORMAT")="@" 144 K ORDIALOG(ORSTR,1),ORDIALOG(ORDGNM,1) 145 I ORDRUG,'ID D ;set strength or drug name 146 . N STR,ITM S STR=$P(ID,"&",7)_$P(ID,"&",8) 147 . I STR'>0 S ORDIALOG(ORDGNM,1)=$$GET1^DIQ(50,+ORDRUG_",",.01) Q 148 . S ITM=$P($G(^ORD(101.43,+$G(OROI),0)),U) 149 . S:ITM'[STR ORDIALOG(ORSTR,1)=STR 150 Q 151 STRT ; Build ORSTRT(inst)=date.time array of start times by dose 152 N OI,PSOI,XD,XH,XM,XS,ORWD,ORI,SCH,ORSD,X,ORD K ORSTRT 153 S OI=$G(ORX(1,$$PTR^ORCD("OR GTX ORDERABLE ITEM"))) 154 S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2),(XD,XH,XM,XS)=0 155 S ORWD=+$G(^SC(+$G(ORL),42)) ;ward 156 S ORI=0 F S ORI=$O(ORX(ORI)) Q:ORI<1 D 157 . S SCH=$G(ORX(ORI,ORSCH)),ORSD="" S:'$L(SCH) X=$$NOW^XLFDT 158 . S:$L(SCH) ORSD=$$STARTSTP^PSJORPOE(+ORVP,SCH,PSOI,ORWD),X=$P(ORSD,U,4) 159 . S ORSTRT(ORI)=$$FMADD^XLFDT(X,XD,XH,XM,XS) ;START+OFFSET 160 . ; update OFFSET for next THEN dose 161 . D DUR(ORI) I $G(ORX(ORI,ORCONJ))="T" D 162 .. I $G(ORD("XD"))<1,$G(ORD("XH"))<1,$G(ORD("XM"))<1,$G(ORD("XS"))<1 S ORD("XD")=+$P(ORSD,U,3) ;default duration 163 .. N I,Y F I="XD","XH","XM","XS" S Y=@I,@I=Y+$G(ORD(I)) 164 .. K ORD 165 ; find beginning date.time for parent 166 S ORI=0,X=9999999 F S ORI=$O(ORSTRT(ORI)) Q:ORI<1 I ORSTRT(ORI)<X S X=ORSTRT(ORI) 167 S ORSTRT("BEG")=X 168 Q 169 DUR(I) ; Accumulate duration in ORD("Xt") for offsetting next THEN dose 170 N X,Y S X=$$FMDUR^ORCDPS3($G(ORX(I,ORDUR))) 171 I X["S",+X>$G(ORD("XS")) S ORD("XS")=+X 172 I X["'",+X>$G(ORD("XM")) S ORD("XM")=+X 173 I X["H",+X>$G(ORD("XH")) S ORD("XH")=+X 174 S Y=$S(X["D":+X,X["W":+X*7,X["M":+X*30,1:0) 175 I Y,Y>$G(ORD("XD")) S ORD("XD")=Y 176 Q 177 VBEC ; Spawn VBECS children 178 D:$L($T(EN^ORCSEND2)) EN^ORCSEND2 179 Q 1 ORCSEND1 ;SLC/MKB-Release cont ;11/25/02 09:48 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,29,45,61,79,94,116,138,158,149,187,215**;Dec 17, 1997 3 ; 4 PKGSTUFF(PKG) ; Package code 5 S PKG=$$GET1^DIQ(9.4,+PKG_",",1) Q:'$L(PKG) 6 D:$L($T(@PKG)) @PKG 7 Q 8 LR ; Spawn child orders if continuous schedule 9 N ORSTRT,ORPARENT,OR0,ORNP,ORDIALOG,ORL,ORX,ORTIME,ORPITEM,ORPSAMP,ORPSPEC,ORPURG,ORPCOMM,ORPTYPE,ORPCOLL,ORS1,ORS2,P,ORCHLD,ORDG,ORLAST,ORDUZ,ORLOG,ORCOLLCT,STS 10 S ORPARENT=+ORIFN,OR0=$G(^OR(100,ORIFN,0)),ORL=$P(OR0,U,10) 11 D SCHEDULE(ORIFN,"LR",.ORSTRT) I ORSTRT'>1 D Q 12 . N START S START=$O(ORSTRT(0)) Q:START=$P($G(^OR(100,+ORIFN,0)),U,8) 13 . D DATES^ORCSAVE2(+ORIFN,START) ;update start date from schedule 14 S ORNP=+$P(OR0,U,4),ORDIALOG=+$P(OR0,U,5),ORDUZ=+$P(OR0,U,6),ORLOG=$P(OR0,U,7),ORDG=+$P(OR0,U,11) 15 D GETDLG1^ORCD(ORDIALOG),GETORDER(ORIFN),GETIMES^ORCDLR1 16 K ORDIALOG($$PTR^ORCD("OR GTX ADMIN SCHEDULE"),1),ORDIALOG($$PTR^ORCD("OR GTX DURATION"),1) 17 S ORPITEM=$$PTR^ORCD("OR GTX ORDERABLE ITEM") 18 S ORPSAMP=$$PTR^ORCD("OR GTX COLLECTION SAMPLE") 19 S ORPSPEC=$$PTR^ORCD("OR GTX SPECIMEN") 20 S ORPURG=$$PTR^ORCD("OR GTX LAB URGENCY") 21 S ORPCOMM=$$PTR^ORCD("OR GTX WORD PROCESSING 1") 22 S ORPTYPE=$$PTR^ORCD("OR GTX COLLECTION TYPE") 23 S ORPCOLL=$$PTR^ORCD("OR GTX START DATE/TIME") 24 LR1 S ORS1=0 F S ORS1=$O(ORX(ORS1)) Q:ORS1'>0 D 25 . F P=ORPITEM,ORPSAMP,ORPSPEC,ORPURG,ORPCOMM,ORPTYPE S ORDIALOG(P,1)=$G(ORX(ORS1,P)) ;set values to next instance 26 . S ORCOLLCT=$G(ORDIALOG(ORPTYPE,1)) 27 . S ORS2=0 F S ORS2=$O(ORSTRT(ORS2)) Q:ORS2'>0 D 28 .. S ORDIALOG(ORPCOLL,1)=ORS2 ;,ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12) 29 .. I ORCOLLCT="LC" S ORDIALOG(ORPTYPE,1)=$S($$LABCOLL^ORCDLR1(ORS2):"LC",1:"WC") 30 .. I ORCOLLCT="I" S ORDIALOG(ORPTYPE,1)=$S($$IMMCOLL^ORCDLR1(ORS2):"I",1:"WC") 31 .. D CHILD() 32 S:$G(ORCHLD) ^OR(100,ORPARENT,2,0)="^100.002PA^"_ORLAST_U_ORCHLD 33 S ORIFN=ORPARENT,ORQUIT=1,STS=$P(^OR(100,ORIFN,3),U,3) 34 I (STS=1)!(STS=13)!(STS=11) S ORERR="1^Unable to release orders" 35 D RELEASE^ORCSAVE2(ORPARENT,1,ORNOW,DUZ,$G(NATURE)) 36 Q 37 SCHEDULE(IFN,PKG,ORY,STRT) ; Returns list of start time(s) from schedule 38 N I,X,PSJSD,PSJFD,PSJW,PSJNE,PSJPP,PSJX,PSJAT,PSJM,PSJTS,PSJY,PSJAX,PSJSCH,PSJOSD,PSJOFD,PSJC,ORDUR 39 S PSJSD=$S(+$G(STRT):STRT,1:$P($G(^OR(100,+IFN,0)),U,8)) I 'PSJSD S ORY=-1 Q 40 S ORY=1,ORY(PSJSD)="" ;1st occurrance 41 S I=$O(^OR(100,+IFN,4.5,"ID","SCHEDULE",0)) Q:'I Q:'$L($G(PKG)) 42 S X=$G(^OR(100,+IFN,4.5,I,1)),PSJX=$S(X:$$GET1^DIQ(51.1,+X_",",.01),1:X) 43 S PSJW=+$G(ORL),PSJNE="",PSJPP=PKG D ENSV^PSJEEU Q:'$L($G(PSJX)) 44 I $G(PSJTS)'="C",$G(PSJTS)'="D" Q ;not continuous or day-of-week 45 S PSJSCH=PSJX,I=$O(^OR(100,+IFN,4.5,"ID","DAYS",0)) Q:'I 46 S ORDUR=$G(^OR(100,+IFN,4.5,+I,1)) 47 S:ORDUR PSJFD=$$FMADD^XLFDT(PSJSD,+ORDUR,,-1) 48 I 'ORDUR S X=+$E(ORDUR,2,9) D 49 . I PSJM S PSJFD=$$FMADD^XLFDT(PSJSD,,,(PSJM*X)-1) ;X_#times 50 . E D ;no freq in minutes --> day of week 51 .. N DAYS,LOCMX,SCHMX 52 .. S LOCMX=$$GET^XPAR("ALL^LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q") 53 .. S SCHMX=$P(^PS(51.1,PSJY,0),U,7) 54 .. S DAYS=$S('SCHMX:LOCMX,LOCMX<SCHMX:LOCMX,1:SCHMX) 55 .. S PSJFD=$$FMADD^XLFDT(PSJSD,DAYS,,-1) 56 D ENSPU^PSJEEU K ORY 57 I ORDUR M ORY=PSJC Q 58 S ORY=$S(PSJC<$E(ORDUR,2,9):PSJC,1:$E(ORDUR,2,9)) 59 N NXT 60 S NXT=0 F I=1:1:ORY S NXT=$O(PSJC(NXT)) Q:'NXT S ORY(NXT)=PSJC(NXT) 61 Q 62 GETORDER(IFN) ; Set ORX(Inst,Ptr)=Value 63 N I,X,Y,PTR,INST,TYPE 64 S I=0 F S I=$O(^OR(100,IFN,4.5,I)) Q:I'>0 S X=$G(^(I,0)),Y=$G(^(1)) D 65 . S PTR=+$P(X,U,2),INST=+$P(X,U,3),TYPE=$P($G(^ORD(101.41,PTR,1)),U) 66 . I TYPE'="W" S ORX(INST,PTR)=Y Q 67 . S ORX(INST,PTR)="^OR(100,"_IFN_",4.5,"_I_",2)" 68 Q 69 PTR(X) ; Returns ptr of prompt X in Order Dialog file 70 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0)) 71 CHILD(STRT) ; Create child order, send to package 72 N ORAPPT 73 K ORIFN D EN^ORCSAVE Q:'$G(ORIFN) D STARTDT^ORCSAVE2(ORIFN) 74 I $G(STRT) D DATES^ORCSAVE2(ORIFN,STRT) 75 S ORCHLD=+$G(ORCHLD)+1,^OR(100,ORPARENT,2,ORIFN,0)=ORIFN,ORLAST=ORIFN 76 S ORAPPT=$P($G(^OR(100,ORPARENT,0)),U,18) 77 S $P(^OR(100,ORIFN,0),U,18)=ORAPPT,$P(^(3),U,9)=ORPARENT 78 I $G(PKG)="LR" S $P(^OR(100,ORIFN,8,1,0),U,4)=8 K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;signature tracked on parent order only, for Labs 79 I $G(PKG)?1"PS".E D 80 . N X0,OLD S X0=$G(^OR(100,ORPARENT,8,1,0)) 81 . I $P(X0,U,4)'=2 D SIGN^ORCSAVE2(ORIFN,+$P(X0,U,5),ORNOW,$P(X0,U,4),1) 82 . I $D(^OR(100,ORPARENT,9)) M ^OR(100,ORIFN,9)=^OR(100,ORPARENT,9) 83 . I $G(ORENEW) S OLD=$O(ORENEW(0)) I OLD S $P(^OR(100,OLD,3),U,6)=ORIFN,$P(^OR(100,ORIFN,3),U,5)=OLD,$P(^(3),U,11)=2 K ORENEW(OLD) 84 D RELEASE^ORCSAVE2(ORIFN,1,ORNOW,DUZ,$G(NATURE)),NEW^ORMBLD(ORIFN) 85 Q 86 PS ; spawn child orders if multiple doses 87 PSJ ; (Inpt only) 88 PSS ; 89 N ORPARENT,OR0,ORNP,ORDIALOG,ORDUZ,ORLOG,ORL,ORDG,ORCAT,ORX,ORP,ORI,STS 90 N ORDOSE,ORT,ORSCH,ORDUR,ORSTRT,ORFRST,ORCONJ,ORID,ORDD,ORSTR,ORDGNM 91 N ORSTART,ORCHLD,ORLAST,ORSIG,OROI,ID,OR3,ORIG,CODE,ORPKG,ORENEW,I 92 S ORPARENT=+ORIFN,OR0=$G(^OR(100,ORPARENT,0)),OR3=$G(^(3)) 93 Q:$P(OR0,U,12)'="I" S ORCAT="I",ORNP=+$P(OR0,U,4) 94 S ORDIALOG=+$P(OR0,U,5),ORDUZ=+$P(OR0,U,6),ORLOG=$P(OR0,U,7) 95 S ORL=$P(OR0,U,10),ORDG=+$P(OR0,U,11),ORPKG=+$P(OR0,U,14) 96 D GETDLG1^ORCD(ORDIALOG),GETORDER(ORPARENT) 97 S ORDOSE=$$PTR("INSTRUCTIONS"),ORT=$$PTR("ROUTE") 98 S ORSCH=$$PTR("SCHEDULE"),ORDUR=$$PTR("DURATION") 99 S ORCONJ=$$PTR("AND/THEN") D STRT S ORSTART=$G(ORSTRT("BEG")) 100 D DATES^ORCSAVE2(ORPARENT,ORSTART) Q:$$DOSES(ORPARENT)'>1 101 S ORFRST=$$PTR("NOW"),ORSIG=$$PTR("SIG") 102 S ORID=$$PTR("DOSE"),ORDD=$$PTR("DISPENSE DRUG") 103 S ORSTR=$$PTR("STRENGTH"),ORDGNM=$$PTR("DRUG NAME") 104 I $P(OR3,U,11)=2,$O(^OR(100,+$P(OR3,U,5),2,0)) D 105 . S ORENEW=+$P(OR3,U,5),I=0 106 . I $$VALUE^ORX8(ORENEW,"NOW") S I=$O(^OR(100,ORENEW,2,0)) 107 . F S I=$O(^OR(100,ORENEW,2,I)) Q:I<1 S ORENEW(I)="" 108 PS1 F ORP="ORDERABLE ITEM","URGENCY","WORD PROCESSING 1" D 109 . N PTR S PTR=$$PTR(ORP) Q:PTR'>0 Q:'$D(ORX(1,PTR)) 110 . S ORDIALOG(PTR,1)=ORX(1,PTR) S:$E(ORP)="O" OROI=ORX(1,PTR) 111 S ORI=$$FRSTDOSE I $G(ORX(1,ORFRST)) D 112 . F ORP=ORDOSE,ORT,ORID S:$D(ORX(ORI,ORP)) ORDIALOG(ORP,1)=ORX(ORI,ORP) 113 . S ID=$G(ORX(ORI,ORID)) S:$P(ID,"&",6) ORDIALOG(ORDD,1)=$P(ID,"&",6) 114 . S ORDIALOG(ORSCH,1)="NOW",ORSTART=$$NOW^XLFDT 115 . D SIG,CHILD(ORSTART) 116 F D S ORI=$O(ORX(ORI)) Q:ORI'>0 117 . F ORP=ORDOSE,ORT,ORSCH,ORDUR,ORID S:$D(ORX(ORI,ORP)) ORDIALOG(ORP,1)=ORX(ORI,ORP) K:'$D(ORX(ORI,ORP)) ORDIALOG(ORP,1) 118 . K ORDIALOG(ORDD,1) S ID=$G(ORX(ORI,ORID)) 119 . S:$P(ID,"&",6) ORDIALOG(ORDD,1)=$P(ID,"&",6) 120 . S ORSTART=$G(ORSTRT(ORI)) 121 . D SIG,CHILD(ORSTART) 122 S:$G(ORCHLD) ^OR(100,ORPARENT,2,0)="^100.002PA^"_ORLAST_U_ORCHLD 123 S ORIFN=ORPARENT,ORQUIT=1,OR3=$G(^OR(100,ORIFN,3)),STS=$P(OR3,U,3) 124 I (STS=1)!(STS=13)!(STS=11) S ORERR="1^Unable to release orders" 125 D RELEASE^ORCSAVE2(ORIFN,1,ORNOW,DUZ,$G(NATURE)) K ^TMP("ORWORD",$J) 126 S $P(^OR(100,ORIFN,3),U,8)=1 ;veil parent order - set stop date/time? 127 Q:(STS=1)!(STS=13)!(STS=11) ;unsuccessful 128 PS2 ; ck if parent is unsigned or edit 129 I $P($G(^OR(100,ORIFN,8,1,0)),U,4)=2 S $P(^(0),U,4)="" K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;clear ES 130 Q:$P(OR3,U,11)'=1 S ORIG=$P(OR3,U,5) Q:ORIG'>0 131 S CODE=$S($P($G(^OR(100,ORIG,3)),U,3)=5:"CA",1:"DC") 132 D MSG^ORMBLD(ORIG,CODE) I "^1^13^"[(U_$P($G(^OR(100,ORIG,3)),U,3)_U) D 133 . N NATR S NATR=+$O(^ORD(100.02,"C","C",0)) 134 . S $P(^OR(100,ORIG,3),U,3)=12,$P(^(3),U,7)=0,^(6)=NATR_U_DUZ_U_ORNOW 135 . D CANCEL^ORCSEND(ORIG) ;ck for unrel actions 136 Q 137 DOSES(IFN) ; count number of doses in order 138 N I,CNT S CNT=0 139 S I=0 F S I=$O(^OR(100,+$G(IFN),4.5,"ID","INSTR",I)) Q:I'>0 I $L($G(^OR(100,+$G(IFN),4.5,I,1))) S CNT=CNT+1 140 S I=+$O(^OR(100,+$G(IFN),4.5,"ID","NOW",0)) I I,$G(^OR(100,+$G(IFN),4.5,I,1)) S CNT=CNT+1 141 Q CNT 142 FRSTDOSE() ; Return instance of first dose 143 N I,Y S I=0,Y=1 144 F S I=$O(ORX(I)) Q:I'>0 I $D(ORX(I,ORDOSE)) S Y=I Q 145 Q Y 146 SIG ; Build text of instructions 147 N ORDRUG,ID,DOSE,ORI,ORX K ^TMP("ORWORD",$J,ORSIG,1) 148 S ORDRUG=$G(ORDIALOG(ORDD,1)),ID=$G(ORDIALOG(ORID,1)) 149 S DOSE=$G(ORDIALOG(ORDOSE,1)),ORI=1 150 S ORX=$$DOSE^ORCDPS2_$$RTE^ORCDPS2_$$SCH^ORCDPS2_$$DUR^ORCDPS2 151 S ^TMP("ORWORD",$J,ORSIG,1,0)="^^1^1^"_DT_U,^(1,0)=ORX 152 S ORDIALOG(ORSIG,1)=$NA(^TMP("ORWORD",$J,ORSIG,1)) 153 S ORDIALOG(ORDOSE,"FORMAT")="@" 154 K ORDIALOG(ORSTR,1),ORDIALOG(ORDGNM,1) 155 I ORDRUG,'ID D ;set strength or drug name 156 . N STR,ITM S STR=$P(ID,"&",7)_$P(ID,"&",8) 157 . I STR'>0 S ORDIALOG(ORDGNM,1)=$$GET1^DIQ(50,+ORDRUG_",",.01) Q 158 . S ITM=$P($G(^ORD(101.43,+$G(OROI),0)),U) 159 . S:ITM'[STR ORDIALOG(ORSTR,1)=STR 160 Q 161 STRT ; Build ORSTRT(inst)=date.time array of start times by dose 162 N OI,PSOI,XD,XH,XM,XS,ORWD,ORI,SCH,ORSD,X,ORD K ORSTRT 163 S OI=$G(ORX(1,$$PTR^ORCD("OR GTX ORDERABLE ITEM"))) 164 S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2),(XD,XH,XM,XS)=0 165 S ORWD=+$G(^SC(+$G(ORL),42)) ;ward 166 S ORI=0 F S ORI=$O(ORX(ORI)) Q:ORI<1 D 167 . S SCH=$G(ORX(ORI,ORSCH)),ORSD="" S:'$L(SCH) X=$$NOW^XLFDT 168 . S:$L(SCH) ORSD=$$STARTSTP^PSJORPOE(+ORVP,SCH,PSOI,ORWD),X=$P(ORSD,U,4) 169 . S ORSTRT(ORI)=$$FMADD^XLFDT(X,XD,XH,XM,XS) ;START+OFFSET 170 . ; update OFFSET for next THEN dose 171 . D DUR(ORI) I $G(ORX(ORI,ORCONJ))="T" D 172 .. I $G(ORD("XD"))<1,$G(ORD("XH"))<1,$G(ORD("XM"))<1,$G(ORD("XS"))<1 S ORD("XD")=+$P(ORSD,U,3) ;default duration 173 .. N I,Y F I="XD","XH","XM","XS" S Y=@I,@I=Y+$G(ORD(I)) 174 .. K ORD 175 ; find beginning date.time for parent 176 S ORI=0,X=9999999 F S ORI=$O(ORSTRT(ORI)) Q:ORI<1 I ORSTRT(ORI)<X S X=ORSTRT(ORI) 177 S ORSTRT("BEG")=X 178 Q 179 DUR(I) ; Accumulate duration in ORD("Xt") for offsetting next THEN dose 180 N X,Y S X=$$FMDUR^ORCDPS3($G(ORX(I,ORDUR))) 181 I X["S",+X>$G(ORD("XS")) S ORD("XS")=+X 182 I X["'",+X>$G(ORD("XM")) S ORD("XM")=+X 183 I X["H",+X>$G(ORD("XH")) S ORD("XH")=+X 184 S Y=$S(X["D":+X,X["W":+X*7,X["M":+X*30,1:0) 185 I Y,Y>$G(ORD("XD")) S ORD("XD")=Y 186 Q 187 VBEC ; Spawn VBECS children 188 D:$L($T(EN^ORCSEND2)) EN^ORCSEND2 189 Q
Note:
See TracChangeset
for help on using the changeset viewer.
