PSIVCAL.m

PSIVCAL ;BIR/RGY,PR-CALCULATES START AND STOP DATES ; 11/20/19 11:03am

 ;;5.0;INPATIENT MEDICATIONS;**4,26,41,47,63,67,69,58,94,80,110,111,177,120,134,229,279,395**;16 DEC 97;Build 8

 ;

 ; Reference to ^PS(50.7 is supported by DBIA #2180.

 ; Reference to ^PS(52.6 is supported by DBIA #1231.

 ; Reference to ^PS(55 is supported by DBIA #2191.

 ;

ENT ;NEEDS PSIVTYPE (P(4))

 I $G(PSJREN) D  Q:P(2)

 . 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

 I $G(PSJORD)["P",$G(P("APPT"))?7N1"."1.N S START=$$DATE2^PSJUTL2(P("APPT")) S:($$FMDIFF^XLFDT(START,PSGDT,2)<0) START=+$E(PSGDT,1,12) G Q

 I $G(PSJSYSW0)=""!($P(PSJSYSW0,U,5)=2) S START=+$E(P("LOG"),1,12) G Q

 S PSIVSN=+P("IVRM"),START="",PSIVTYPE=$G(P(4)) Q:PSIVTYPE=""

 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))

 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

 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")

 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

 S NAT=+$P($G(^PS(59.6,+$O(^PS(59.6,"B",+VAIN(4),0)),0)),U,5)

 I '$D(PSGDT) S PSGDT=$$DATE^PSJUTL2()

 I X<X1,'NAT S START=$$ENSD^PSGNE3(P(9),P(11),+$E(P("LOG"),1,12),PSGDT) G Q

 I X>X2 S START=$$ENSD^PSGNE3(P(9),P(11),+$E(P("LOG"),1,12),PSGDT) G Q

T6 F I=2:1:PSGCNT S X1="."_$P(PX,"-",I-1),X2="."_$P(PX,"-",I) Q:+X1<X&(+X2>X)

 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

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

 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

 S X=START,%DT="XRTX" D ^%DT

Q ;

 I START["@" S X=START,%DT="RTX" D ^%DT S START=+Y

 S P(2)=START

 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))

 K NAT,START,PSIVTYPE,PSIVSTRT,PSGCNT,X1,X2,PX

 Q

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)))

 S Y=X,PSGCNT=$L(X,"-") S:X]""&(PSGCNT<1) PSGCNT=1 Q

 ;

