PSJAPIDS ;BIR/MV - API TO PROCESS DOSING ORDER CHECKS FOR IV ;6 Jun 07 / 3:37 PM
;;5.0;INPATIENT MEDICATIONS ;**181,252,256,358**;16 DEC 97;Build 10
;
; Reference to ^PSDRUG( is supported by DBIA #2192.
; Reference to ^PS(51.1 is supported by DBIA# 2177.
; Reference to ^PSSDSAPI is supported by DBIA# 5425.
; Reference to DRT^PSSDSAPD is supported by DBIA# 5617.
; Reference to DOSE^PSSDSAPD is supported by DBIA# 5426.
; Reference to IN^PSSHRQ2 is supported by DBIA# 5369.
;
DOSE(PSJBASE,DFN,PSJIV) ;
;PSJBASE(1)=PSJBASE - Base1(Literal value for TMP global)- Required
;PSJBASE(2)=PSJBASE1 - Base2(Literal value for Screened display TMP global)- Required
;PSJDFN - Patient Internal Entry Number
;PSJIV(Px) - See DBIA #5385...P4 can be "ALL", "See Comments", or bottle number(s)
;PSJIV("TVOL_VOL") - Contains nUnit where n is # & Unit is either H,D,L,M, or DOSES
;PSJIV(X,"OI_ERROR",OI Name) - OI ien ^ Pharm # ^ Enhance flag(use in ENHFLG sub routine)
NEW DRG,P,PSIVAS,PSIVNM,PSJDD,PSJFDB,PSJOCDS,PSIVTDUR,PSJTOTVL,X
I $$PING()=-1 D Q
. F X=0:0 S X=$O(PSJBASE(X)) Q:'X D
.. M ^TMP($J,PSJBASE(X),"OUT")=^TMP($J,"PSJPRE","OUT")
Q:$G(PSJIV("IV_TYPE"))=""
Q:'+$G(DFN)
S PSJTOTVL=0
F X=0:0 S X=$O(PSJBASE(X)) Q:'X K:PSJBASE(X)]"" ^TMP($J,PSJBASE(1))
S P("DTYP")=+PSJIV("IV_TYPE")
S P("MR")=$G(PSJIV("MR_IEN"))
S P(8)=$G(PSJIV("INF_RATE"))
S P(9)=$G(PSJIV("SCHEDULE"))
;Admin times and Freq are not available from CPRS
S P(11)=""
S P(15)=""
D SETDRG
S PSJIV("DUR")="",PSJIV("TOT_VOL")=""
I PSJIV("TVOL_DUR")]"" D
. S PSIVTDUR=$$UP^XLFSTR(PSJIV("TVOL_DUR"))
. I PSIVTDUR["M" S PSJIV("TOT_VOL")=+PSIVTDUR
. I PSIVTDUR["L" S PSJIV("TOT_VOL")=+PSIVTDUR*1000,PSIVTDUR=PSJIV("TOT_VOL")_"M"
. ;get dose count for intermittent
. I P("DTYP")=1 D DURATION(PSIVTDUR,P(9)) Q
. ;Convert PSJIV("DUR") to minutes
. I P("DTYP")=2,$S(PSIVTDUR["H":1,PSIVTDUR["D":1,1:0) S PSJIV("DUR")=$$DRT^PSSDSAPD(PSIVTDUR)
D IN^PSIVOCDS(PSJBASE(1))
D ENHFLG
S PSJOCDS("CONTEXT")="CPRS-IV-"_$S($G(PSJIV("IV_TYPE"))=1:"I",1:"C")
I $$CHKDS() S PSJFDB("PACKAGE")="I" D DOSE^PSSDSAPD(.PSJBASE,DFN,.PSJOCDS,.PSJFDB)
K ^TMP($J,"PSJPRE")
Q
CHKDS() ;Check if dosing check should be performed
;PSJFLG=1 means dosing check should be performed
NEW PSJX,PSJFLG
I $G(PSJFDB(1,"ENH"))=0 Q 1
S PSJFLG=0
F PSJX=0:0 S PSJX=$O(PSJFDB(PSJX)) Q:'PSJX Q:PSJFLG D
. I '$D(PSJFDB(PSJX,"OI_ERROR")) S PSJFLG=1 Q
. I +$G(PSJFDB(PSJX,"OI")),$$SETENH(1,+PSJFDB(PSJX,"OI")) S PSJFLG=1
Q PSJFLG
SETDRG ;
NEW PSIVX,PSIVX0,PSJDD,PSGDT,PSJCNT,%
D NOW^%DTC S PSGDT=%
F PSIVAS="AD","SOL" S PSJCNT=0 F PSIVX=0:0 S PSIVX=$O(PSJIV(PSIVAS,PSIVX)) Q:'PSIVX D
.S PSIVX0=$G(PSJIV(PSIVAS,PSIVX))
.D:PSIVAS="AD" SETAD(+PSIVX0,$P(PSIVX0,U,2),$P(PSIVX0,U,5))
.D:PSIVAS="SOL" SETSOL(+PSIVX0,$P(PSIVX0,U,2),$P(PSIVX0,U,5))
Q
SETAD(PSJOI,PSJOINM,PSJFLG) ;Check if additive is active then set the DRG array
;PSJOI - 50.7 ien
;PSJOINM - CPRS OI name
;PSJFLG - 1 if the Enhanced order checks were done. 0 if not.
;PSJADDD - 50 ien ^ 52.6 ien or null
Q:'+$G(PSJOI)
Q:'$D(PSIVX0)
NEW PSJADDD,PSIVIEN
S PSJADDD=$$ADDD^PSJMISC(PSJOI)
I PSJADDD="" S PSJIV("OI_ERROR",$S($G(PSJOINM)]"":PSJOINM,1:"NOT FOUND"))=4_U_PSJOI_U_1 Q
S PSIVIEN=$P(PSJADDD,U,2)
S PSJCNT=$G(PSJCNT)+1
S DRG("AD",PSJCNT)=PSIVIEN_U_$P(PSIVX0,U,2)_U_$P(PSIVX0,U,3)_U_$S($P(PSIVX0,U,4)]"":$P(PSIVX0,U,4),1:"")
S PSJIV("DRG",+PSJADDD)=+$G(PSJFLG)
Q
SETSOL(PSJOI,PSJOINM,PSJFLG) ;Check if solution is active then set then DRG array
;PSJOI - 50.7 ien
;PSJOINM - CPRS OI name
;PSJFLG - 1 if the Enhanced order checks were done. 0 if not.
;PSJSOLDD - 50 ien ^ 52.7 ien or null
Q:'+$G(PSJOI)
Q:'$D(PSIVX0)
NEW PSJSOLDD,PSIVIEN
S PSJSOLDD=$$SOLDD^PSJMISC(PSJOI,+$P(PSIVX0,U,3))
I PSJSOLDD="" S PSJIV("OI_ERROR",$S($G(PSJOINM)]"":PSJOINM,1:"NOT FOUND"))=4_U_PSJOI_U_1 Q
S PSIVIEN=$P(PSJSOLDD,U,2)
S PSJCNT=$G(PSJCNT)+1
S DRG("SOL",PSJCNT)=PSIVIEN_U_$P(PSIVX0,U,2)_U_$P(PSIVX0,U,3)
S PSJIV("DRG",+PSJSOLDD)=+$G(PSJFLG)
S PSJTOTVL=$G(PSJTOTVL)+(+$P(PSIVX0,U,3))
Q
SETENH(PSJFLG,PSJOI) ;Reset PSJFLG to 0 only if GCN message is needed for the dosing check
NEW PSJDD,PSJDDFLG
I '+$D(PSJFLG) Q 0
I PSJFLG=0 Q 0
I '+$G(PSJOI) Q PSJFLG
;If PSJFLG=1 (CPRS did DI & DT) then check if no GCN for any of the DDs tie to OI then reset PSJFLG=0 to signal PDM
; to get the check done for the OI error.
S PSJDDFLG=0
F PSJDD=0:0 S PSJDD=$O(^PSDRUG("ASP",PSJOI,PSJDD)) Q:'PSJDD Q:PSJDDFLG D
. I +$$GCN^PSJMISC(PSJDD) S PSJDDFLG=1 Q
Q PSJDDFLG
ENHFLG ;Set the enhance flag so dosing error message won't display if enhance OC already displayed.
NEW PSJX,PSJOINM
F PSJX=0:0 S PSJX=$O(PSJFDB(PSJX)) Q:'PSJX D
. ;If "OI_ERROR" existed than set the "ENH" flag for that PSJX set
. S PSJOINM=$O(PSJFDB(PSJX,"OI_ERROR",""))
. I PSJOINM]"" D Q
.. S PSJFDB(PSJX,"ENH")=$P($G(PSJIV("OI_ERROR",PSJOINM)),U,3)
. I '$D(PSJFDB(PSJX,"DRUG_IEN")) Q
. S PSJFDB(PSJX,"ENH")=+$G(PSJIV("DRG",+PSJFDB(PSJX,"DRUG_IEN")))
Q
DURATION(PSJDUR,PSJSCH) ;Figure out date dose limit send by CPRS for intermittent IV
;Set PSJIV("DOSE_CNT") only for duration < 24 hrs & set PSJIV("DUR") to # minutes specified in the duration field
;PSJDUR1 - Duration in minutes (#_M)
;PSJCNTP3=# of minutes from schedule
;PSJCNTP4=# of doses from schedule
NEW PSJDOW,PSJCNT,PSJDUR1,PSJCNTP1,PSJCNTP2,PSJCNTP3,PSJCNTP4,PSJX
I $G(PSJDUR)="" Q
I $G(PSJSCH)="" Q
S PSJDUR=$$UP^XLFSTR(PSJDUR)
;These 'ML', 'L' don't make sense for IVPB & 'Days' is excluded because >24h
I $S(PSJDUR["ML":1,PSJDUR["L":1,PSJDUR["DAYS":1,1:0) Q
S PSJDUR1=0
S PSJDOW=$$DOW(PSJSCH)
I PSJDUR["H" Q:(+PSJDUR'<24) S PSJDUR1=$$DRT^PSSDSAPD(PSJDUR)_"M",PSJIV("DUR")=PSJDUR1
;
S PSJCNT=$$FRQ^PSSDSAPI(PSJSCH,PSJDOW,"I",PSJDUR1,$G(PSJDD))
S PSJCNTP1=$P(PSJCNT,U)
s PSJCNTP2=$P(PSJCNT,U,2)
I PSJCNTP2?1N.N S PSJCNTP3=1440/+PSJCNTP2,PSJCNTP4=+PSJCNTP2
I PSJCNTP2?1"Q"1N.N1"H" S PSJCNTP3=$P(PSJCNTP2,"Q",2)*60 S:+PSJCNTP3 PSJCNTP4=1440/PSJCNTP3
I PSJCNTP2?1"X"1N.N1"D" S:+$P(PSJCNTP2,"Q",2) PSJCNTP3=1440/$P(PSJCNTP2,"Q",2),PSJCNTP4=$P(PSJCNTP2,"Q",2)
;
Q:'+$G(PSJCNTP4)
I PSJDUR["DOSES",(+PSJDUR<PSJCNTP4) D
. S PSJX=(+PSJDUR)*(1440/PSJCNTP4)
. I PSJX["." S PSJX=$J((PSJX+.5),0,0)
. S PSJIV("DUR")=PSJX_"M"
. S PSJIV("DOSE_CNT")=+PSJDUR
;
Q:'+$G(PSJCNTP3)
I PSJDUR1["M",(+PSJDUR1<+$G(PSJCNTP3)) D
. S PSJX=+PSJDUR/(1440/PSJCNTP3)
. I PSJX["." S PSJX=$J((PSJX+.5),0,0)
. S PSJIV("DOSE_CNT")=PSJX
. S PSJIV("DUR")=PSJDUR1
Q
DOW(PSJSCH) ;Check if Schedule is a date of week
;Return "D" if date of week
NEW PSJSCHNO,PSJDOW,PSJFOUND
I $G(PSJSCH)="" Q ""
S PSJDOW=0,PSJFOUND=0
F PSJSCHNO=0:0 S PSJSCHNO=$O(^PS(51.1,"APPSJ",PSJSCH,PSJSCHNO)) Q:'PSJSCHNO!(PSJDOW) D
.I $P($G(^PS(51.1,PSJSCHNO,0)),"^",5)="D" S PSJDOW=1
.I $D(^PS(51.1,PSJSCHNO,0)) S PSJFOUND=1
I PSJDOW Q "D"
I PSJFOUND Q ""
I PSJSCH["@" Q "D"
Q ""
PING() ;Return -1 if the system is down.
S ^TMP($J,"PSJPRE","IN","PING")=""
D IN^PSSHRQ2("PSJPRE")
Q +$G(^TMP($J,"PSJPRE","OUT",0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJAPIDS 7145 printed Dec 13, 2024@02:06:11 Page 2
PSJAPIDS ;BIR/MV - API TO PROCESS DOSING ORDER CHECKS FOR IV ;6 Jun 07 / 3:37 PM
+1 ;;5.0;INPATIENT MEDICATIONS ;**181,252,256,358**;16 DEC 97;Build 10
+2 ;
+3 ; Reference to ^PSDRUG( is supported by DBIA #2192.
+4 ; Reference to ^PS(51.1 is supported by DBIA# 2177.
+5 ; Reference to ^PSSDSAPI is supported by DBIA# 5425.
+6 ; Reference to DRT^PSSDSAPD is supported by DBIA# 5617.
+7 ; Reference to DOSE^PSSDSAPD is supported by DBIA# 5426.
+8 ; Reference to IN^PSSHRQ2 is supported by DBIA# 5369.
+9 ;
DOSE(PSJBASE,DFN,PSJIV) ;
+1 ;PSJBASE(1)=PSJBASE - Base1(Literal value for TMP global)- Required
+2 ;PSJBASE(2)=PSJBASE1 - Base2(Literal value for Screened display TMP global)- Required
+3 ;PSJDFN - Patient Internal Entry Number
+4 ;PSJIV(Px) - See DBIA #5385...P4 can be "ALL", "See Comments", or bottle number(s)
+5 ;PSJIV("TVOL_VOL") - Contains nUnit where n is # & Unit is either H,D,L,M, or DOSES
+6 ;PSJIV(X,"OI_ERROR",OI Name) - OI ien ^ Pharm # ^ Enhance flag(use in ENHFLG sub routine)
+7 NEW DRG,P,PSIVAS,PSIVNM,PSJDD,PSJFDB,PSJOCDS,PSIVTDUR,PSJTOTVL,X
+8 IF $$PING()=-1
Begin DoDot:1
+9 FOR X=0:0
SET X=$ORDER(PSJBASE(X))
if 'X
QUIT
Begin DoDot:2
+10 MERGE ^TMP($JOB,PSJBASE(X),"OUT")=^TMP($JOB,"PSJPRE","OUT")
End DoDot:2
End DoDot:1
QUIT
+11 if $GET(PSJIV("IV_TYPE"))=""
QUIT
+12 if '+$GET(DFN)
QUIT
+13 SET PSJTOTVL=0
+14 FOR X=0:0
SET X=$ORDER(PSJBASE(X))
if 'X
QUIT
if PSJBASE(X)]""
KILL ^TMP($JOB,PSJBASE(1))
+15 SET P("DTYP")=+PSJIV("IV_TYPE")
+16 SET P("MR")=$GET(PSJIV("MR_IEN"))
+17 SET P(8)=$GET(PSJIV("INF_RATE"))
+18 SET P(9)=$GET(PSJIV("SCHEDULE"))
+19 ;Admin times and Freq are not available from CPRS
+20 SET P(11)=""
+21 SET P(15)=""
+22 DO SETDRG
+23 SET PSJIV("DUR")=""
SET PSJIV("TOT_VOL")=""
+24 IF PSJIV("TVOL_DUR")]""
Begin DoDot:1
+25 SET PSIVTDUR=$$UP^XLFSTR(PSJIV("TVOL_DUR"))
+26 IF PSIVTDUR["M"
SET PSJIV("TOT_VOL")=+PSIVTDUR
+27 IF PSIVTDUR["L"
SET PSJIV("TOT_VOL")=+PSIVTDUR*1000
SET PSIVTDUR=PSJIV("TOT_VOL")_"M"
+28 ;get dose count for intermittent
+29 IF P("DTYP")=1
DO DURATION(PSIVTDUR,P(9))
QUIT
+30 ;Convert PSJIV("DUR") to minutes
+31 IF P("DTYP")=2
IF $SELECT(PSIVTDUR["H":1,PSIVTDUR["D":1,1:0)
SET PSJIV("DUR")=$$DRT^PSSDSAPD(PSIVTDUR)
End DoDot:1
+32 DO IN^PSIVOCDS(PSJBASE(1))
+33 DO ENHFLG
+34 SET PSJOCDS("CONTEXT")="CPRS-IV-"_$SELECT($GET(PSJIV("IV_TYPE"))=1:"I",1:"C")
+35 IF $$CHKDS()
SET PSJFDB("PACKAGE")="I"
DO DOSE^PSSDSAPD(.PSJBASE,DFN,.PSJOCDS,.PSJFDB)
+36 KILL ^TMP($JOB,"PSJPRE")
+37 QUIT
CHKDS() ;Check if dosing check should be performed
+1 ;PSJFLG=1 means dosing check should be performed
+2 NEW PSJX,PSJFLG
+3 IF $GET(PSJFDB(1,"ENH"))=0
QUIT 1
+4 SET PSJFLG=0
+5 FOR PSJX=0:0
SET PSJX=$ORDER(PSJFDB(PSJX))
if 'PSJX
QUIT
if PSJFLG
QUIT
Begin DoDot:1
+6 IF '$DATA(PSJFDB(PSJX,"OI_ERROR"))
SET PSJFLG=1
QUIT
+7 IF +$GET(PSJFDB(PSJX,"OI"))
IF $$SETENH(1,+PSJFDB(PSJX,"OI"))
SET PSJFLG=1
End DoDot:1
+8 QUIT PSJFLG
SETDRG ;
+1 NEW PSIVX,PSIVX0,PSJDD,PSGDT,PSJCNT,%
+2 DO NOW^%DTC
SET PSGDT=%
+3 FOR PSIVAS="AD","SOL"
SET PSJCNT=0
FOR PSIVX=0:0
SET PSIVX=$ORDER(PSJIV(PSIVAS,PSIVX))
if 'PSIVX
QUIT
Begin DoDot:1
+4 SET PSIVX0=$GET(PSJIV(PSIVAS,PSIVX))
+5 if PSIVAS="AD"
DO SETAD(+PSIVX0,$PIECE(PSIVX0,U,2),$PIECE(PSIVX0,U,5))
+6 if PSIVAS="SOL"
DO SETSOL(+PSIVX0,$PIECE(PSIVX0,U,2),$PIECE(PSIVX0,U,5))
End DoDot:1
+7 QUIT
SETAD(PSJOI,PSJOINM,PSJFLG) ;Check if additive is active then set the DRG array
+1 ;PSJOI - 50.7 ien
+2 ;PSJOINM - CPRS OI name
+3 ;PSJFLG - 1 if the Enhanced order checks were done. 0 if not.
+4 ;PSJADDD - 50 ien ^ 52.6 ien or null
+5 if '+$GET(PSJOI)
QUIT
+6 if '$DATA(PSIVX0)
QUIT
+7 NEW PSJADDD,PSIVIEN
+8 SET PSJADDD=$$ADDD^PSJMISC(PSJOI)
+9 IF PSJADDD=""
SET PSJIV("OI_ERROR",$SELECT($GET(PSJOINM)]"":PSJOINM,1:"NOT FOUND"))=4_U_PSJOI_U_1
QUIT
+10 SET PSIVIEN=$PIECE(PSJADDD,U,2)
+11 SET PSJCNT=$GET(PSJCNT)+1
+12 SET DRG("AD",PSJCNT)=PSIVIEN_U_$PIECE(PSIVX0,U,2)_U_$PIECE(PSIVX0,U,3)_U_$SELECT($PIECE(PSIVX0,U,4)]"":$PIECE(PSIVX0,U,4),1:"")
+13 SET PSJIV("DRG",+PSJADDD)=+$GET(PSJFLG)
+14 QUIT
SETSOL(PSJOI,PSJOINM,PSJFLG) ;Check if solution is active then set then DRG array
+1 ;PSJOI - 50.7 ien
+2 ;PSJOINM - CPRS OI name
+3 ;PSJFLG - 1 if the Enhanced order checks were done. 0 if not.
+4 ;PSJSOLDD - 50 ien ^ 52.7 ien or null
+5 if '+$GET(PSJOI)
QUIT
+6 if '$DATA(PSIVX0)
QUIT
+7 NEW PSJSOLDD,PSIVIEN
+8 SET PSJSOLDD=$$SOLDD^PSJMISC(PSJOI,+$PIECE(PSIVX0,U,3))
+9 IF PSJSOLDD=""
SET PSJIV("OI_ERROR",$SELECT($GET(PSJOINM)]"":PSJOINM,1:"NOT FOUND"))=4_U_PSJOI_U_1
QUIT
+10 SET PSIVIEN=$PIECE(PSJSOLDD,U,2)
+11 SET PSJCNT=$GET(PSJCNT)+1
+12 SET DRG("SOL",PSJCNT)=PSIVIEN_U_$PIECE(PSIVX0,U,2)_U_$PIECE(PSIVX0,U,3)
+13 SET PSJIV("DRG",+PSJSOLDD)=+$GET(PSJFLG)
+14 SET PSJTOTVL=$GET(PSJTOTVL)+(+$PIECE(PSIVX0,U,3))
+15 QUIT
SETENH(PSJFLG,PSJOI) ;Reset PSJFLG to 0 only if GCN message is needed for the dosing check
+1 NEW PSJDD,PSJDDFLG
+2 IF '+$DATA(PSJFLG)
QUIT 0
+3 IF PSJFLG=0
QUIT 0
+4 IF '+$GET(PSJOI)
QUIT PSJFLG
+5 ;If PSJFLG=1 (CPRS did DI & DT) then check if no GCN for any of the DDs tie to OI then reset PSJFLG=0 to signal PDM
+6 ; to get the check done for the OI error.
+7 SET PSJDDFLG=0
+8 FOR PSJDD=0:0
SET PSJDD=$ORDER(^PSDRUG("ASP",PSJOI,PSJDD))
if 'PSJDD
QUIT
if PSJDDFLG
QUIT
Begin DoDot:1
+9 IF +$$GCN^PSJMISC(PSJDD)
SET PSJDDFLG=1
QUIT
End DoDot:1
+10 QUIT PSJDDFLG
ENHFLG ;Set the enhance flag so dosing error message won't display if enhance OC already displayed.
+1 NEW PSJX,PSJOINM
+2 FOR PSJX=0:0
SET PSJX=$ORDER(PSJFDB(PSJX))
if 'PSJX
QUIT
Begin DoDot:1
+3 ;If "OI_ERROR" existed than set the "ENH" flag for that PSJX set
+4 SET PSJOINM=$ORDER(PSJFDB(PSJX,"OI_ERROR",""))
+5 IF PSJOINM]""
Begin DoDot:2
+6 SET PSJFDB(PSJX,"ENH")=$PIECE($GET(PSJIV("OI_ERROR",PSJOINM)),U,3)
End DoDot:2
QUIT
+7 IF '$DATA(PSJFDB(PSJX,"DRUG_IEN"))
QUIT
+8 SET PSJFDB(PSJX,"ENH")=+$GET(PSJIV("DRG",+PSJFDB(PSJX,"DRUG_IEN")))
End DoDot:1
+9 QUIT
DURATION(PSJDUR,PSJSCH) ;Figure out date dose limit send by CPRS for intermittent IV
+1 ;Set PSJIV("DOSE_CNT") only for duration < 24 hrs & set PSJIV("DUR") to # minutes specified in the duration field
+2 ;PSJDUR1 - Duration in minutes (#_M)
+3 ;PSJCNTP3=# of minutes from schedule
+4 ;PSJCNTP4=# of doses from schedule
+5 NEW PSJDOW,PSJCNT,PSJDUR1,PSJCNTP1,PSJCNTP2,PSJCNTP3,PSJCNTP4,PSJX
+6 IF $GET(PSJDUR)=""
QUIT
+7 IF $GET(PSJSCH)=""
QUIT
+8 SET PSJDUR=$$UP^XLFSTR(PSJDUR)
+9 ;These 'ML', 'L' don't make sense for IVPB & 'Days' is excluded because >24h
+10 IF $SELECT(PSJDUR["ML":1,PSJDUR["L":1,PSJDUR["DAYS":1,1:0)
QUIT
+11 SET PSJDUR1=0
+12 SET PSJDOW=$$DOW(PSJSCH)
+13 IF PSJDUR["H"
if (+PSJDUR'<24)
QUIT
SET PSJDUR1=$$DRT^PSSDSAPD(PSJDUR)_"M"
SET PSJIV("DUR")=PSJDUR1
+14 ;
+15 SET PSJCNT=$$FRQ^PSSDSAPI(PSJSCH,PSJDOW,"I",PSJDUR1,$GET(PSJDD))
+16 SET PSJCNTP1=$PIECE(PSJCNT,U)
+17 SET PSJCNTP2=$PIECE(PSJCNT,U,2)
+18 IF PSJCNTP2?1N.N
SET PSJCNTP3=1440/+PSJCNTP2
SET PSJCNTP4=+PSJCNTP2
+19 IF PSJCNTP2?1"Q"1N.N1"H"
SET PSJCNTP3=$PIECE(PSJCNTP2,"Q",2)*60
if +PSJCNTP3
SET PSJCNTP4=1440/PSJCNTP3
+20 IF PSJCNTP2?1"X"1N.N1"D"
if +$PIECE(PSJCNTP2,"Q",2)
SET PSJCNTP3=1440/$PIECE(PSJCNTP2,"Q",2)
SET PSJCNTP4=$PIECE(PSJCNTP2,"Q",2)
+21 ;
+22 if '+$GET(PSJCNTP4)
QUIT
+23 IF PSJDUR["DOSES"
IF (+PSJDUR<PSJCNTP4)
Begin DoDot:1
+24 SET PSJX=(+PSJDUR)*(1440/PSJCNTP4)
+25 IF PSJX["."
SET PSJX=$JUSTIFY((PSJX+.5),0,0)
+26 SET PSJIV("DUR")=PSJX_"M"
+27 SET PSJIV("DOSE_CNT")=+PSJDUR
End DoDot:1
+28 ;
+29 if '+$GET(PSJCNTP3)
QUIT
+30 IF PSJDUR1["M"
IF (+PSJDUR1<+$GET(PSJCNTP3))
Begin DoDot:1
+31 SET PSJX=+PSJDUR/(1440/PSJCNTP3)
+32 IF PSJX["."
SET PSJX=$JUSTIFY((PSJX+.5),0,0)
+33 SET PSJIV("DOSE_CNT")=PSJX
+34 SET PSJIV("DUR")=PSJDUR1
End DoDot:1
+35 QUIT
DOW(PSJSCH) ;Check if Schedule is a date of week
+1 ;Return "D" if date of week
+2 NEW PSJSCHNO,PSJDOW,PSJFOUND
+3 IF $GET(PSJSCH)=""
QUIT ""
+4 SET PSJDOW=0
SET PSJFOUND=0
+5 FOR PSJSCHNO=0:0
SET PSJSCHNO=$ORDER(^PS(51.1,"APPSJ",PSJSCH,PSJSCHNO))
if 'PSJSCHNO!(PSJDOW)
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^PS(51.1,PSJSCHNO,0)),"^",5)="D"
SET PSJDOW=1
+7 IF $DATA(^PS(51.1,PSJSCHNO,0))
SET PSJFOUND=1
End DoDot:1
+8 IF PSJDOW
QUIT "D"
+9 IF PSJFOUND
QUIT ""
+10 IF PSJSCH["@"
QUIT "D"
+11 QUIT ""
PING() ;Return -1 if the system is down.
+1 SET ^TMP($JOB,"PSJPRE","IN","PING")=""
+2 DO IN^PSSHRQ2("PSJPRE")
+3 QUIT +$GET(^TMP($JOB,"PSJPRE","OUT",0))
