- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVCAL.m
r613 r623 1 PSIVCAL ;BIR/RGY,PR-CALCULATES START AND STOP DATES ;12 Mar 99 / 12:42 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**4,26,41,47,63,67,69,58,94,80,110,111,177,120,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^PS(50.7 is supported by DBIA #2180. 5 ; Reference to ^PS(52.6 is supported by DBIA #1231. 6 ; Reference to ^PS(55 is supported by DBIA #2191. 7 ; 8 ENT ;NEEDS PSIVTYPE (P(4)) 9 I $G(PSJREN) D Q:P(2) 10 . I $G(P("OLDON")) N P2 S P2=$G(@("^PS(55,"_DFN_",""IV"","_+P("OLDON")_",0)")),P2=$P(P2,"^",2) I P2 S P(2)=P2 11 I $G(PSJORD)["P",$G(P("APPT"))?7N1"."1.N S START=$$DATE2^PSJUTL2(P("APPT")) G Q 12 I $G(PSJSYSW0)=""!($P(PSJSYSW0,U,5)=2) S START=+$E(P("LOG"),1,12) G Q 13 S PSIVSN=+P("IVRM"),START="",PSIVTYPE=$G(P(4)) Q:PSIVTYPE="" 14 N PSIV X $S($E(PSIVAC)="C":"S X=+$E(P(""LOG""),1,12) D H^%DTC S PSIV=%T",1:"S PSIV=$P($H,"","",2)") G T2:PSIVTYPE'["P"&('P(5)) 15 I P(11)']"" X $S($E(PSIVAC)="C":"S Y=+$E(P(""LOG""),1,12)",1:"D NOW^%DTC S Y=%") S Y=Y+.007\.01/100 S:'$P(Y,".",2) Y=$$MDNGHT(Y) X ^DD("DD") S START=Y G Q 16 S X=P(11) D CHK S PX=Y,X1=PSIV\3600,X2=PSIV#3600\60,X=$E(".0",1,$L(X1)#2+1)_X1_$E("0",X2<10)_X2,START=$S($E(PSIVAC)="C":$P(P("LOG"),"."),1:"T") 17 S X1=$P(PX,"-"),X1=$E(".0",1,$L(X1)#2+1)_X1,X2=$P(PX,"-",PSGCNT),X2=$E(".0",1,$L(X2)#2+1)_X2 18 S NAT=+$P($G(^PS(59.6,+$O(^PS(59.6,"B",+VAIN(4),0)),0)),U,5) 19 I '$D(PSGDT) S PSGDT=$$DATE^PSJUTL2() 20 I X<X1,'NAT S START=$$ENSD^PSGNE3(P(9),P(11),+$E(P("LOG"),1,12),PSGDT) G Q 21 I X>X2 S START=$$ENSD^PSGNE3(P(9),P(11),+$E(P("LOG"),1,12),PSGDT) G Q 22 T6 F I=2:1:PSGCNT S X1="."_$P(PX,"-",I-1),X2="."_$P(PX,"-",I) Q:+X1<X&(+X2>X) 23 S X1=X-X1,X2=$S(NAT:0,1:X2-X),START=$S(X1<X2:$P(PX,"-",I-1),1:$P(PX,"-",I)) S:START="" START=$P(PX,"-") X $S($E(PSIVAC)="C":"S Y=$P(P(""LOG""),""."") X ^DD(""DD"") S PSIV=Y",1:"S PSIV=""TODAY""") S START=PSIV_"@"_$E("0",$L(START)=3)_START G Q 24 T2 S X=+("."_$E(10000+(PSIV\3600*100)+(PSIV#3600\60),2,5)),START=$O(^PS(59.5,PSIVSN,3,"AT",X)) S:'START START=$O(^(0)),PSIVTOM=1 I 'START S START=X K PSIVTOM 25 S START=$S($E(PSIVAC)="C":$P(P("LOG"),"."),1:DT)_START I $D(PSIVTOM) S X1=$S($E(PSIVAC)="C":$P(P("LOG"),"."),1:DT),X2=1 D C^%DTC S Y=$P(X,".")_START K PSIVTOM 26 S X=START,%DT="XRTX" D ^%DT 27 Q ; 28 I START["@" S X=START,%DT="RTX" D ^%DT S START=+Y 29 S P(2)=START 30 I $G(PSJORD)["P" D:'$G(PSGRDTX(+PSJORD,"PSGSD")) REQDT^PSJLIVMD(PSJORD) S START=$G(PSGRDTX(+PSJORD,"PSGSD")) S P(2)=$S(START:START,1:P(2)) 31 K NAT,START,PSIVTYPE,PSIVSTRT,PSGCNT,X1,X2,PX 32 Q 33 CHK F Y=1:1 Q:$L(X)>240!($P(X,"-",Y)="") S $P(X,"-",Y)=$P(X,"-",Y)_$E("0000",1,4-$L($P(X,"-",Y))) 34 S Y=X,PSGCNT=$L(X,"-") S:X]""&(PSGCNT<1) PSGCNT=1 Q 35 ; 36 ENSTOP ; WILL CALCULATE STOP DATE FOR ORDER 37 ;NEEDS (DFN) & ON 38 N WALL,P3,ADX,DDLX,OIX,DRGT,PSIDAY,PSIMIN,LIMDAY S (WALL,P3,PSIDAY,PSIMIN)=0 39 D:'$G(PSIVSITE) ^PSIVSET Q:'P(2) 40 I P(23)'="" S PSIVTYPE="C" 41 S STOP="",X="",PSIVSTRT=P(2),PSIVTYPE=$G(P(4)) I $G(PSJREN) D 42 . N RDT I $G(ON)["P" S RDT=+$$LASTREN^PSJLMPRI(DFN,ON) 43 . S PSIVSTRT=$$DATE2^PSJUTL2($S($G(RDT):RDT,1:$G(PSGDT))) 44 ;BHW - PSJ*5*177 - Begin Modifications - Reset Start date to Last Renewed date for active orders that have been renewed 45 I ('$G(PSJREN))&($G(P(4))="A")&($G(ON)["V") D 46 . N RDT S RDT=+$$LASTREN^PSJLMPRI(DFN,ON) 47 . I +RDT S PSIVSTRT=RDT 48 . Q 49 ;BHW - PSJ*5*177 - End Modifications - Resetting PSIVSTRT will recalculate the stop date based on the Last renewed date. 50 ; 51 I $S("^NOW^STAT^ONCE^ONE-TIME^ONE TIME^ONETIME^1TIME^1-TIME^1 TIME^"[(U_P(9)_U):1,1:0),PSIVTYPE="P"!P(5)!(P(23)="P") S X=$$ENOSD^PSJDCU(PSJSYSW0,PSIVSTRT,DFN) I X]"" S:P(11)=""&($G(ON)["P") PSIVCAL=1 G END 52 I '$G(P("OVRIDE")),$G(ON) N DUR,DURMIN,PSJPROV,PSJDNM,A,PSJDAY I $G(ON)["V"!(($G(ON)["P")&($P($G(^PS(53.1,+ON,0)),"^",4)="F")) D 53 . S DUR=$$GETDUR^PSJLIVMD(DFN,+ON,"IV",1) I DUR]"" S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN S PSIMIN=DURMIN 54 I $P(PSIVSITE,"^",5) D 55 . N Z S Y=0 56 . F S Y=$O(^PS(55,DFN,"IV",Y)) Q:'Y S Z=^(Y,0) D Q:X]"" 57 .. I $P(Z,"^",17)="A",$$ONE^PSJBCMA(DFN,Y_"V",$P(Z,"^",9))'="O" S X=$P(Z,"^",3) Q 58 S:$G(X) WALL=X 59 S PSIDAY=$S(PSIVTYPE="A":$P(PSIVSITE,"^",4),PSIVTYPE="H":$P(PSIVSITE,"^",17),PSIVTYPE="P":$P(PSIVSITE,"^",18),PSIVTYPE="S":$P(PSIVSITE,"^",20),1:$P(PSIVSITE,"^",21)) 60 I $G(ON)["P"!($G(ON)["V") I '$G(P("OVRIDE")) N MINS,LIM S PSIVLIM=$$GETLIM(DFN,ON) I $G(PSIVLIM)]"" S MINS=$$GETMIN(PSIVLIM,DFN,ON,.LIMDAY) D 61 .I (MINS&(MINS<PSIMIN))!'PSIMIN S PSIMIN=MINS 62 S PSJDAY="" D I PSJDAY]"",PSJDAY<PSIDAY S PSIDAY=PSJDAY 63 . N A,B,PSJCLIN 64 . Q:'$D(PSJORD) S A="" 65 . I PSJORD["P" S A=$G(^PS(53.1,+PSJORD,"DSS")) 66 . I PSJORD["U" S A=$G(^PS(55,PSGP,5,+PSJORD,8)) 67 . I PSJORD["V" S A=$G(^PS(55,PSGP,"IV",+PSJORD,"DSS")) 68 . S (PSJCLIN,A)=$P(A,"^") Q:A="" S PSJCLIN=$P(^SC(PSJCLIN,0),"^") I $D(^PS(53.46,"B",A)) S B=$O(^PS(53.46,"B",A,"")),PSJDAY=$P(^PS(53.46,B,0),"^",2) 69 F X=0:0 S X=$O(DRG("AD",X)) Q:'X I $P(^PS(52.6,+$P(DRG("AD",+X),U),0),"^",4),($P(^(0),"^",4))<+PSIDAY S PSIDAY=$P(^(0),"^",4) 70 I WALL,($$FMADD^XLFDT(PSIVSTRT,PSIDAY,"D"))>WALL S PSIDAY=$$FMDIFF^XLFDT(WALL,PSIVSTRT,1) S:PSIDAY<1 PSIDAY="" 71 S DRGT=$S($D(DRG("AD")):"AD",1:"SOL") F ADX=0:0 S ADX=$O(DRG(DRGT,ADX)) Q:'ADX!($G(DRGTMP)&($G(DRGTN)["AD")&(DRGT="SOL")) D 72 . S OIX=+$P(DRG(DRGT,ADX),"^",6),DDLX=$P(^PS(50.7,OIX,0),"^",5) Q:'DDLX D DDLIM(.PSIDAY,.P3) 73 I '$G(DRG("AD",0)),$G(DRGTMP),($G(DRGTN)["SOL") S OIX=$P($G(DRGTMP),"^",6) I OIX S DDLX=$P(^PS(50.7,OIX,0),"^",5) I DDLX D DDLIM(.PSIDAY,.P3) 74 I $G(PSIVLIM)["a",'$G(P("OVRIDE")) S DDLX=$P(PSIVLIM,"a",2)_"L" I $G(DDLX) D DDLIM(.PSIDAY,.P3) 75 I $G(P(2)) I P3>P(2) S X=P3 76 S:('PSIDAY&'PSIMIN) PSIDAY=1 77 TIME S X2=PSIDAY,X1=PSIVSTRT D C^%DTC S X=$P(X,"."),X=X_$S($P(PSIVSITE,"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14)) 78 I PSIMIN D 79 . I $G(PSIDAY),((PSIDAY*1440)<PSIMIN) K PSIVLIM,P("LIMIT") S P("OVRIDE")=1 Q 80 . I (PSIMIN<(PSIDAY*1440)!'$G(PSIDAY)) S X=$$FMADD^XLFDT(PSIVSTRT,,,PSIMIN) D 81 .. I '(PSIMIN#1440) S X=$P(X,"."),X=X_$S($P(PSIVSITE,"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14)) 82 END ; 83 S P(3)=+X 84 I $G(PSJORD)["P" D:'$G(PSGRDTX(+PSJORD,"PSGFD")) REQDT^PSJLIVMD(PSJORD) S P(3)=$S($G(PSGRDTX(+PSJORD,"PSGFD")):PSGRDTX(+PSJORD,"PSGFD"),1:P(3)) 85 S P(3)=$$DATE2^PSJUTL2(P(3)),P(2)=$$DATE2^PSJUTL2(P(2)) 86 Q 87 ; 88 ENAD ;Will get last admin. time for order (needs dfn and on) 89 N P4,PSIVX,PSIVY 90 I $P(PSJSYSW0,U,5)=2 S PSIVADM=$$DATE^PSJUTL2() Q 91 I $S($G(PSIVAC)["R":1,P(9)="QOD":1,1:P(9)?1"Q".N1"D") S PSIVADM=$$ENSD^PSGNE3(P(9),P(11),+$E(P("LOG"),1,12),+$P($G(^PS(55,DFN,"IV",+P("OLDON"),0)),U,2)) Q:PSIVADM 92 S PSIVX=X,PSIVY=Y,P4=P(4) S:P(4)="C" P4=P(23) S:P4="S" P4=$S(P(5):"P",1:"A") D NOW^%DTC S Y=%,PSIVNOW=Y I (P4="P"&(P(11)="")&'P(15))!("HA"[P4&'P(15)) S Y=Y+.007\.01/100 G QAD 93 D P:P4="P"&('P(15)),AH:P(15) 94 QAD ; 95 S:'$D(PSGSA) PSGSA="" 96 S PSIVSD=Y I Y S OD=$L(PSGSA," ") I OD>2 S X=+PSGSA\1 F OD1=2:1:OD-1 I $P(PSGSA," ",OD1)'>$S(OD1>2:$P(PSGSA," ",OD1-1),1:PSGSA#1) S X1=X,X2=1 D C^%DTC 97 I PSIVSD,OD>2 S Y=X_PSIVSD 98 S PSIVADM=+Y,X=PSIVX,Y=PSIVY K PSGSA,PSIVSD,OD,OD1,PSIVMI,PSIVNOW S:PSIVADM<P(2) PSIVADM=P(2) Q 99 ; 100 P S CD=PSIVNOW,PSGSA="",(PSIVSD,OD)=DT_.0001,X=P(11) D CHK S P(11)=X D ENP4^PSIVWL 101 I PSGSA="" S PSIVSD=DT_.0001,PSIVMIN=-1440 D ENT^PSIVWL S $P(Y,".",2)=$P(P(11),"-",$L(P(11),"-")) Q 102 S Y=$P(PSGSA," ",$L(PSGSA," ")-1) Q 103 AH F PSIVADM=0:-1 S CD=PSIVNOW,(X,X1)=DT,X2=PSIVADM D:X2 C^%DTC S X=$P(X,".") S (OD1,PSIVSD,OD)=X_.0001,PSIVMIN=P(15) D ENP3^PSIVWL Q:PSIVADM<-4!(PSGSA]"") 104 S Y=$P(PSGSA," ",$L(PSGSA," ")-1) Q 105 MDNGHT(Y) ;Sets Start Date/Time on orders placed between midnight and 12:30 106 S Y=$$FMADD^XLFDT(Y,-1,0,0,0),Y=$P(Y,".")_".24" Q Y 107 ; 108 DDLIM(PSIVDUR,STPDT) ; Day Dose Limit 109 N P3,NEWDAYS,NEWDUR 110 I DDLX["D" D Q:(STPDT=0) 111 .I +DDLX'<+PSIVDUR S STPDT=0 Q 112 .S PSIVDUR=+DDLX,X2=PSIVDUR,X1=PSIVSTRT D C^%DTC S X=$P(X,"."),X=X_$S($P(PSIVSITE,"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14)) I X>P(2) S P(3)=X 113 I DDLX["L",($G(P(9))]""),("AH"'[$G(PSIVTYPE)) S LASTD=$$DOSES(DDLX,.P) I LASTD D 114 .S NEWDUR=$$FMDIFF^XLFDT(LASTD,P(2),2) I NEWDUR>0 S NEWDAYS=(NEWDUR/86400) 115 .I $G(NEWDAYS) I NEWDAYS<PSIVDUR S PSIVDUR=NEWDAYS S P(3)=$$DATE2^PSJUTL2(LASTD) 116 S P(3)=$$DATE2^PSJUTL2(P(3)),P(2)=$$DATE2^PSJUTL2(P(2)) S STPDT=P(3) 117 Q 118 ; 119 GETLIM(DFN,PSJORD) ; Convert IV Limits to minutes (only if in 'time' form). 120 N ND2P5,F 121 S F=$S(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"") 122 S ND2P5=$G(@(F_"2.5)")) S LIM=$P(ND2P5,"^",4) Q:LIM="" 0 123 S ND0=$G(@(F_"0)")) I PSJORD["P",$P(ND0,"^",4)="U" Q 0 124 N MULT S MULT=$S($E(LIM)="h":60,$E(LIM)="d":1440,$E(LIM)="m":LIM,$E(LIM)="l":LIM,$E(LIM)="a":LIM,1:0) I MULT S LIM=MULT*$E(LIM,2,99) 125 Q LIM 126 ; 127 GETMIN(LIM,DFN,PSJORD,DAYS) ; Return the duration of the IV Limit in minutes (includes IV Limits in volume and doses format) 128 S LIM=$$GETMIN^PSIVUTL1(LIM,DFN,PSJORD,.DAYS) 129 Q LIM 130 DOSES(DDLX,PRAY) ; Find stop date when 'doses' are sent as an IV Limit 131 Q:$G(DDLX)'["L" "" 132 I $P(DDLX,"L")["." S DDLX=($P(DDLX,".")+1)_"L" 133 I '$G(PRAY(15)),$G(PRAY(11)) S PRAY(15)=1440/$L(PRAY(11),"-") 134 Q:'$G(PRAY(2))!'$G(OIX) "" 135 N FIRST,DOSAR,LAST,TMP9 S LAST="",TMP9=PRAY(9) 136 S STRING=PRAY(2)_"^"_$S($G(STPDT):STPDT,1:$$FMADD^XLFDT(PSGDT,30))_"^"_PRAY(9)_"^C^"_OIX S FIRST=$$ENQ^PSJORP2(DFN,STRING) 137 S P(9)=TMP9 138 S FIRST=$S($G(FIRST):FIRST,1:PRAY(2)) Q:'FIRST S DSTMP=FIRST,DOSAR(1)=DSTMP D 139 .I '$G(PRAY(11)) F I=2:1:DDLX+1 S DOSAR(I)=$$FMADD^XLFDT(DSTMP,,,PRAY(15)),DSTMP=DOSAR(I) Q 140 .I $G(PRAY(11)) N ADMS,NXT,LAST,DAY S LAST=$P(DSTMP,".",2),DAY=$P(DSTMP,".") D 141 ..F II=1:1:$L(PRAY(11),"-") S ADMS(+$P(PRAY(11),"-",II))=$P(PRAY(11),"-",II) 142 ..F IJ=2:1:DDLX+1 S NXT=$O(ADMS(+LAST)),LAST=NXT D 143 ...I NXT="" S NXT=$O(ADMS(NXT)),LAST=NXT,DAY=$$FMADD^XLFDT(DAY,1) 144 ...S DOSAR(IJ)=DAY_"."_ADMS(NXT),DSTMP=DOSAR(IJ) 145 ..I +DDLX=1 S NXT=$O(ADMS(LAST)),LAST=NXT D 146 ...I NXT="" S NXT=$O(ADMS(NXT)),LAST=NXT 147 I $D(DOSAR) S LAST=$O(DOSAR(""),-1) I LAST S LAST=DOSAR(LAST) 148 Q LAST 1 PSIVCAL ;BIR/RGY,PR-CALCULATES START AND STOP DATES ;12 Mar 99 / 12:42 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**4,26,41,47,63,67,69,58,94,80,110,111,177,120**;16 DEC 97;Build 10 3 ; 4 ; Reference to ^PS(50.7 is supported by DBIA #2180. 5 ; Reference to ^PS(52.6 is supported by DBIA #1231. 6 ; Reference to ^PS(55 is supported by DBIA #2191. 7 ; 8 ENT ;NEEDS PSIVTYPE (P(4)) 9 I $G(PSJREN) D Q:P(2) 10 . I $G(P("OLDON")) N P2 S P2=$G(@("^PS(55,"_DFN_",""IV"","_+P("OLDON")_",0)")),P2=$P(P2,"^",2) I P2 S P(2)=P2 11 I $G(PSJORD)["P",$G(P("APPT"))?7N1"."1.N S START=$$DATE2^PSJUTL2(P("APPT")) G Q 12 I $G(PSJSYSW0)=""!($P(PSJSYSW0,U,5)=2) S START=+$E(P("LOG"),1,12) G Q 13 ;I $G(P("RES"))="R" N PSIVAC S PSIVAC="PR" D ENAD I PSIVADM S P(2)=PSIVADM Q 14 S PSIVSN=+P("IVRM"),START="",PSIVTYPE=$G(P(4)) Q:PSIVTYPE="" 15 N PSIV X $S($E(PSIVAC)="C":"S X=+$E(P(""LOG""),1,12) D H^%DTC S PSIV=%T",1:"S PSIV=$P($H,"","",2)") G T2:PSIVTYPE'["P"&('P(5)) 16 I P(11)']"" X $S($E(PSIVAC)="C":"S Y=+$E(P(""LOG""),1,12)",1:"D NOW^%DTC S Y=%") S Y=Y+.007\.01/100 S:'$P(Y,".",2) Y=$$MDNGHT(Y) X ^DD("DD") S START=Y G Q 17 S X=P(11) D CHK S PX=Y,X1=PSIV\3600,X2=PSIV#3600\60,X=$E(".0",1,$L(X1)#2+1)_X1_$E("0",X2<10)_X2,START=$S($E(PSIVAC)="C":$P(P("LOG"),"."),1:"T") 18 S X1=$P(PX,"-"),X1=$E(".0",1,$L(X1)#2+1)_X1,X2=$P(PX,"-",PSGCNT),X2=$E(".0",1,$L(X2)#2+1)_X2 19 S NAT=+$P($G(^PS(59.6,+$O(^PS(59.6,"B",+VAIN(4),0)),0)),U,5) 20 I '$D(PSGDT) S PSGDT=$$DATE^PSJUTL2() 21 I X<X1,'NAT S START=$$ENSD^PSGNE3(P(9),P(11),+$E(P("LOG"),1,12),PSGDT) G Q 22 I X>X2 S START=$$ENSD^PSGNE3(P(9),P(11),+$E(P("LOG"),1,12),PSGDT) G Q 23 T6 F I=2:1:PSGCNT S X1="."_$P(PX,"-",I-1),X2="."_$P(PX,"-",I) Q:+X1<X&(+X2>X) 24 S X1=X-X1,X2=$S(NAT:0,1:X2-X),START=$S(X1<X2:$P(PX,"-",I-1),1:$P(PX,"-",I)) S:START="" START=$P(PX,"-") X $S($E(PSIVAC)="C":"S Y=$P(P(""LOG""),""."") X ^DD(""DD"") S PSIV=Y",1:"S PSIV=""TODAY""") S START=PSIV_"@"_$E("0",$L(START)=3)_START G Q 25 T2 S X=+("."_$E(10000+(PSIV\3600*100)+(PSIV#3600\60),2,5)),START=$O(^PS(59.5,PSIVSN,3,"AT",X)) S:'START START=$O(^(0)),PSIVTOM=1 I 'START S START=X K PSIVTOM 26 S START=$S($E(PSIVAC)="C":$P(P("LOG"),"."),1:DT)_START I $D(PSIVTOM) S X1=$S($E(PSIVAC)="C":$P(P("LOG"),"."),1:DT),X2=1 D C^%DTC S Y=$P(X,".")_START K PSIVTOM 27 S X=START,%DT="XRTX" D ^%DT 28 Q ; 29 I START["@" S X=START,%DT="RTX" D ^%DT S START=+Y 30 S P(2)=START 31 I $G(PSJORD)["P" D:'$G(PSGRDTX(+PSJORD,"PSGSD")) REQDT^PSJLIVMD(PSJORD) S START=$G(PSGRDTX(+PSJORD,"PSGSD")) S P(2)=$S(START:START,1:P(2)) 32 K NAT,START,PSIVTYPE,PSIVSTRT,PSGCNT,X1,X2,PX 33 Q 34 CHK F Y=1:1 Q:$L(X)>240!($P(X,"-",Y)="") S $P(X,"-",Y)=$P(X,"-",Y)_$E("0000",1,4-$L($P(X,"-",Y))) 35 S Y=X,PSGCNT=$L(X,"-") S:X]""&(PSGCNT<1) PSGCNT=1 Q 36 ; 37 ENSTOP ; WILL CALCULATE STOP DATE FOR ORDER 38 ;NEEDS (DFN) & ON 39 N WALL,P3,ADX,DDLX,OIX,DRGT,PSIDAY,PSIMIN S (WALL,P3,PSIDAY,PSIMIN)=0 40 D:'$G(PSIVSITE) ^PSIVSET Q:'P(2) 41 I P(23)'="" S PSIVTYPE="C" 42 S STOP="",X="",PSIVSTRT=P(2),PSIVTYPE=$G(P(4)) I $G(PSJREN) D 43 . N RDT I $G(ON)["P" S RDT=+$$LASTREN^PSJLMPRI(DFN,ON) 44 . S PSIVSTRT=$$DATE2^PSJUTL2($S($G(RDT):RDT,1:$G(PSGDT))) 45 ;BHW - PSJ*5*177 - Begin Modifications - Reset Start date to Last Renewed date for active orders that have been renewed 46 I ('$G(PSJREN))&($G(P(4))="A")&($G(ON)["V") D 47 . N RDT S RDT=+$$LASTREN^PSJLMPRI(DFN,ON) 48 . I +RDT S PSIVSTRT=RDT 49 . Q 50 ;BHW - PSJ*5*177 - End Modifications - Resetting PSIVSTRT will recalculate the stop date based on the Last renewed date. 51 ; 52 I $S("^NOW^STAT^ONCE^ONE-TIME^ONE TIME^ONETIME^1TIME^1-TIME^1 TIME^"[(U_P(9)_U):1,1:0),PSIVTYPE="P"!P(5)!(P(23)="P") S X=$$ENOSD^PSJDCU(PSJSYSW0,PSIVSTRT,DFN) I X]"" S:P(11)=""&($G(ON)["P") PSIVCAL=1 G END 53 N DUR,DURMIN,PSJPROV,PSJDNM,A,PSJDAY I $G(PSJORD)["V" S DUR=$$GETDUR^PSJLIVMD(DFN,+PSJORD,"IV",1) I DUR]"" S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN S PSIMIN=DURMIN 54 I $G(PSJORD)["P"!($G(PSJORD)["V") N MINS,LIM S PSIVLIM=$$GETLIM(DFN,PSJORD) I PSIVLIM]"" S MINS=$$GETMIN(PSIVLIM,DFN,PSJORD) I MINS,MINS<PSIMIN!'PSIMIN S PSIMIN=MINS 55 I $P(PSIVSITE,"^",5) D 56 . N Z S Y=0 57 . F S Y=$O(^PS(55,DFN,"IV",Y)) Q:'Y S Z=^(Y,0) D Q:X]"" 58 .. I $P(Z,"^",17)="A",$$ONE^PSJBCMA(DFN,Y_"V",$P(Z,"^",9))'="O" S X=$P(Z,"^",3) Q 59 S:X WALL=X 60 S PSIDAY=$S(PSIVTYPE="A":$P(PSIVSITE,"^",4),PSIVTYPE="H":$P(PSIVSITE,"^",17),PSIVTYPE="P":$P(PSIVSITE,"^",18),PSIVTYPE="S":$P(PSIVSITE,"^",20),1:$P(PSIVSITE,"^",21)) 61 S PSJDAY="" D I PSJDAY]"",PSJDAY<PSIDAY S PSIDAY=PSJDAY 62 . N A,B,PSJCLIN 63 . Q:'$D(PSJORD) S A="" 64 . I PSJORD["P" S A=$G(^PS(53.1,+PSJORD,"DSS")) 65 . I PSJORD["U" S A=$G(^PS(55,PSGP,5,+PSJORD,8)) 66 . I PSJORD["V" S A=$G(^PS(55,PSGP,"IV",+PSJORD,"DSS")) 67 . S (PSJCLIN,A)=$P(A,"^") Q:A="" S PSJCLIN=$P(^SC(PSJCLIN,0),"^") I $D(^PS(53.46,"B",A)) S B=$O(^PS(53.46,"B",A,"")),PSJDAY=$P(^PS(53.46,B,0),"^",2) 68 F X=0:0 S X=$O(DRG("AD",X)) Q:'X I $P(^PS(52.6,+$P(DRG("AD",+X),U),0),"^",4),($P(^(0),"^",4))<+PSIDAY S PSIDAY=$P(^(0),"^",4) 69 I WALL,($$FMADD^XLFDT(PSIVSTRT,PSIDAY,"D"))>WALL S PSIDAY=$$FMDIFF^XLFDT(WALL,PSIVSTRT,1) S:PSIDAY<1 PSIDAY="" 70 S DRGT=$S($D(DRG("AD")):"AD",1:"SOL") F ADX=0:0 S ADX=$O(DRG(DRGT,ADX)) Q:'ADX!($G(DRGTMP)&($G(DRGTN)["AD")&(DRGT="SOL")) D 71 . S OIX=+$P(DRG(DRGT,ADX),"^",6),DDLX=$P(^PS(50.7,OIX,0),"^",5) Q:'DDLX D DDLIM(.PSIDAY,.P3) 72 I '$G(DRG("AD",0)),$G(DRGTMP),($G(DRGTN)["SOL") S OIX=$P($G(DRGTMP),"^",6) I OIX S DDLX=$P(^PS(50.7,OIX,0),"^",5) I DDLX D DDLIM(.PSIDAY,.P3) 73 I $G(P3),$G(P(2)) I P3>P(2) S X=P3 G END 74 S:('PSIDAY&'PSIMIN) PSIDAY=1 75 TIME S X2=PSIDAY,X1=PSIVSTRT D C^%DTC S X=$P(X,"."),X=X_$S($P(PSIVSITE,"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14)) 76 I PSIMIN,PSIMIN<(PSIDAY*1440) S X=$$FMADD^XLFDT(PSIVSTRT,,,PSIMIN) D 77 . I '(PSIMIN#1440) S X=$P(X,"."),X=X_$S($P(PSIVSITE,"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14)) 78 END ; 79 S P(3)=+X 80 I $G(PSJORD)["P" D:'$G(PSGRDTX(+PSJORD,"PSGFD")) REQDT^PSJLIVMD(PSJORD) S P(3)=$S($G(PSGRDTX(+PSJORD,"PSGFD")):PSGRDTX(+PSJORD,"PSGFD"),1:P(3)) 81 S P(3)=$$DATE2^PSJUTL2(P(3)),P(2)=$$DATE2^PSJUTL2(P(2)) 82 Q 83 ; 84 ENAD ;Will get last admin. time for order (needs dfn and on) 85 N P4,PSIVX,PSIVY 86 I $P(PSJSYSW0,U,5)=2 S PSIVADM=$$DATE^PSJUTL2() Q 87 I $S($G(PSIVAC)["R":1,P(9)="QOD":1,1:P(9)?1"Q".N1"D") S PSIVADM=$$ENSD^PSGNE3(P(9),P(11),+$E(P("LOG"),1,12),+$P($G(^PS(55,DFN,"IV",+P("OLDON"),0)),U,2)) Q:PSIVADM 88 S PSIVX=X,PSIVY=Y,P4=P(4) S:P(4)="C" P4=P(23) S:P4="S" P4=$S(P(5):"P",1:"A") D NOW^%DTC S Y=%,PSIVNOW=Y I (P4="P"&(P(11)="")&'P(15))!("HA"[P4&'P(15)) S Y=Y+.007\.01/100 G QAD 89 D P:P4="P"&('P(15)),AH:P(15) 90 QAD ; 91 S:'$D(PSGSA) PSGSA="" 92 S PSIVSD=Y I Y S OD=$L(PSGSA," ") I OD>2 S X=+PSGSA\1 F OD1=2:1:OD-1 I $P(PSGSA," ",OD1)'>$S(OD1>2:$P(PSGSA," ",OD1-1),1:PSGSA#1) S X1=X,X2=1 D C^%DTC 93 I PSIVSD,OD>2 S Y=X_PSIVSD 94 S PSIVADM=+Y,X=PSIVX,Y=PSIVY K PSGSA,PSIVSD,OD,OD1,PSIVMI,PSIVNOW S:PSIVADM<P(2) PSIVADM=P(2) Q 95 ; 96 P S CD=PSIVNOW,PSGSA="",(PSIVSD,OD)=DT_.0001,X=P(11) D CHK S P(11)=X D ENP4^PSIVWL 97 I PSGSA="" S PSIVSD=DT_.0001,PSIVMIN=-1440 D ENT^PSIVWL S $P(Y,".",2)=$P(P(11),"-",$L(P(11),"-")) Q 98 S Y=$P(PSGSA," ",$L(PSGSA," ")-1) Q 99 AH F PSIVADM=0:-1 S CD=PSIVNOW,(X,X1)=DT,X2=PSIVADM D:X2 C^%DTC S X=$P(X,".") S (OD1,PSIVSD,OD)=X_.0001,PSIVMIN=P(15) D ENP3^PSIVWL Q:PSIVADM<-4!(PSGSA]"") 100 S Y=$P(PSGSA," ",$L(PSGSA," ")-1) Q 101 MDNGHT(Y) ;Sets Start Date/Time on orders placed between midnight and 12:30 102 S Y=$$FMADD^XLFDT(Y,-1,0,0,0),Y=$P(Y,".")_".24" Q Y 103 ; 104 DDLIM(PSIVDUR,STPDT) ; 105 N P3 106 I DDLX["D" D Q:(STPDT=0) 107 . I +DDLX'<+PSIVDUR S STPDT=0 Q 108 . S PSIVDUR=+DDLX,X2=PSIVDUR,X1=PSIVSTRT D C^%DTC S X=$P(X,"."),X=X_$S($P(PSIVSITE,"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14)) I X>P(2) S P(3)=X 109 I DDLX["L",($G(P(9))]""),$G(P(15)),("AH"'[PSIVTYPE) D 110 . Q:'$G(P(2))!'$G(OIX) N FIRST,DOSAR,LAST,NEWDUR 111 . S STRING=P(2)_"^"_$S($G(STPDT):STPDT,1:$$FMADD^XLFDT(PSGDT,30))_"^"_P(9)_"^C^"_OIX S FIRST=$$ENQ^PSJORP2(DFN,STRING) 112 . S FIRST=$S($G(FIRST):FIRST,1:P(2)) Q:'FIRST S DSTMP=FIRST,DOSAR(1)=DSTMP F I=2:1:DDLX+1 S DOSAR(I)=$$FMADD^XLFDT(DSTMP,,,P(15)),DSTMP=DOSAR(I) 113 . I $D(DOSAR) S LAST=$O(DOSAR(""),-1) I LAST S LAST=DOSAR(LAST) I LAST>P(2) S NEWDUR=$$FMDIFF^XLFDT(LAST,P(2)) I NEWDUR<PSIVDUR S P(3)=LAST 114 S P(3)=$$DATE2^PSJUTL2(P(3)),P(2)=$$DATE2^PSJUTL2(P(2)) S STPDT=P(3) 115 Q 116 ; 117 GETLIM(DFN,PSJORD) ; 118 N ND2P5,F 119 S F=$S(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"") 120 S ND2P5=$G(@(F_"2.5)")) S LIM=$P(ND2P5,"^",4) Q:LIM="" 0 121 S ND0=$G(@(F_"0)")) I PSJORD["P",$P(ND0,"^",4)="U" Q 0 122 N MULT S MULT=$S($E(LIM)="h":60,$E(LIM)="d":1440,$E(LIM)="m":LIM,$E(LIM)="l":LIM,1:0) I MULT S LIM=MULT*$E(LIM,2,99) 123 Q LIM 124 ; 125 GETMIN(LIM,DFN,PSJORD) ; 126 N F 127 I LIM!(LIM=0) Q LIM 128 S F=$S(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"") 129 N RATE S RATE=$S(PSJORD["P":+$P($G(@(F_"8)")),"^",5),PSJORD["V":+$P($G(@(F_"0)")),"^",8),1:0) I RATE D 130 . S LIM=$S($E(LIM)="m":$E(LIM,2,99),$E(LIM)="l":($E(LIM,2,99)*1000),1:0)/RATE S LIM=LIM*60 131 Q LIM
Note:
See TracChangeset
for help on using the changeset viewer.