ENSTOP ; WILL CALCULATE STOP DATE FOR ORDER

 ;NEEDS (DFN) & ON

 N WALL,P3,ADX,DDLX,OIX,DRGT,PSIDAY,PSIMIN,LIMDAY S (WALL,P3,PSIDAY,PSIMIN)=0

 D:'$G(PSIVSITE) ^PSIVSET  Q:'P(2)

 I P(23)'="" S PSIVTYPE="C"

 S STOP="",X="",PSIVSTRT=P(2),PSIVTYPE=$G(P(4)) I $G(PSJREN) D

 . N RDT I $G(ON)["P" S RDT=+$$LASTREN^PSJLMPRI(DFN,ON)

 . S PSIVSTRT=$$DATE2^PSJUTL2($S($G(RDT):RDT,1:$G(PSGDT)))

 ;BHW - PSJ*5*177 - Begin Modifications - Reset Start date to Last Renewed date for active orders that have been renewed

 I ('$G(PSJREN))&($G(P(4))="A")&($G(ON)["V") D

 . N RDT S RDT=+$$LASTREN^PSJLMPRI(DFN,ON)

 . I +RDT S PSIVSTRT=RDT

 . Q

 ;BHW - PSJ*5*177 - End Modifications - Resetting PSIVSTRT will recalculate the stop date based on the Last renewed date.

 ;

 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

 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

 . S DUR=$$GETDUR^PSJLIVMD(DFN,+ON,"IV",1) I DUR]"" S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN S PSIMIN=DURMIN

 I $P(PSIVSITE,"^",5) D

 . N Z S Y=0

 . F  S Y=$O(^PS(55,DFN,"IV",Y)) Q:'Y  S Z=^(Y,0) D  Q:X]""

 .. I $P(Z,"^",17)="A",$$ONE^PSJBCMA(DFN,Y_"V",$P(Z,"^",9))'="O" S X=$P(Z,"^",3) Q

 S:$G(X) WALL=X

 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))

 ;*229 Add Dose Limit for IOE

 I '$G(ON),$G(PSIVLIMT)]"" S PSIVLIM=PSIVLIMT

 I $G(ON)["P"!($G(ON)["V") I '$G(P("OVRIDE")) N MINS,LIM S PSIVLIM=$S($G(PSIVLIMT)]"":PSIVLIMT,1:$$GETLIM(DFN,ON)) I $G(PSIVLIM)]"" S MINS=$$GETMIN(PSIVLIM,DFN,ON,.LIMDAY) D

 .I (MINS&(MINS<PSIMIN))!'PSIMIN S PSIMIN=MINS

 S PSJDAY="" D  I PSJDAY]"",PSJDAY<PSIDAY S PSIDAY=PSJDAY

 . N A,B,PSJCLIN

 . Q:'$D(PSJORD)  S A=""

 . I PSJORD["P" S A=$G(^PS(53.1,+PSJORD,"DSS"))

 . I PSJORD["U" S A=$G(^PS(55,PSGP,5,+PSJORD,8))

 . I PSJORD["V" S A=$G(^PS(55,PSGP,"IV",+PSJORD,"DSS"))

 . S:(+$G(A)<0) A=""

 . S (PSJCLIN,A)=$P(A,"^") Q:A=""  S PSJCLIN=$P($G(^SC(+$G(PSJCLIN),0)),"^") Q:PSJCLIN=""  I $D(^PS(53.46,"B",A)) S B=$O(^PS(53.46,"B",A,"")),PSJDAY=$P(^PS(53.46,B,0),"^",2)

 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)

 I WALL,($$FMADD^XLFDT(PSIVSTRT,PSIDAY,"D"))>WALL S PSIDAY=$$FMDIFF^XLFDT(WALL,PSIVSTRT,1) S:PSIDAY<1 PSIDAY=""

 S DRGT=$S($G(DRG("AD",0)):"AD",1:"SOL") F ADX=0:0 S ADX=$O(DRG(DRGT,ADX)) Q:'ADX!($G(DRGTMP)&($G(DRGTN)["AD")&(DRGT="SOL"))  D   ;395 use $G of "AD",0 node

 . S OIX=+$P(DRG(DRGT,ADX),"^",6),DDLX=$P(^PS(50.7,OIX,0),"^",5) Q:'DDLX  D DDLIM(.PSIDAY,.P3)

 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)

 I $G(PSIVLIM)["a",'$G(P("OVRIDE")) S DDLX=$P(PSIVLIM,"a",2)_"L" I $G(DDLX) D DDLIM(.PSIDAY,.P3)

 I $G(P(2)) I P3>P(2) S X=P3 Q  ;*229 Quit so we use dose limit.

 S:('PSIDAY&'PSIMIN) PSIDAY=1

TIME S X2=PSIDAY,X1=PSIVSTRT D C^%DTC S X=$P(X,"."),X=X_$S($P(PSIVSITE,"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14))

 I PSIMIN D

 . I $G(PSIDAY),((PSIDAY*1440)<PSIMIN) K PSIVLIM,P("LIMIT") S P("OVRIDE")=1 Q

 . ;*229 if PSIMIN=(PSIDAY*1440) then dose lim, if day lim use site param.

 . I (PSIMIN<=(PSIDAY*1440)!'$G(PSIDAY)) S X=$$FMADD^XLFDT(PSIVSTRT,,,PSIMIN) D

 . . I $G(P("LIMIT"))["d" S X=$P(X,"."),X=X_$S($P(PSIVSITE,"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14))

 ;

END ;

 S P(3)=+X

 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))

 S P(3)=$$DATE2^PSJUTL2(P(3)),P(2)=$$DATE2^PSJUTL2(P(2))

 Q

 ;

ENAD ;Will get last admin. time for order (needs dfn and on)

 N P4,PSIVX,PSIVY

 I $P(PSJSYSW0,U,5)=2 S PSIVADM=$$DATE^PSJUTL2() Q

 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

 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

 D P:P4="P"&('P(15)),AH:P(15)

QAD ;

 S:'$D(PSGSA) PSGSA=""

 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

 I PSIVSD,OD>2 S Y=X_PSIVSD

 S PSIVADM=+Y,X=PSIVX,Y=PSIVY K PSGSA,PSIVSD,OD,OD1,PSIVMI,PSIVNOW S:PSIVADM<P(2) PSIVADM=P(2) Q

 ;

P S CD=PSIVNOW,PSGSA="",(PSIVSD,OD)=DT_.0001,X=P(11) D CHK S P(11)=X D ENP4^PSIVWL

 I PSGSA="" S PSIVSD=DT_.0001,PSIVMIN=-1440 D ENT^PSIVWL S $P(Y,".",2)=$P(P(11),"-",$L(P(11),"-")) Q

 S Y=$P(PSGSA," ",$L(PSGSA," ")-1) Q

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]"")

 S Y=$P(PSGSA," ",$L(PSGSA," ")-1) Q

MDNGHT(Y)          ;Sets Start Date/Time on orders placed between midnight and 12:30

 S Y=$$FMADD^XLFDT(Y,-1,0,0,0),Y=$P(Y,".")_".24" Q Y

 ;

DDLIM(PSIVDUR,STPDT) ;  Day Dose Limit

 N P3,NEWDAYS,NEWDUR,LASTD

 I DDLX["D" D  Q:(STPDT=0)

 .I +DDLX'<+PSIVDUR S STPDT=0 Q

 .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

 I DDLX["L",($G(P(9))]""),("AH"'[$G(PSIVTYPE)) S LASTD=$$DOSES(DDLX,.P) I LASTD D

 .S NEWDUR=$$FMDIFF^XLFDT(LASTD,P(2),2) I NEWDUR>0 S NEWDAYS=(NEWDUR/86400)

 .I $G(NEWDAYS) I NEWDAYS<PSIVDUR S PSIVDUR=NEWDAYS S P(3)=$$DATE2^PSJUTL2(LASTD)

 ;*229 Should be using LASTD if exists

 S P(3)=$$DATE2^PSJUTL2($S($G(LASTD):LASTD,1:P(3))),P(2)=$$DATE2^PSJUTL2(P(2)) S STPDT=P(3)

 Q

 ;

GETLIM(DFN,PSJORD) ; Convert IV Limits to minutes (only if in 'time' form).

 N ND2P5,F

 S F=$S(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"")

 S ND2P5=$G(@(F_"2.5)")) S LIM=$P(ND2P5,"^",4) Q:LIM="" 0

 S ND0=$G(@(F_"0)")) I PSJORD["P",$P(ND0,"^",4)="U" Q 0

 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)

 Q LIM

 ;

GETMIN(LIM,DFN,PSJORD,DAYS) ; Return the duration of the IV Limit in minutes (includes IV Limits in volume and doses format) 

 S LIM=$$GETMIN^PSIVUTL1(LIM,DFN,PSJORD,.DAYS)

 Q LIM

DOSES(DDLX,PRAY) ; Find stop date when 'doses' are sent as an IV Limit

 Q:$G(DDLX)'["L" ""

 I $P(DDLX,"L")["." S DDLX=($P(DDLX,".")+1)_"L"

 I '$G(PRAY(15)),$G(PRAY(11)) S PRAY(15)=1440/$L(PRAY(11),"-")

 Q:'$G(PRAY(2))!'$G(OIX) ""

 N FIRST,DOSAR,LAST,TMP9 S LAST="",TMP9=PRAY(9)

 S STRING=PRAY(2)_"^"_$S($G(STPDT):STPDT,1:$$FMADD^XLFDT(PSGDT,30))_"^"_PRAY(9)_"^C^"_OIX_"^"_PRAY(11) S FIRST=$$ENQ^PSJORP2(DFN,STRING)

 S P(9)=TMP9

 S FIRST=$S($G(FIRST):FIRST,1:PRAY(2)) Q:'FIRST  S DSTMP=FIRST,DOSAR(1)=DSTMP D

 .;*229 Add Dose Limit Calc

 .I $G(DDLX)["L",$G(PRAY(15)),($G(PRAY(11))']"")!($G(PRAY(15))>1440) N PSIVSD,PSIVMIN,X S PSIVMIN=(+DDLX*PRAY(15)),PSIVSD=+PRAY(2) D ENT^PSIVWL S DOSAR(1)=Y Q

 .I '$G(PRAY(11)) F I=2:1:DDLX+1 S DOSAR(I)=$$FMADD^XLFDT(DSTMP,,,PRAY(15)),DSTMP=DOSAR(I) Q

 .I $G(PRAY(11)) N ADMS,NXT,LAST,DAY S LAST=$P(DSTMP,".",2),DAY=$P(DSTMP,".") D

 ..F II=1:1:$L(PRAY(11),"-") S ADMS(+$P(PRAY(11),"-",II))=$P(PRAY(11),"-",II)

 ..;*229 Include DOW Calc, Need to Q if DAY<0 if we go past max dt

 ..F IJ=2:1:DDLX+1 S NXT=$O(ADMS(+LAST)),LAST=NXT D  Q:DAY<0

 ...I NXT="" S NXT=$O(ADMS(NXT)),LAST=NXT,DAY=$$FMADD^XLFDT(DAY,$$MWFD(PRAY(9),DAY)) Q:DAY<0

 ...S DOSAR(IJ)=DAY_"."_ADMS(NXT),DSTMP=DOSAR(IJ)

 ..I +DDLX=1 S NXT=$O(ADMS(LAST)),LAST=NXT D

 ...I NXT="" S NXT=$O(ADMS(NXT)),LAST=NXT

 I $D(DOSAR) S LAST=$O(DOSAR(""),-1) I LAST S LAST=DOSAR(LAST)

 Q LAST

 ;

MWFD(SCH,LAST) ;*229 Add to calc which days in DOW

 ;Calculate Days to add for DOW sched

 N X,Y

 I '$$DOW^PSIVUTL(SCH) Q 1 ;return 1 if not DOW

 F I=1:1:7 S X=$$FMADD^XLFDT(LAST,I) D DW^%DTC I SCH[$E(X,1,2) S Y=I Q

 Q Y

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSIVCAL   10842     printed  Feb 18, 2025@23:30:20                                                                                                                                                                                                    Page 2

PSIVCAL   ;BIR/RGY,PR-CALCULATES START AND STOP DATES ; 11/20/19 11:03am

 +1       ;;5.0;INPATIENT MEDICATIONS;**4,26,41,47,63,67,69,58,94,80,110,111,177,120,134,229,279,395**;16 DEC 97;Build 8

 +2       ;

 +3       ; Reference to ^PS(50.7 is supported by DBIA #2180.

 +4       ; Reference to ^PS(52.6 is supported by DBIA #1231.

 +5       ; Reference to ^PS(55 is supported by DBIA #2191.

 +6       ;

ENT       ;NEEDS PSIVTYPE (P(4))

 +1        IF $GET(PSJREN)

               Begin DoDot:1

 +2                IF $GET(P("OLDON"))

                       NEW P2

                       SET P2=$GET(@("^PS(55,"_DFN_",""IV"","_+P("OLDON")_",0)"))

                       SET P2=$PIECE(P2,"^",2)

                       IF P2

                           SET P(2)=P2

               End DoDot:1

               if P(2)

                   QUIT 

 +3        IF $GET(PSJORD)["P"

               IF $GET(P("APPT"))?7N1"."1.N

                   SET START=$$DATE2^PSJUTL2(P("APPT"))

                   if ($$FMDIFF^XLFDT(START,PSGDT,2)<0)

                       SET START=+$EXTRACT(PSGDT,1,12)

                   GOTO Q

 +4        IF $GET(PSJSYSW0)=""!($PIECE(PSJSYSW0,U,5)=2)

               SET START=+$EXTRACT(P("LOG"),1,12)

               GOTO Q

 +5        SET PSIVSN=+P("IVRM")

           SET START=""

           SET PSIVTYPE=$GET(P(4))

           if PSIVTYPE=""

               QUIT 

 +6        NEW PSIV

           XECUTE $SELECT($EXTRACT(PSIVAC)="C":"S X=+$E(P(""LOG""),1,12) D H^%DTC S PSIV=%T",1:"S PSIV=$P($H,"","",2)")

           if PSIVTYPE'["P"&('P(5))

               GOTO T2

 +7        IF P(11)']""

               XECUTE $SELECT($EXTRACT(PSIVAC)="C":"S Y=+$E(P(""LOG""),1,12)",1:"D NOW^%DTC S Y=%")

               SET Y=Y+.007\.01/100

               if '$PIECE(Y,".",2)

                   SET Y=$$MDNGHT(Y)

               XECUTE ^DD("DD")

               SET START=Y

               GOTO Q

 +8        SET X=P(11)

           DO CHK

           SET PX=Y

           SET X1=PSIV\3600

           SET X2=PSIV#3600\60

           SET X=$EXTRACT(".0",1,$LENGTH(X1)#2+1)_X1_$EXTRACT("0",X2<10)_X2

           SET START=$SELECT($EXTRACT(PSIVAC)="C":$PIECE(P("LOG"),"."),1:"T")

 +9        SET X1=$PIECE(PX,"-")

           SET X1=$EXTRACT(".0",1,$LENGTH(X1)#2+1)_X1

           SET X2=$PIECE(PX,"-",PSGCNT)

           SET X2=$EXTRACT(".0",1,$LENGTH(X2)#2+1)_X2

 +10       SET NAT=+$PIECE($GET(^PS(59.6,+$ORDER(^PS(59.6,"B",+VAIN(4),0)),0)),U,5)

 +11       IF '$DATA(PSGDT)

               SET PSGDT=$$DATE^PSJUTL2()

 +12       IF X<X1

               IF 'NAT

                   SET START=$$ENSD^PSGNE3(P(9),P(11),+$EXTRACT(P("LOG"),1,12),PSGDT)

                   GOTO Q

 +13       IF X>X2

               SET START=$$ENSD^PSGNE3(P(9),P(11),+$EXTRACT(P("LOG"),1,12),PSGDT)

               GOTO Q

T6         FOR I=2:1:PSGCNT

               SET X1="."_$PIECE(PX,"-",I-1)

               SET X2="."_$PIECE(PX,"-",I)

               if +X1<X&(+X2>X)

                   QUIT 

 +1        SET X1=X-X1

           SET X2=$SELECT(NAT:0,1:X2-X)

           SET START=$SELECT(X1<X2:$PIECE(PX,"-",I-1),1:$PIECE(PX,"-",I))

           if START=""

               SET START=$PIECE(PX,"-")

           XECUTE $SELECT($EXTRACT(PSIVAC)="C":"S Y=$P(P(""LOG""),""."") X ^DD(""DD"") S PSIV=Y",1:"S PSIV=""TODAY""")

           SET START=PSIV_"@"_$EXTRACT("0",$LENGTH(START)=3)_START

           GOTO Q

T2         SET X=+("."_$EXTRACT(10000+(PSIV\3600*100)+(PSIV#3600\60),2,5))

           SET START=$ORDER(^PS(59.5,PSIVSN,3,"AT",X))

           if 'START

               SET START=$ORDER(^(0))

               SET PSIVTOM=1

           IF 'START

               SET START=X

               KILL PSIVTOM

 +1        SET START=$SELECT($EXTRACT(PSIVAC)="C":$PIECE(P("LOG"),"."),1:DT)_START

           IF $DATA(PSIVTOM)

               SET X1=$SELECT($EXTRACT(PSIVAC)="C":$PIECE(P("LOG"),"."),1:DT)

               SET X2=1

               DO C^%DTC

               SET Y=$PIECE(X,".")_START

               KILL PSIVTOM

 +2        SET X=START

           SET %DT="XRTX"

           DO ^%DT

Q         ;

 +1        IF START["@"

               SET X=START

               SET %DT="RTX"

               DO ^%DT

               SET START=+Y

 +2        SET P(2)=START

 +3        IF $GET(PSJORD)["P"

               if '$GET(PSGRDTX(+PSJORD,"PSGSD"))

                   DO REQDT^PSJLIVMD(PSJORD)

               SET START=$GET(PSGRDTX(+PSJORD,"PSGSD"))

               SET P(2)=$SELECT(START:START,1:P(2))

 +4        KILL NAT,START,PSIVTYPE,PSIVSTRT,PSGCNT,X1,X2,PX

 +5        QUIT 

CHK        FOR Y=1:1

               if $LENGTH(X)>240!($PIECE(X,"-",Y)="")

                   QUIT 

               SET $PIECE(X,"-",Y)=$PIECE(X,"-",Y)_$EXTRACT("0000",1,4-$LENGTH($PIECE(X,"-",Y)))

 +1        SET Y=X

           SET PSGCNT=$LENGTH(X,"-")

           if X]""&(PSGCNT<1)

               SET PSGCNT=1

           QUIT 

 +2       ;

ENSTOP    ; WILL CALCULATE STOP DATE FOR ORDER

 +1       ;NEEDS (DFN) & ON

 +2        NEW WALL,P3,ADX,DDLX,OIX,DRGT,PSIDAY,PSIMIN,LIMDAY

           SET (WALL,P3,PSIDAY,PSIMIN)=0

 +3        if '$GET(PSIVSITE)

               DO ^PSIVSET

           if 'P(2)

               QUIT 

 +4        IF P(23)'=""

               SET PSIVTYPE="C"

 +5        SET STOP=""

           SET X=""

           SET PSIVSTRT=P(2)

           SET PSIVTYPE=$GET(P(4))

           IF $GET(PSJREN)

               Begin DoDot:1

 +6                NEW RDT

                   IF $GET(ON)["P"

                       SET RDT=+$$LASTREN^PSJLMPRI(DFN,ON)

 +7                SET PSIVSTRT=$$DATE2^PSJUTL2($SELECT($GET(RDT):RDT,1:$GET(PSGDT)))

               End DoDot:1

 +8       ;BHW - PSJ*5*177 - Begin Modifications - Reset Start date to Last Renewed date for active orders that have been renewed

 +9        IF ('$GET(PSJREN))&($GET(P(4))="A")&($GET(ON)["V")

               Begin DoDot:1

 +10               NEW RDT

                   SET RDT=+$$LASTREN^PSJLMPRI(DFN,ON)

 +11               IF +RDT

                       SET PSIVSTRT=RDT

 +12               QUIT 

               End DoDot:1

 +13      ;BHW - PSJ*5*177 - End Modifications - Resetting PSIVSTRT will recalculate the stop date based on the Last renewed date.

 +14      ;

 +15       IF $SELECT("^NOW^STAT^ONCE^ONE-TIME^ONE TIME^ONETIME^1TIME^1-TIME^1 TIME^"[(U_P(9)_U):1,1:0)

               IF PSIVTYPE="P"!P(5)!(P(23)="P")

                   SET X=$$ENOSD^PSJDCU(PSJSYSW0,PSIVSTRT,DFN)

                   IF X]""

                       if P(11)=""&($GET(ON)["P")

                           SET PSIVCAL=1

                       GOTO END

 +16       IF '$GET(P("OVRIDE"))

               IF $GET(ON)

                   NEW DUR,DURMIN,PSJPROV,PSJDNM,A,PSJDAY

                   IF $GET(ON)["V"!(($GET(ON)["P")&($PIECE($GET(^PS(53.1,+ON,0)),"^",4)="F"))

                       Begin DoDot:1

 +17                       SET DUR=$$GETDUR^PSJLIVMD(DFN,+ON,"IV",1)

                           IF DUR]""

                               SET DURMIN=$$DURMIN^PSJLIVMD(DUR)

                               IF DURMIN

                                   SET PSIMIN=DURMIN

                       End DoDot:1

 +18       IF $PIECE(PSIVSITE,"^",5)

               Begin DoDot:1

 +19               NEW Z

                   SET Y=0

 +20               FOR 

                       SET Y=$ORDER(^PS(55,DFN,"IV",Y))

                       if 'Y

                           QUIT 

                       SET Z=^(Y,0)

                       Begin DoDot:2

 +21                       IF $PIECE(Z,"^",17)="A"

                               IF $$ONE^PSJBCMA(DFN,Y_"V",$PIECE(Z,"^",9))'="O"

                                   SET X=$PIECE(Z,"^",3)

                                   QUIT 

                       End DoDot:2

                       if X]""

                           QUIT 

               End DoDot:1

 +22       if $GET(X)

               SET WALL=X

 +23       SET PSIDAY=$SELECT(PSIVTYPE="A":$PIECE(PSIVSITE,"^",4),PSIVTYPE="H":$PIECE(PSIVSITE,"^",17),PSIVTYPE="P":$PIECE(PSIVSITE,"^",18),PSIVTYPE="S":$PIECE(PSIVSITE,"^",20),1:$PIECE(PSIVSITE,"^",21))

 +24      ;*229 Add Dose Limit for IOE

 +25       IF '$GET(ON)

               IF $GET(PSIVLIMT)]""

                   SET PSIVLIM=PSIVLIMT

 +26       IF $GET(ON)["P"!($GET(ON)["V")

               IF '$GET(P("OVRIDE"))

                   NEW MINS,LIM

                   SET PSIVLIM=$SELECT($GET(PSIVLIMT)]"":PSIVLIMT,1:$$GETLIM(DFN,ON))

                   IF $GET(PSIVLIM)]""

                       SET MINS=$$GETMIN(PSIVLIM,DFN,ON,.LIMDAY)

                       Begin DoDot:1

 +27                       IF (MINS&(MINS<PSIMIN))!'PSIMIN

                               SET PSIMIN=MINS

                       End DoDot:1

 +28       SET PSJDAY=""

           Begin DoDot:1

 +29           NEW A,B,PSJCLIN

 +30           if '$DATA(PSJORD)

                   QUIT 

               SET A=""

 +31           IF PSJORD["P"

                   SET A=$GET(^PS(53.1,+PSJORD,"DSS"))

 +32           IF PSJORD["U"

                   SET A=$GET(^PS(55,PSGP,5,+PSJORD,8))

 +33           IF PSJORD["V"

                   SET A=$GET(^PS(55,PSGP,"IV",+PSJORD,"DSS"))

 +34           if (+$GET(A)<0)

                   SET A=""

 +35           SET (PSJCLIN,A)=$PIECE(A,"^")

               if A=""

                   QUIT 

               SET PSJCLIN=$PIECE($GET(^SC(+$GET(PSJCLIN),0)),"^")

               if PSJCLIN=""

                   QUIT 

               IF $DATA(^PS(53.46,"B",A))

                   SET B=$ORDER(^PS(53.46,"B",A,""))

                   SET PSJDAY=$PIECE(^PS(53.46,B,0),"^",2)

           End DoDot:1

           IF PSJDAY]""

               IF PSJDAY<PSIDAY

                   SET PSIDAY=PSJDAY

 +36       FOR X=0:0

               SET X=$ORDER(DRG("AD",X))

               if 'X

                   QUIT 

               IF $PIECE(^PS(52.6,+$PIECE(DRG("AD",+X),U),0),"^",4)

                   IF ($PIECE(^(0),"^",4))<+PSIDAY

                       SET PSIDAY=$PIECE(^(0),"^",4)

 +37       IF WALL

               IF ($$FMADD^XLFDT(PSIVSTRT,PSIDAY,"D"))>WALL

                   SET PSIDAY=$$FMDIFF^XLFDT(WALL,PSIVSTRT,1)

                   if PSIDAY<1

                       SET PSIDAY=""

 +38      ;395 use $G of "AD",0 node

           SET DRGT=$SELECT($GET(DRG("AD",0)):"AD",1:"SOL")

           FOR ADX=0:0

               SET ADX=$ORDER(DRG(DRGT,ADX))

               if 'ADX!($GET(DRGTMP)&($GET(DRGTN)["AD")&(DRGT="SOL"))

                   QUIT 

               Begin DoDot:1

 +39               SET OIX=+$PIECE(DRG(DRGT,ADX),"^",6)

                   SET DDLX=$PIECE(^PS(50.7,OIX,0),"^",5)

                   if 'DDLX

                       QUIT