PSSDSAPB ;CAN/EJD - Dose Check APIs routine (continued) ; Aug 22, 2023@10:03
 ;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
 ;
STN1 ;Standard Logic continue - called by PSSDSAPI@STN
 K PSSFWAA,PSSFWAAD
 S PSSDCF=$$DCFSCH^PSSSCHMS(PSSFWLP2,$G(PSSDRG),$G(PSSFWDRL))
 ;PSS*1*206
 I PSSDCF="",(PSSFWSC[" PRN") D
 . NEW PSSX
 . S PSSX=PSSFWLP2
 . I ($P(PSSFWSC," PRN",1)'=""),($P(PSSFWSC," PRN",1)'?." ") S PSSFWLP2=$O(^PS(51.1,"APPSJ",$P(PSSFWSC," PRN",1),0))
 . S:+PSSFWLP2 PSSDCF=$$DCFSCH^PSSSCHMS(PSSFWLP2,$G(PSSDRG),$G(PSSFWDRL))
 . S PSSFWLP2=PSSX
 I PSSDCF]"" S (PSSFWPR1,PSSFWFLG,PSSDCFLG)=1,PSSFWRST=$P(PSSDCF,U),PSSFWPR7=$P(PSSDCF,U,2) Q
 S PSSFWAA=$P($G(^PS(51.1,PSSFWLP2,0)),"^",3)
 Q:'$G(PSSFWAA)
 S PSSFWAAD=1440/PSSFWAA
 I PSSFWAAD?.N S PSSFWRST=PSSFWAAD,PSSFWFLG=1 Q
 I (PSSFWAA<1440),((PSSFWAA/60)?.N) S PSSFWRST="Q"_(PSSFWAA/60)_"H",PSSFWFLG=1 Q
 I PSSFWAAD>1 Q
 S PSSFWAAM=PSSFWAA/1440
 I PSSFWAAM'?.N D  Q
 . S PSSFWFLG=1,PSSFWRST="",PSSDIVFG=1
 . I (PSSFWAA/60)?.N S PSSFWRST="Q"_(PSSFWAA/60)_"H"
 I PSSFWAAM?.N D  Q
 .S PSSFWAMN=PSSFWAAM/30 I PSSFWAMN?.N S PSSFWFLG=1,PSSFWRST="Q"_PSSFWAMN_"L" Q
 .I PSSFWAAM=365 S PSSFWFLG=1,PSSFWRST="Q12L" Q   ;254
 .S PSSFWAWK=PSSFWAAM/7 I PSSFWAWK?.N S PSSFWFLG=1,PSSFWRST="Q"_PSSFWAWK_"W" Q
 .S PSSFWFLG=1,PSSFWRST="Q"_PSSFWAAM_"D" Q
 I PSSFWAA'>10080 S PSSFWAXW=10080/PSSFWAA I PSSFWAXW?.N S PSSFWFLG=1,PSSFWRST=PSSFWAXW_"XW" Q
 S PSSFWAXL=43200/PSSFWAA I PSSFWAXL?.N S PSSFWFLG=1,PSSFWRST=PSSFWAXL_"XL" Q
 Q
 ;
STNO1 ;Standard Logic part 2, using File 51, For Outpatient Orders only - called by PSSDSAPI@STNO
 K PSSFWBA,PSSFWBAD
 S PSSDCF=$$DCF51^PSSSCHMS(PSSFWLP3,$G(PSSDRG),$G(PSSFWDRL))
 I PSSDCF]"" S (PSSFWPR1,PSSFWFLG,PSSDCFLG)=1,PSSFWRST=$P(PSSDCF,U),PSSFWPR7=$P(PSSDCF,U,2) Q
 S PSSFWBA=$P($G(^PS(51,PSSFWLP3,0)),"^",8)
 Q:'$G(PSSFWBA)
 S PSSFWBAD=1440/PSSFWBA
 I PSSFWBAD?.N S PSSFWRST=PSSFWBAD,PSSFWFLG=1 Q
 I (PSSFWBA<1440),((PSSFWBA/60)?.N) S PSSFWRST="Q"_(PSSFWBA/60)_"H",PSSFWFLG=1 Q
 ;PSSDECNO=1 when the admin time is not a whole #(dosing error message should display)
 I PSSFWBAD>1 S PSSFWFLG=0,PSSDECNO=1 Q
 S PSSFWBAM=PSSFWBA/1440
 I PSSFWBAM'?.N S PSSFWFLG=1,PSSFWRST="",PSSDIVFG=1 Q
 I PSSFWBAM?.N D  Q
 .S PSSFWBMN=PSSFWBAM/30 I PSSFWBMN?.N S PSSFWFLG=1,PSSFWRST="Q"_PSSFWBMN_"L" Q
 .I PSSFWBAM=365 S PSSFWFLG=1,PSSFWRST="Q12L" Q   ;254
 .S PSSFWBWK=PSSFWBAM/7 I PSSFWBWK?.N S PSSFWFLG=1,PSSFWRST="Q"_PSSFWBWK_"W" Q
 .S PSSFWFLG=1,PSSFWRST="Q"_PSSFWBAM_"D" Q
 I PSSFWBA'>10080 S PSSFWBXW=10080/PSSFWBA I PSSFWBXW?.N S PSSFWFLG=1,PSSFWRST="X"_PSSFWBXW_"W" Q
 S PSSFWBXL=43200/PSSFWBA I PSSFWBXL?.N S PSSFWFLG=1,PSSFWRST="X"_PSSFWBXL_"L" Q
 Q
 ;
