PSJORPOE ;BIR/MLM,LDT - MISC. PROCEDURE CALLS FOR OE/RR 3.0 ;Jul 01, 2020@14:27:10
;;5.0;INPATIENT MEDICATIONS;**50,56,92,80,110,127,133,134,113,277,330,388**;16 DEC 97;Build 9
;
; Reference to ^PS(50.7 is supported by DBIA# 2180.
; Reference to ^PS(51.2 is supported by DBIA# 2178.
; Reference to ^PS(55 is supported by DBIA# 2191.
; Reference to ^PS(51.1 is supported by DBIA# 2177.
; Reference to ^PS(52.6 is supported by DBIA# 1231.
; Reference to ^PS(52.7 is supported by DBIA# 2173.
; Reference to ^PSDRUG is supported by DBIA# 2192.
;
STARTSTP(PSGP,SCH,OI,PSJPWD,PSGORD,PSJADM,PSGORST) ;
; PSGP=Patient IEN
; SCH=Schedule
; OI=Orderable Item
; PSJPWD=Ward Location (Optional)
; PSGORD=Pharmacy Order Number if the order being placed is a Renewal (Optional)
; PSGORST=Order Start Date instead of NOW (Optional)
;
Q:+PSGP'>0 ""
Q:SCH']"" ""
Q:+OI'>0 ""
I SCH?.E1L.E S SCH=$$ENLU^PSGMI(SCH)
K DFN,PSGNEFDO,PSGNEFD,PSGST,PSGSCH,PSGNEDFD,PSGNESD,PSJSYSW,PSJSYSW0 N RESULT
S:'$D(PSGS0XT) PSGS0XT="" S:'$D(PSGS0Y) PSGSOY=""
I $G(PSJPWD)']"" S DFN=PSGP D IN5^VADPT S:VAIP(5)]"" PSJPWD=+VAIP(5)
S PSJSYSW0="",PSJSYSW=0 I $G(PSJPWD)]"" S PSJSYSW=+$O(^PS(59.6,"B",PSJPWD,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
S RESULT=$S($P(PSJSYSW0,"^",5)=0:"CLOSEST",$P(PSJSYSW0,"^",5)=1:"NEXT",1:"NOW")
I OI]"" S PSGST=$S($P($G(^PS(50.7,OI,0)),"^",7)]"":$P($G(^PS(50.7,OI,0)),"^",7),1:"C")
N %,PSGXSCH D NOW^%DTC S PSGDT=%,DFN=PSGP,(PSGSCH,PSGXSCH)=SCH
I $G(PSGORST)'="" S PSGDT=PSGORST ;Use Order Start Date if known instead of current date
S X=PSGSCH,PSGS0Y="" D ADMIN
I $G(PSGORD)]"" D
.S PSGNESD=$$DSTART^PSJDCU(PSGP,PSGORD) I PSGNESD]"" S $P(RESULT,"^",2)=PSGNESD Q
.S ND=$S(PSGORD["U":$G(^PS(55,PSGP,5,+PSGORD,2)),1:$G(^PS(55,PSGP,"IV",+PSGORD,0)))
.N PSJADM,PSJSTRT S PSJADM=$S(PSGORD["U":$P(ND,"^",5),1:$P(ND,"^",11)),PSJSTRT=$P(ND,"^",2),PSJREN=1
S SCH=PSGXSCH
;*277 Remove forced use of NEXT ward param.
;N PSJTMPW0 S PSJTMPW0=PSJSYSW0 S $P(PSJSYSW0,"^",5)=1
I $G(PSGNESD)="" S RESULT=RESULT_"^"_$$ENSD^PSGNE3(PSGSCH,$S($G(PSJADM)]"":$G(PSJADM),1:PSGS0Y),PSGDT,$S($G(PSJSTRT)]"":$G(PSJSTRT),1:PSGDT))
;S PSJSYSW0=PSJTMPW0
S PSGNESD=$P(RESULT,"^",2)
S PSGNEDFD=$$GTNEDFD^PSGOE7("U",OI)
K PSGODF,PSGOES,PSJREN
S SCH=PSGXSCH
D ENFD^PSGNE3(PSGDT) S RESULT=RESULT_"^"_$G(PSGNEFD) ;_"^"_$G(PSGNEFDO)
N DATE S DATE=$$FMDIFF^XLFDT($P(RESULT,"^",3),$P(RESULT,"^",2),3)
S $P(RESULT,"^",3)=$S($G(PSGST)="O":0,+DATE>0:+DATE_"D",$P($P(DATE," ",2),":")>0:$P($P(DATE," ",2),":")_"H",1:0)
N STRING S STRING=PSGNESD_U_PSGNEFD_U_$G(PSGSCH)_U_$G(PSGST)_U_$G(OI) I ($P($G(ZZND),U,2)]"")&($P($G(ZZND),"^")=$G(PSGSCH)) S STRING=STRING_U_$P(ZZND,U,2)
I $G(PSGSCH)]"" I $$DOW^PSIVUTL(PSGSCH) S:$G(PSGS0Y) $P(STRING,"^",6)=PSGS0Y
I $G(PSJADM) S $P(STRING,"^",6)=PSJADM
S RESULT=RESULT_"^"_$$ENQ^PSJORP2(PSGP,STRING) I ($G(PSGSCH)]"") I $$DOW^PSIVUTL(PSGSCH),(PSGSCH'["@"),'$G(PSGS0Y) S $P(RESULT,"^",4)=$P(RESULT,"^",2)
I ($G(PSGSCH)]"") I $$PRNOK^PSGS0(PSGSCH) S $P(RESULT,"^",4)=$P(RESULT,"^",2)
D KVAR^VADPT K LYN,ND,PSGDT,PSGNEDFD,PSGNEFD,PSGNEFDO,PSGNESD,PSGS0Y,PSGSCH,PSGST,PSJSYSW,PSJSYSW0,ZZ
;RESULT=WARD PARAMETER^DEFAULT START DATE/TIME^#_D(NUMBER OF DAYS ORDER LASTS) OR #_H(NUMBER OF HOURS ORDER LASTS)^EXPECTED FIRST DOSE
Q RESULT
;
RESOLVE(PSGP,SCH,OI,PCH,PSJPWD,PSJADM) ;
; PSGP=Patient IEN
; SCH=Schedule
; OI=Orderable Item
; PCH=Providers Choice
; PSJPWD=Ward Location (Optional)
; PSJADM=Admin Times (Optional)
;
N PSJSYSW0,PSJSYSW,PSGSCH,PSGOES,PSGS0Y,DFN,RESULT1
I $G(PSJPWD)']"" S DFN=PSGP D IN5^VADPT S:VAIP(5)]"" PSJPWD=+VAIP(5)
S PSJSYSW0="",PSJSYSW=0 I $G(PSJPWD)]"" S PSJSYSW=+$O(^PS(59.6,"B",PSJPWD,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
S $P(PSJSYSW0,"^",5)=$S($$ONE(SCH):2,PCH="NEXT":1,1:0)
S RESULT1=$S($P(PSJSYSW0,"^",5)=0:"CLOSEST",$P(PSJSYSW0,"^",5)=1:"NEXT",1:"NOW")
I OI]"" S PSGST=$S($P($G(^PS(50.7,OI,0)),"^",7)]"":$P($G(^PS(50.7,OI,0)),"^",7),1:"C")
N % D NOW^%DTC S PSGDT=%,DFN=PSGP,PSGSCH=SCH
S X=PSGSCH,PSGS0Y="" I $D(^PS(51.1,"AC","PSJ",X)) D ADMIN
S:$G(PSJADM) PSGS0Y=PSJADM
S RESULT1=RESULT1_"^"_$$ENSD^PSGNE3(SCH,PSGS0Y,PSGDT,PSGDT)
I $G(PSGSCH)]"" I $$DOW^PSIVUTL(PSGSCH),(PSGSCH'["@"),'$G(PSGS0Y) S $P(RESULT,"^",4)=$P(RESULT,"^",2)
I $G(PSGSCH)]"" I $$PRNOK^PSGS0(PSGSCH) S $P(RESULT1,"^",4)=$P(RESULT,"^",2)
D KVAR^VADPT K LYN,PSGDT,PSGNEDFD,PSGNEFD,PSGNEFDO,PSGNESD,PSGS0Y,PSGSCH,PSGST,PSJSYSW,PSJSYSW0,ZZ,PSGS0XT,PSGS0Y
Q RESULT1
;
SCHREQ(MR,OI,DD) ;
; MR=Medication Route from 51.2 (Required)
; OI=Orderable Item from 50.7 (Optional)
; DD=Dispense Drug from 50 (Optional)
N ADDITIVE,SOLUTION,REQ S REQ=0,(SOLUTION,ADDITIVE)=""
I '+$G(MR) S REQ=1 Q REQ
I '+$G(OI),'+$G(DD) S REQ=1 Q REQ
I +$G(DD) S:$P($G(^PSDRUG(+DD,2)),U,3)["U" REQ=1 Q REQ
I '$D(PS(51.2,+MR,0)) S REQ=1 Q REQ
I $P($G(^PS(51.2,+MR,0)),"^",6)=1 D
.I +$G(OI) D
..I '$D(^PS(50.7,+OI,0)) S REQ=1 Q
..F S SOLUTION=$O(^PS(52.7,"AOI",+OI,SOLUTION)) Q:'SOLUTION Q:REQ=1 S:$P(^PSDRUG(+$P(^PS(52.7,SOLUTION,0),U,2),2),U,3)["U" REQ=1
..F S ADDITIVE=$O(^PS(52.6,"AOI",+OI,ADDITIVE)) Q:'ADDITIVE Q:REQ=1 S:$P(^PSDRUG(+$P(^PS(52.6,ADDITIVE,0),U,2),2),U,3)["U" REQ=1
Q REQ
;
ADMIN ; Get admin times associated with schedule
S PSGS0Y="",ZZ=0 N PSGCHG S PSGCHG=""
I $$DOW^PSIVUTL($P(X,"@")),'$D(^PS(51.1,"AC","PSJ",X)) S PSGST="C" D Q:$G(PSGS0Y)
.I $P(X,"@",2) N PSJADBAD D Q
..S PSGS0Y=$S($G(PSJADBAD):"",1:$P(X,"@",2))
..N ADMIN,TIME,II S ADMIN=$P(X,"@",2) F II=1:1:$L(ADMIN,"-") S TIME=$P(ADMIN,"-",II) I TIME'?2N&(TIME'?4N) S PSJADBAD=1
.I $P(X,"@",2)]"",$D(^PS(51.1,"APPSJ",$P(X,"@",2))) S X=$P(X,"@",2)
D FIND^DIC(51.1,,,,X,,"APPSJ",,,"LYN")
S ZZ=$O(LYN("DILIST",2,ZZ)) I ZZ S ZZ=+LYN("DILIST",2,ZZ) I ZZ S ZZND=$G(^PS(51.1,ZZ,0)) S PSGST=$P(ZZND,U,5),PSGS0XT=$P(ZZND,U,3) S:$G(PSGSFLG) PSGSCIEN=$G(LYN("DILIST",2,ZZ)) I $G(PSJPWD) D
. N ZZNDW S ZZNDW=$G(^PS(51.1,ZZ,1,PSJPWD,0)) I $P(ZZNDW,"^",2)]"" S PSGS0Y=$P(ZZNDW,"^",2),$P(ZZND,"^",2)=PSGS0Y I $G(PSGSFLG) S PSGSCIEN=$G(LYN("DILIST",2,ZZ))
S ZZ=0 F S ZZ=$O(LYN("DILIST",1,ZZ)) Q:'ZZ I $G(LYN("DILIST",1,ZZ))'=X K LYN("DILIST",1,ZZ),LYN("DILIST",2,ZZ),LYN("DILIST","ID",ZZ,1)
I $D(PSJPWD) S ZZ=0 F S ZZ=$O(LYN("DILIST",2,ZZ)) Q:'ZZ!$G(PSGS0Y) I $P($G(^PS(51.1,+LYN("DILIST",2,ZZ),1,+PSJPWD,0)),U,2)]"" S PSGS0Y=$P($G(^(0)),U,2) I $G(PSGSFLG) S PSGSCIEN=$G(LYN("DILIST",2,ZZ))
I $G(PSJOCFG)="COPY UD" D
.S:$P((ZZND),U,5)'="" PSGCHG=$P($G(ZZND),U,5)
.S:(PSGCHG'="O")!((PSGCHG'="P")!(PSGCHG'="OC")) PSGS0Y=$G(PSGAT)
Q:PSGS0Y]"" S ZZ=0 F S ZZ=$O(LYN("DILIST",2,ZZ)) Q:'ZZ!$G(PSGS0Y) I $G(LYN("DILIST","ID",ZZ,1))]"" S PSGS0Y=$G(LYN("DILIST","ID",ZZ,1))
Q
;
ONE(SCH) ;
; SCH=Admin Schedule
; Returns 0 = (zero) Not a one time schedule.
; 1 = One time schedule.
Q:$G(SCH)="" 0
N X
I $D(^PS(51.1,"AC","PSJ",SCH)) S X=$O(^(SCH,"")) S X=$P(^PS(51.1,X,0),"^",5) Q $S(X="O":1,1:0)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJORPOE 6989 printed Apr 09, 2024@21:07:55 Page 2
PSJORPOE ;BIR/MLM,LDT - MISC. PROCEDURE CALLS FOR OE/RR 3.0 ;Jul 01, 2020@14:27:10
+1 ;;5.0;INPATIENT MEDICATIONS;**50,56,92,80,110,127,133,134,113,277,330,388**;16 DEC 97;Build 9
+2 ;
+3 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
+4 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
+5 ; Reference to ^PS(55 is supported by DBIA# 2191.
+6 ; Reference to ^PS(51.1 is supported by DBIA# 2177.
+7 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
+8 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
+9 ; Reference to ^PSDRUG is supported by DBIA# 2192.
+10 ;
STARTSTP(PSGP,SCH,OI,PSJPWD,PSGORD,PSJADM,PSGORST) ;
+1 ; PSGP=Patient IEN
+2 ; SCH=Schedule
+3 ; OI=Orderable Item
+4 ; PSJPWD=Ward Location (Optional)
+5 ; PSGORD=Pharmacy Order Number if the order being placed is a Renewal (Optional)
+6 ; PSGORST=Order Start Date instead of NOW (Optional)
+7 ;
+8 if +PSGP'>0
QUIT ""
+9 if SCH']""
QUIT ""
+10 if +OI'>0
QUIT ""
+11 IF SCH?.E1L.E
SET SCH=$$ENLU^PSGMI(SCH)
+12 KILL DFN,PSGNEFDO,PSGNEFD,PSGST,PSGSCH,PSGNEDFD,PSGNESD,PSJSYSW,PSJSYSW0
NEW RESULT
+13 if '$DATA(PSGS0XT)
SET PSGS0XT=""
if '$DATA(PSGS0Y)
SET PSGSOY=""
+14 IF $GET(PSJPWD)']""
SET DFN=PSGP
DO IN5^VADPT
if VAIP(5)]""
SET PSJPWD=+VAIP(5)
+15 SET PSJSYSW0=""
SET PSJSYSW=0
IF $GET(PSJPWD)]""
SET PSJSYSW=+$ORDER(^PS(59.6,"B",PSJPWD,0))
IF PSJSYSW
SET PSJSYSW0=$GET(^PS(59.6,PSJSYSW,0))
+16 SET RESULT=$SELECT($PIECE(PSJSYSW0,"^",5)=0:"CLOSEST",$PIECE(PSJSYSW0,"^",5)=1:"NEXT",1:"NOW")
+17 IF OI]""
SET PSGST=$SELECT($PIECE($GET(^PS(50.7,OI,0)),"^",7)]"":$PIECE($GET(^PS(50.7,OI,0)),"^",7),1:"C")
+18 NEW %,PSGXSCH
DO NOW^%DTC
SET PSGDT=%
SET DFN=PSGP
SET (PSGSCH,PSGXSCH)=SCH
+19 ;Use Order Start Date if known instead of current date
IF $GET(PSGORST)'=""
SET PSGDT=PSGORST
+20 SET X=PSGSCH
SET PSGS0Y=""
DO ADMIN
+21 IF $GET(PSGORD)]""
Begin DoDot:1
+22 SET PSGNESD=$$DSTART^PSJDCU(PSGP,PSGORD)
IF PSGNESD]""
SET $PIECE(RESULT,"^",2)=PSGNESD
QUIT
+23 SET ND=$SELECT(PSGORD["U":$GET(^PS(55,PSGP,5,+PSGORD,2)),1:$GET(^PS(55,PSGP,"IV",+PSGORD,0)))
+24 NEW PSJADM,PSJSTRT
SET PSJADM=$SELECT(PSGORD["U":$PIECE(ND,"^",5),1:$PIECE(ND,"^",11))
SET PSJSTRT=$PIECE(ND,"^",2)
SET PSJREN=1
End DoDot:1
+25 SET SCH=PSGXSCH
+26 ;*277 Remove forced use of NEXT ward param.
+27 ;N PSJTMPW0 S PSJTMPW0=PSJSYSW0 S $P(PSJSYSW0,"^",5)=1
+28 IF $GET(PSGNESD)=""
SET RESULT=RESULT_"^"_$$ENSD^PSGNE3(PSGSCH,$SELECT($GET(PSJADM)]"":$GET(PSJADM),1:PSGS0Y),PSGDT,$SELECT($GET(PSJSTRT)]"":$GET(PSJSTRT),1:PSGDT))
+29 ;S PSJSYSW0=PSJTMPW0
+30 SET PSGNESD=$PIECE(RESULT,"^",2)
+31 SET PSGNEDFD=$$GTNEDFD^PSGOE7("U",OI)
+32 KILL PSGODF,PSGOES,PSJREN
+33 SET SCH=PSGXSCH
+34 ;_"^"_$G(PSGNEFDO)
DO ENFD^PSGNE3(PSGDT)
SET RESULT=RESULT_"^"_$GET(PSGNEFD)
+35 NEW DATE
SET DATE=$$FMDIFF^XLFDT($PIECE(RESULT,"^",3),$PIECE(RESULT,"^",2),3)
+36 SET $PIECE(RESULT,"^",3)=$SELECT($GET(PSGST)="O":0,+DATE>0:+DATE_"D",$PIECE($PIECE(DATE," ",2),":")>0:$PIECE($PIECE(DATE," ",2),":")_"H",1:0)
+37 NEW STRING
SET STRING=PSGNESD_U_PSGNEFD_U_$GET(PSGSCH)_U_$GET(PSGST)_U_$GET(OI)
IF ($PIECE($GET(ZZND),U,2)]"")&($PIECE($GET(ZZND),"^")=$GET(PSGSCH))
SET STRING=STRING_U_$PIECE(ZZND,U,2)
+38 IF $GET(PSGSCH)]""
IF $$DOW^PSIVUTL(PSGSCH)
if $GET(PSGS0Y)
SET $PIECE(STRING,"^",6)=PSGS0Y
+39 IF $GET(PSJADM)
SET $PIECE(STRING,"^",6)=PSJADM
+40 SET RESULT=RESULT_"^"_$$ENQ^PSJORP2(PSGP,STRING)
IF ($GET(PSGSCH)]"")
IF $$DOW^PSIVUTL(PSGSCH)
IF (PSGSCH'["@")
IF '$GET(PSGS0Y)
SET $PIECE(RESULT,"^",4)=$PIECE(RESULT,"^",2)
+41 IF ($GET(PSGSCH)]"")
IF $$PRNOK^PSGS0(PSGSCH)
SET $PIECE(RESULT,"^",4)=$PIECE(RESULT,"^",2)
+42 DO KVAR^VADPT
KILL LYN,ND,PSGDT,PSGNEDFD,PSGNEFD,PSGNEFDO,PSGNESD,PSGS0Y,PSGSCH,PSGST,PSJSYSW,PSJSYSW0,ZZ
+43 ;RESULT=WARD PARAMETER^DEFAULT START DATE/TIME^#_D(NUMBER OF DAYS ORDER LASTS) OR #_H(NUMBER OF HOURS ORDER LASTS)^EXPECTED FIRST DOSE
+44 QUIT RESULT
+45 ;
RESOLVE(PSGP,SCH,OI,PCH,PSJPWD,PSJADM) ;
+1 ; PSGP=Patient IEN
+2 ; SCH=Schedule
+3 ; OI=Orderable Item
+4 ; PCH=Providers Choice
+5 ; PSJPWD=Ward Location (Optional)
+6 ; PSJADM=Admin Times (Optional)
+7 ;
+8 NEW PSJSYSW0,PSJSYSW,PSGSCH,PSGOES,PSGS0Y,DFN,RESULT1
+9 IF $GET(PSJPWD)']""
SET DFN=PSGP
DO IN5^VADPT
if VAIP(5)]""
SET PSJPWD=+VAIP(5)
+10 SET PSJSYSW0=""
SET PSJSYSW=0
IF $GET(PSJPWD)]""
SET PSJSYSW=+$ORDER(^PS(59.6,"B",PSJPWD,0))
IF PSJSYSW
SET PSJSYSW0=$GET(^PS(59.6,PSJSYSW,0))
+11 SET $PIECE(PSJSYSW0,"^",5)=$SELECT($$ONE(SCH):2,PCH="NEXT":1,1:0)
+12 SET RESULT1=$SELECT($PIECE(PSJSYSW0,"^",5)=0:"CLOSEST",$PIECE(PSJSYSW0,"^",5)=1:"NEXT",1:"NOW")
+13 IF OI]""
SET PSGST=$SELECT($PIECE($GET(^PS(50.7,OI,0)),"^",7)]"":$PIECE($GET(^PS(50.7,OI,0)),"^",7),1:"C")
+14 NEW %
DO NOW^%DTC
SET PSGDT=%
SET DFN=PSGP
SET PSGSCH=SCH
+15 SET X=PSGSCH
SET PSGS0Y=""
IF $DATA(^PS(51.1,"AC","PSJ",X))
DO ADMIN
+16 if $GET(PSJADM)
SET PSGS0Y=PSJADM
+17 SET RESULT1=RESULT1_"^"_$$ENSD^PSGNE3(SCH,PSGS0Y,PSGDT,PSGDT)
+18 IF $GET(PSGSCH)]""
IF $$DOW^PSIVUTL(PSGSCH)
IF (PSGSCH'["@")
IF '$GET(PSGS0Y)
SET $PIECE(RESULT,"^",4)=$PIECE(RESULT,"^",2)
+19 IF $GET(PSGSCH)]""
IF $$PRNOK^PSGS0(PSGSCH)
SET $PIECE(RESULT1,"^",4)=$PIECE(RESULT,"^",2)
+20 DO KVAR^VADPT
KILL LYN,PSGDT,PSGNEDFD,PSGNEFD,PSGNEFDO,PSGNESD,PSGS0Y,PSGSCH,PSGST,PSJSYSW,PSJSYSW0,ZZ,PSGS0XT,PSGS0Y
+21 QUIT RESULT1
+22 ;
SCHREQ(MR,OI,DD) ;
+1 ; MR=Medication Route from 51.2 (Required)
+2 ; OI=Orderable Item from 50.7 (Optional)
+3 ; DD=Dispense Drug from 50 (Optional)
+4 NEW ADDITIVE,SOLUTION,REQ
SET REQ=0
SET (SOLUTION,ADDITIVE)=""
+5 IF '+$GET(MR)
SET REQ=1
QUIT REQ
+6 IF '+$GET(OI)
IF '+$GET(DD)
SET REQ=1
QUIT REQ
+7 IF +$GET(DD)
if $PIECE($GET(^PSDRUG(+DD,2)),U,3)["U"
SET REQ=1
QUIT REQ
+8 IF '$DATA(PS(51.2,+MR,0))
SET REQ=1
QUIT REQ
+9 IF $PIECE($GET(^PS(51.2,+MR,0)),"^",6)=1
Begin DoDot:1
+10 IF +$GET(OI)
Begin DoDot:2
+11 IF '$DATA(^PS(50.7,+OI,0))
SET REQ=1
QUIT
+12 FOR
SET SOLUTION=$ORDER(^PS(52.7,"AOI",+OI,SOLUTION))
if 'SOLUTION
QUIT
if REQ=1
QUIT
if $PIECE(^PSDRUG(+$PIECE(^PS(52.7,SOLUTION,0),U,2),2),U,3)["U"
SET REQ=1
+13 FOR
SET ADDITIVE=$ORDER(^PS(52.6,"AOI",+OI,ADDITIVE))
if 'ADDITIVE
QUIT
if REQ=1
QUIT
if $PIECE(^PSDRUG(+$PIECE(^PS(52.6,ADDITIVE,0),U,2),2),U,3)["U"
SET REQ=1
End DoDot:2
End DoDot:1
+14 QUIT REQ
+15 ;
ADMIN ; Get admin times associated with schedule
+1 SET PSGS0Y=""
SET ZZ=0
NEW PSGCHG
SET PSGCHG=""
+2 IF $$DOW^PSIVUTL($PIECE(X,"@"))
IF '$DATA(^PS(51.1,"AC","PSJ",X))
SET PSGST="C"
Begin DoDot:1
+3 IF $PIECE(X,"@",2)
NEW PSJADBAD
Begin DoDot:2
+4 SET PSGS0Y=$SELECT($GET(PSJADBAD):"",1:$PIECE(X,"@",2))
+5 NEW ADMIN,TIME,II
SET ADMIN=$PIECE(X,"@",2)
FOR II=1:1:$LENGTH(ADMIN,"-")
SET TIME=$PIECE(ADMIN,"-",II)
IF TIME'?2N&(TIME'?4N)
SET PSJADBAD=1
End DoDot:2
QUIT
+6 IF $PIECE(X,"@",2)]""
IF $DATA(^PS(51.1,"APPSJ",$PIECE(X,"@",2)))
SET X=$PIECE(X,"@",2)
End DoDot:1
if $GET(PSGS0Y)
QUIT
+7 DO FIND^DIC(51.1,,,,X,,"APPSJ",,,"LYN")
+8 SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
IF ZZ
SET ZZ=+LYN("DILIST",2,ZZ)
IF ZZ
SET ZZND=$GET(^PS(51.1,ZZ,0))
SET PSGST=$PIECE(ZZND,U,5)
SET PSGS0XT=$PIECE(ZZND,U,3)
if $GET(PSGSFLG)
SET PSGSCIEN=$GET(LYN("DILIST",2,ZZ))
IF $GET(PSJPWD)
Begin DoDot:1
+9 NEW ZZNDW
SET ZZNDW=$GET(^PS(51.1,ZZ,1,PSJPWD,0))
IF $PIECE(ZZNDW,"^",2)]""
SET PSGS0Y=$PIECE(ZZNDW,"^",2)
SET $PIECE(ZZND,"^",2)=PSGS0Y
IF $GET(PSGSFLG)
SET PSGSCIEN=$GET(LYN("DILIST",2,ZZ))
End DoDot:1
+10 SET ZZ=0
FOR
SET ZZ=$ORDER(LYN("DILIST",1,ZZ))
if 'ZZ
QUIT
IF $GET(LYN("DILIST",1,ZZ))'=X
KILL LYN("DILIST",1,ZZ),LYN("DILIST",2,ZZ),LYN("DILIST","ID",ZZ,1)
+11 IF $DATA(PSJPWD)
SET ZZ=0
FOR
SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
if 'ZZ!$GET(PSGS0Y)
QUIT
IF $PIECE($GET(^PS(51.1,+LYN("DILIST",2,ZZ),1,+PSJPWD,0)),U,2)]""
SET PSGS0Y=$PIECE($GET(^(0)),U,2)
IF $GET(PSGSFLG)
SET PSGSCIEN=$GET(LYN("DILIST",2,ZZ))
+12 IF $GET(PSJOCFG)="COPY UD"
Begin DoDot:1
+13 if $PIECE((ZZND),U,5)'=""
SET PSGCHG=$PIECE($GET(ZZND),U,5)
+14 if (PSGCHG'="O")!((PSGCHG'="P")!(PSGCHG'="OC"))
SET PSGS0Y=$GET(PSGAT)
End DoDot:1
+15 if PSGS0Y]""
QUIT
SET ZZ=0
FOR
SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
if 'ZZ!$GET(PSGS0Y)
QUIT
IF $GET(LYN("DILIST","ID",ZZ,1))]""
SET PSGS0Y=$GET(LYN("DILIST","ID",ZZ,1))
+16 QUIT
+17 ;
ONE(SCH) ;
+1 ; SCH=Admin Schedule
+2 ; Returns 0 = (zero) Not a one time schedule.
+3 ; 1 = One time schedule.
+4 if $GET(SCH)=""
QUIT 0
+5 NEW X
+6 IF $DATA(^PS(51.1,"AC","PSJ",SCH))
SET X=$ORDER(^(SCH,""))
SET X=$PIECE(^PS(51.1,X,0),"^",5)
QUIT $SELECT(X="O":1,1:0)
+7 QUIT 0