NOEXPF ;254 Check for exceptions to frequency
 ;Called by PSSDSAPK@NOEXP
 N PSSTEXT
 I '$D(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDBFDB(1,"RX_NUM"),1,"TEXT")) Q
 S PSSTEXT=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDBFDB(1,"RX_NUM"),1,"TEXT"))
 I PSSTEXT["Weight is required" Q
 I PSSTEXT["Body surface area is required" Q
 K ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSNOE1)
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSAPB   3091     printed  Sep 23, 2025@20:06:44                                                                                                                                                                                                    Page 2
PSSDSAPB  ;CAN/EJD - Dose Check APIs routine (continued) ; Aug 22, 2023@10:03
 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
 +2       ;
STN1      ;Standard Logic continue - called by PSSDSAPI@STN
 +1        KILL PSSFWAA,PSSFWAAD
 +2        SET PSSDCF=$$DCFSCH^PSSSCHMS(PSSFWLP2,$GET(PSSDRG),$GET(PSSFWDRL))
 +3       ;PSS*1*206
 +4        IF PSSDCF=""
               IF (PSSFWSC[" PRN")
                   Begin DoDot:1
 +5                    NEW PSSX
 +6                    SET PSSX=PSSFWLP2
 +7                    IF ($PIECE(PSSFWSC," PRN",1)'="")
                           IF ($PIECE(PSSFWSC," PRN",1)'?." ")
                               SET PSSFWLP2=$ORDER(^PS(51.1,"APPSJ",$PIECE(PSSFWSC," PRN",1),0))
 +8                    if +PSSFWLP2
                           SET PSSDCF=$$DCFSCH^PSSSCHMS(PSSFWLP2,$GET(PSSDRG),$GET(PSSFWDRL))
 +9                    SET PSSFWLP2=PSSX
                   End DoDot:1
 +10       IF PSSDCF]""
               SET (PSSFWPR1,PSSFWFLG,PSSDCFLG)=1
               SET PSSFWRST=$PIECE(PSSDCF,U)
               SET PSSFWPR7=$PIECE(PSSDCF,U,2)
               QUIT 
 +11       SET PSSFWAA=$PIECE($GET(^PS(51.1,PSSFWLP2,0)),"^",3)
 +12       if '$GET(PSSFWAA)
               QUIT 
 +13       SET PSSFWAAD=1440/PSSFWAA
 +14       IF PSSFWAAD?.N
               SET PSSFWRST=PSSFWAAD
               SET PSSFWFLG=1
               QUIT 
 +15       IF (PSSFWAA<1440)
               IF ((PSSFWAA/60)?.N)
                   SET PSSFWRST="Q"_(PSSFWAA/60)_"H"
                   SET PSSFWFLG=1
                   QUIT 
 +16       IF PSSFWAAD>1
               QUIT 
 +17       SET PSSFWAAM=PSSFWAA/1440
 +18       IF PSSFWAAM'?.N
               Begin DoDot:1
 +19               SET PSSFWFLG=1
                   SET PSSFWRST=""
                   SET PSSDIVFG=1
 +20               IF (PSSFWAA/60)?.N
                       SET PSSFWRST="Q"_(PSSFWAA/60)_"H"
               End DoDot:1
               QUIT 
 +21       IF PSSFWAAM?.N
               Begin DoDot:1
 +22               SET PSSFWAMN=PSSFWAAM/30
                   IF PSSFWAMN?.N
                       SET PSSFWFLG=1
                       SET PSSFWRST="Q"_PSSFWAMN_"L"
                       QUIT 
 +23      ;254
                   IF PSSFWAAM=365
                       SET PSSFWFLG=1
                       SET PSSFWRST="Q12L"
                       QUIT 
 +24               SET PSSFWAWK=PSSFWAAM/7
                   IF PSSFWAWK?.N
                       SET PSSFWFLG=1
                       SET PSSFWRST="Q"_PSSFWAWK_"W"
                       QUIT 
 +25               SET PSSFWFLG=1
                   SET PSSFWRST="Q"_PSSFWAAM_"D"
                   QUIT 
               End DoDot:1
               QUIT 
 +26       IF PSSFWAA'>10080
               SET PSSFWAXW=10080/PSSFWAA
               IF PSSFWAXW?.N
                   SET PSSFWFLG=1
                   SET PSSFWRST=PSSFWAXW_"XW"
                   QUIT 
 +27       SET PSSFWAXL=43200/PSSFWAA
           IF PSSFWAXL?.N
               SET PSSFWFLG=1
               SET PSSFWRST=PSSFWAXL_"XL"
               QUIT 
 +28       QUIT 
 +29      ;
STNO1     ;Standard Logic part 2, using File 51, For Outpatient Orders only - called by PSSDSAPI@STNO
 +1        KILL PSSFWBA,PSSFWBAD
 +2        SET PSSDCF=$$DCF51^PSSSCHMS(PSSFWLP3,$GET(PSSDRG),$GET(PSSFWDRL))
 +3        IF PSSDCF]""
               SET (PSSFWPR1,PSSFWFLG,PSSDCFLG)=1
               SET PSSFWRST=$PIECE(PSSDCF,U)
               SET PSSFWPR7=$PIECE(PSSDCF,U,2)
               QUIT 
 +4        SET PSSFWBA=$PIECE($GET(^PS(51,PSSFWLP3,0)),"^",8)
 +5        if '$GET(PSSFWBA)
               QUIT 
 +6        SET PSSFWBAD=1440/PSSFWBA
 +7        IF PSSFWBAD?.N
               SET PSSFWRST=PSSFWBAD
               SET PSSFWFLG=1
               QUIT 
 +8        IF (PSSFWBA<1440)
               IF ((PSSFWBA/60)?.N)
                   SET PSSFWRST="Q"_(PSSFWBA/60)_"H"
                   SET PSSFWFLG=1
                   QUIT 
 +9       ;PSSDECNO=1 when the admin time is not a whole #(dosing error message should display)
 +10       IF PSSFWBAD>1
               SET PSSFWFLG=0
               SET PSSDECNO=1
               QUIT 
 +11       SET PSSFWBAM=PSSFWBA/1440
 +12       IF PSSFWBAM'?.N
               SET PSSFWFLG=1
               SET PSSFWRST=""
               SET PSSDIVFG=1
               QUIT 
 +13       IF PSSFWBAM?.N
               Begin DoDot:1
 +14               SET PSSFWBMN=PSSFWBAM/30
                   IF PSSFWBMN?.N
                       SET PSSFWFLG=1
                       SET PSSFWRST="Q"_PSSFWBMN_"L"
                       QUIT 
 +15      ;254
                   IF PSSFWBAM=365
                       SET PSSFWFLG=1
                       SET PSSFWRST="Q12L"
                       QUIT 
 +16               SET PSSFWBWK=PSSFWBAM/7
                   IF PSSFWBWK?.N
                       SET PSSFWFLG=1
                       SET PSSFWRST="Q"_PSSFWBWK_"W"
                       QUIT 
 +17               SET PSSFWFLG=1
                   SET PSSFWRST="Q"_PSSFWBAM_"D"
                   QUIT 
               End DoDot:1
               QUIT 
 +18       IF PSSFWBA'>10080
               SET PSSFWBXW=10080/PSSFWBA
               IF PSSFWBXW?.N
                   SET PSSFWFLG=1
                   SET PSSFWRST="X"_PSSFWBXW_"W"
                   QUIT 
 +19       SET PSSFWBXL=43200/PSSFWBA
           IF PSSFWBXL?.N
               SET PSSFWFLG=1
               SET PSSFWRST="X"_PSSFWBXL_"L"
               QUIT 
 +20       QUIT 
 +21      ;
NOEXPF    ;254 Check for exceptions to frequency
 +1       ;Called by PSSDSAPK@NOEXP
 +2        NEW PSSTEXT
 +3        IF '$DATA(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDBFDB(1,"RX_NUM"),1,"TEXT"))
               QUIT 
 +4        SET PSSTEXT=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDBFDB(1,"RX_NUM"),1,"TEXT"))
 +5        IF PSSTEXT["Weight is required"
               QUIT 
 +6        IF PSSTEXT["Body surface area is required"
               QUIT 
 +7        KILL ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSNOE1)
 +8        QUIT