Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSSSCHMS

PSSSCHMS.m

Go to the documentation of this file.
  1. PSSSCHMS ;BIR/MV-Frequency utilities routine ;09/13/10
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**178,206,231**;9/30/97;Build 4
  1. ;;Reference to INP^VADPT supported by DBIA #10061
  1. ;
  1. OLDSCH(PSSFWSCC) ;Get IEN for .01 of the schedule file from the Old Schedule name
  1. ;Input:
  1. ; PSSFWSC - Schedule name from the order
  1. ;Output:
  1. ; Schedule Name(.01)^51.1 IEN(if old schedule found)
  1. ;
  1. NEW PSSOLDNM,PSSSCH,PSSIEN,PSSOSN
  1. I $G(PSSFWSCC)="" Q ""
  1. ; Skip looking for the old schedule name if there is an exact matched for the original schedule
  1. I $O(^PS(51.1,"APPSJ",PSSFWSCC,0)) Q PSSFWSCC
  1. S PSSOLDNM=PSSFWSCC
  1. S PSSIEN=+$O(^PS(51.1,"D",PSSOLDNM,0))
  1. ; If there is an exact matched to the old schedule name then use it. Otherwise retain the original schedule
  1. I 'PSSIEN Q PSSFWSCC
  1. S PSSSCH=$G(^PS(51.1,PSSIEN,0))
  1. I $P(PSSSCH,U)]"",($P(PSSSCH,U,4)="PSJ") S PSSFWSCC=$P(PSSSCH,U),PSSOSN=+PSSIEN
  1. Q PSSFWSCC_U_$G(PSSOSN)
  1. ;
  1. OLD51(PSSFWSCC) ;Get IEN for .01 of the Med Instruction file from the Old Med Instruction name
  1. ;Input:
  1. ; PSSFWSC - Schedule name from the order
  1. ;Output:
  1. ; Med instruction name(.01)^51 IEN(If old med Instruction found)
  1. ;
  1. NEW PSSOLDNM,PSSSCH,PSSIEN,PSSOMEDN
  1. I $G(PSSFWSCC)="" Q ""
  1. I $O(^PS(51,"B",PSSFWSCC,0)) Q PSSFWSCC
  1. S PSSOLDNM=PSSFWSCC
  1. S PSSIEN=+$O(^PS(51,"D",PSSOLDNM,0))
  1. I 'PSSIEN Q PSSFWSCC
  1. S PSSSCH=$P($G(^PS(51,PSSIEN,0)),U)
  1. S:PSSSCH]"" PSSFWSCC=PSSSCH,PSSOMEDN=+PSSIEN
  1. Q PSSFWSCC_U_$G(PSSOMEDN)
  1. ;
  1. DCFSCH(PSSIEN,PSSDDIEN,PSSFWDRL) ;Dosing Check Frequency process for 51.1
  1. ;Input:
  1. ; PSSIEN - IEN from 51.1
  1. ; PSSDDIEN - IEN from file 50
  1. ; PSSFWDRL - The order duration
  1. ;Output:
  1. ; PSSDCF - P1(adjust if order duration is passed in)^P2(#51.1 - 0;11)
  1. ;
  1. Q:'+$G(PSSIEN) ""
  1. NEW PSSDCF,PSSDCFLG,PSSDCF1,PSSFRQF,PSSNODD
  1. S PSSDCFLG=0
  1. S PSSDCF=$P($G(^PS(51.1,+PSSIEN,0)),U,11)
  1. Q:PSSDCF="" ""
  1. ; If no dispense drug is defined in 51.1 then return DCF if available
  1. I '$O(^PS(51.1,+PSSIEN,4,0)) S PSSDCFLG=1
  1. I $G(PSSDBIFL) D Q:+PSSNODD ""
  1. .S PSSNODD=$$NOTALLDD(+$G(PSSDBFDB("OI")),PSSIEN)
  1. .S:'+PSSNODD PSSDDIEN=$P(PSSNODD,U,2)
  1. ; If the dispense drug is defined, then verify if PSSDDIEN existed
  1. I 'PSSDCFLG,+$G(PSSDDIEN),$D(^PS(51.1,+PSSIEN,4,"B",+PSSDDIEN)) S PSSDCFLG=1
  1. I 'PSSDCFLG Q ""
  1. I $G(PSSFWDRL)]"" S PSSFRQF=$P($G(^PS(51.1,PSSIEN,0)),"^",3),PSSDCF1=$$DCFSCHD(PSSIEN,PSSFWDRL,PSSDCF,PSSFRQF) Q $S($G(PSSDCF1)]"":PSSDCF1,1:"")_U_PSSDCF
  1. Q $S($G(PSSDCF1)]"":PSSDCF1,1:PSSDCF)_U_PSSDCF
  1. ;
  1. DCFSCHD(PSSIEN,PSSFWDRL,PSSDCF,PSSFRQF) ;Adjusting the frequency based on the order duration
  1. ;PSSDRL - The order duration (in minute)
  1. ;PSSFRQF - Frequency value from 51 or 51.1
  1. ;Return the adjusted frequency
  1. ;Note - the frequency is rounded up when needed. (ex: Q4H for 6 hours (order duration), the frequency = 2;
  1. ; the reason is that the pt received dose 1 in the first hour and 2nd dose 4 hours later.
  1. NEW PSSDRL,PSSFRQ,PSSDCFN,PSSDCFD,PSSDCF1
  1. Q:$G(PSSDCF)="" ""
  1. Q:$G(PSSFWDRL)="" ""
  1. S PSSDRL=$$DRT^PSSDSAPD(PSSFWDRL)
  1. I PSSDRL'<1440 Q ""
  1. S PSSDCF1=""
  1. ; Adjust frequency for Q#H
  1. I PSSDCF?1"Q"1N.N1"H" D Q PSSDCF1
  1. . S PSSDCFN=+$E(PSSDCF,2,$L(PSSDCF))*60
  1. . S PSSDCFD=PSSDRL/PSSDCFN
  1. . I PSSDCFD<1 S PSSDCF1="" Q
  1. . S PSSDCF1=$S((PSSDCFD?.N):PSSDCFD,1:$J((PSSDCFD+.5),0,0))
  1. ; Adjust frequency for X#D (# per day)
  1. I +$G(PSSFRQF),(PSSDCF?1"X"1N.N1"D") D Q PSSDCF1
  1. . I '+$G(PSSIEN) S PSSDCF1="" Q
  1. . S PSSFRQ=PSSDRL/PSSFRQF
  1. . S PSSFRQ=$S((PSSFRQ?.N):PSSFRQ,1:$J((PSSFRQ+.5),0,0))
  1. . S (PSSDCFN,PSSDCF1)=+$E(PSSDCF,2,$L(PSSDCF))
  1. . I PSSDCFN>PSSFRQ S PSSDCF1=PSSFRQ
  1. Q $G(PSSDCF1)
  1. ;
  1. DCF51(PSSIEN,PSSDDIEN,PSSFWDRL) ;Dosing Check Frequency process for Med Instruction file
  1. ;Input:
  1. ; PSSIEN - IEN from 51
  1. ; PSSDDIEN - IEN from file 50
  1. ; PSSFWDRL - Order duration
  1. ;Output:
  1. ; PSSDCF - P1(adjust if order duration is passed in)^P2(#51 - 0;9)
  1. ;
  1. Q:'+$G(PSSIEN) ""
  1. NEW PSSDCF,PSSDCFLG,PSSDCF1,PSSFRQF
  1. S PSSDCFLG=0
  1. S PSSDCF=$P($G(^PS(51,+PSSIEN,0)),U,9)
  1. Q:PSSDCF="" ""
  1. ; check if the dispense drug is specified in 51
  1. I '$O(^PS(51,+PSSIEN,5,0)) S PSSDCFLG=1
  1. I 'PSSDCFLG,+$G(PSSDDIEN),$D(^PS(51,+PSSIEN,5,"B",+PSSDDIEN)) S PSSDCFLG=1
  1. I 'PSSDCFLG Q ""
  1. I $G(PSSFWDRL)]"" S PSSFRQF=$P($G(^PS(51,PSSIEN,0)),U,8),PSSDCF1=$$DCFSCHD(PSSIEN,PSSFWDRL,PSSDCF,PSSFRQF)
  1. Q $S($G(PSSDCF1)]"":PSSDCF1,1:PSSDCF)_U_PSSDCF
  1. ;
  1. MULTSCH(PSSMSCH,PSSFWFR,PSSFWPK,PSSFWDRL) ;Return Frequency for PSSMSCHD with multi schedules
  1. ;Piece out each word (schedule) in PSSMSCH
  1. ;PSSMSCH - Multi-schedules
  1. ;PSSFWSCC - Single schedule (pieced out)
  1. ;PSSFRQ - Return 2 pieces - p1 = adjusted frequency (duration); p2 = the frequency
  1. ;It is necessary to set PSSDBAR("TYPE")="SINGLE DOSE" when the schedule is determined for "Once" or "ONCALL".
  1. ;PSSDBAR array came from DOSE^PSSDSAPD
  1. NEW PSSFRQ,PSSFWSCC,PSSDOW,PSSDOWAT,PSSONCE,PSSODRL,PSSOSCH,PSSOUT1,PSSOUTD,PSSOUTX,PSSP1,PSSX
  1. S PSSFRQ="^",PSSONCE=0,PSSDOW=0,PSSODRL=$G(PSSFWDRL),PSSOSCH=""
  1. I $G(PSSMSCH)="" Q "^"
  1. F PSSX=1:1:$L(PSSMSCH," ") S PSSFWSCC=$P(PSSMSCH," ",PSSX) D Q:PSSONCE
  1. . I $G(PSSFWSCC)="" S PSSFRQ="^"
  1. . S PSSFWSCC=$$ADDAT(PSSFWSCC)
  1. . I $$ONETIME(PSSFWSCC) S PSSONCE=1 Q
  1. . I PSSFWSCC["@" S PSSFWFR="D",PSSDOW=1
  1. . ; $$FRQZ^PSSDSAPI needs PSSFWFR="D" for DOW schedule
  1. . S PSSOUT1=$$FRQZ^PSSDSAPI()
  1. . ;I PSSFWSCC["@" S PSSDOWAT=PSSOUT1
  1. . I PSSFWSCC["@" S:$G(PSSOUT1)]"" PSSOUTD(PSSOUT1,PSSFWSCC)=""
  1. . I PSSOUT1]"" S PSSOUTX(PSSOUT1,PSSFWSCC)="" S:PSSOSCH="" PSSOSCH=PSSFWSCC
  1. ;
  1. I $G(PSSONCE) S PSSDBAR("TYPE")="SINGLE DOSE" Q "1^1"
  1. I $D(PSSOUTD) D Q $S($G(PSSP1)]"":PSSP1_"^"_PSSP1,1:"^")
  1. . S PSSP1=$O(PSSOUTD("")) I $O(PSSOUTD(PSSP1))]"" S PSSP1="" Q
  1. ; Check if the schedules have the same frequency.
  1. S PSSP1=$O(PSSOUTX("")) I $O(PSSOUTX(PSSP1))]"" Q "^"
  1. I $G(PSSFWDRL)="" Q PSSP1_U_PSSP1
  1. ; Get the frequency for piece 2 without the duration factor in
  1. I $G(PSSP1)]"",($G(PSSFWDRL)]""),($G(PSSOSCH)]"") S PSSFWDRL="",PSSFWSCC=PSSOSCH,PSSFRQ=PSSP1_U_$$FRQZ^PSSDSAPI(),PSSFWDRL=PSSODRL
  1. Q PSSFRQ
  1. ONETIME(PSSSCHD) ;check for one-time, now, oncall schedules
  1. ;Return 1 if schedule is one-time, now
  1. ; 0 if not
  1. NEW PSSX,PSSASIEN,PSSOUT
  1. I $G(PSSSCHD)="" Q 0
  1. S PSSOUT=0
  1. F PSSASIEN=0:0 S PSSASIEN=$O(^PS(51.1,"APPSJ",PSSSCHD,PSSASIEN)) Q:'PSSASIEN D Q:PSSOUT
  1. . S PSSX=$P($G(^PS(51.1,PSSASIEN,0)),U,5)
  1. . S:PSSX="O"!(PSSX="OC") PSSOUT=1
  1. Q PSSOUT
  1. ;
  1. DOWAT(PSSFWSCC,PSSDDIEN) ;
  1. ;Process day of week with admin times (ex SU-MO@12)
  1. NEW PSSIEN,PSSSCH1,PSSSCH2
  1. Q:$G(PSSFWSCC)="" ""
  1. S PSSSCH1=$P(PSSFWSCC,"@"),PSSSCH2=$P(PSSFWSCC,"@",2)
  1. S PSSIEN=$$DOWIEN(PSSFWSCC,PSSSCH1,PSSSCH2)
  1. I 'PSSIEN S PSSIEN=$$DOWIEN(PSSSCH1_"@"_PSSSCH2,PSSSCH1,PSSSCH2)
  1. I 'PSSIEN S PSSIEN=$$DOWIEN(PSSSCH1_"@"_$$AT(PSSSCH2,2),PSSSCH1,PSSSCH2)
  1. I 'PSSIEN S PSSIEN=$$DOWIEN(PSSSCH1_"@"_$$AT(PSSSCH2,4),PSSSCH1,PSSSCH2)
  1. I 'PSSIEN S PSSIEN=$$DOWIEN(PSSSCH1,PSSSCH1,PSSSCH2)
  1. I 'PSSIEN Q ""
  1. ;Get DCF(the order duration is ignored when it's DOW schedule)
  1. Q $$DCFSCH(PSSIEN,$G(PSSDDIEN))
  1. ;
  1. DOWIEN(PSSSCH,PSSSCH1,PSSSCH2) ;
  1. ;Return 51.1 IEN (if more than one matched, return the DOW, else the first matched)
  1. NEW PSSIEN,PSSX,PSSFLG
  1. Q:$G(PSSSCH)="" ""
  1. S PSSIEN=0,PSSFLG=0
  1. F PSSX=0:0 S PSSX=$O(^PS(51.1,"APPSJ",PSSSCH,PSSX)) Q:'PSSX D Q:PSSFLG
  1. . I '$$SCHAT(PSSX,$G(PSSSCH1),$G(PSSSCH2)) Q
  1. . ; store the first IEN found
  1. . I 'PSSIEN S PSSIEN=PSSX
  1. . I $P($G(^PS(51.1,PSSX,0)),U,5)="D" S PSSIEN=PSSX,PSSFLG=1 Q
  1. Q PSSIEN
  1. ;
  1. AT(PSSAT,PSSDIG) ;return admin time(s) in 2 or 4 digits format
  1. ;PSSDIG - set admin time to 2 digits or 4 digits format (ex: 09 or 0900)
  1. NEW PSSY,PSSX
  1. Q:$G(PSSAT)="" ""
  1. I '+$G(PSSDIG) S PSSDIG=4
  1. S PSSX=""
  1. F PSSY=1:1:$L(PSSAT,"-") S PSSX=PSSX_$S(PSSX="":"",1:"-")_$E($P(PSSAT,"-",PSSY)_"0000",1,PSSDIG)
  1. Q PSSX
  1. ;
  1. SCHAT(PSSIEN,PSSSCH1,PSSSCH2) ;return PSSIEN from 51.1 for DOW
  1. NEW PSSFL1,PSSFL2,PSSAT,PSSIEN0
  1. Q:'+$G(PSSIEN) 0
  1. S PSSIEN0=$G(^PS(51.1,PSSIEN,0))
  1. S PSSAT=$P(PSSIEN0,U,2),(PSSFL1,PSSFL2)=0
  1. ; Return IEN if there is no admin time define and schedule matched .01
  1. I (PSSAT=""),($G(PSSSCH1)_"@"_$G(PSSSCH2))=$P(PSSIEN0,U) Q PSSIEN
  1. I (PSSAT=""),($G(PSSSCH1)_"@"_$$AT($G(PSSSCH2),2))=$P(PSSIEN0,U) Q PSSIEN
  1. I (PSSAT=""),($G(PSSSCH1)_"@"_$$AT($G(PSSSCH2),4))=$P(PSSIEN0,U) Q PSSIEN
  1. ; If admin is not defined in 51.1 but was entered with order
  1. I (PSSAT=""),(PSSSCH2]"") S PSSFL1=1
  1. ; There maybe multiple entries with the same DOW. Tried to find the one with the same admin time
  1. ; Check for schedule and admin times from 51.1(in 2 & 4 digit format) matched to the admin time entered for the order
  1. I (PSSAT]""),($G(PSSSCH1)_"@"_$$AT(PSSAT,2))'=($G(PSSSCH1)_"@"_$$AT($G(PSSSCH2),2)) S PSSFL1=1
  1. I (PSSAT]""),($G(PSSSCH1)_"@"_$$AT(PSSAT,4))'=($G(PSSSCH1)_"@"_$$AT($G(PSSSCH2),4)) S PSSFL1=1
  1. ; Only return PSSIEN if the schedule and admin time from 51.1 matched order's Admin time
  1. I PSSFL1 S PSSIEN=0
  1. Q PSSIEN
  1. ADDAT(PSSFWSCC) ;concatenate admin times from 51.1 to the schedule name for DOW
  1. ;PSSFWSCC - Schedule name
  1. NEW PSSASIEN,PSSX,PSSXFG
  1. I $G(PSSFWSCC)="" Q ""
  1. S PSSXFG=0
  1. F PSSASIEN=0:0 S PSSASIEN=$O(^PS(51.1,"APPSJ",PSSFWSCC,PSSASIEN)) Q:'PSSASIEN D Q:PSSXFG
  1. . I PSSFWSCC["@" S PSSXFG=1 Q
  1. . S PSSX=$G(^PS(51.1,PSSASIEN,0))
  1. . I $P(PSSX,U,5)'="D" S PSSXFG=1 Q
  1. . I $P(PSSX,U,2)]"" S PSSFWSCC=PSSFWSCC_"@"_$P(PSSX,U,2) S PSSXFG=1
  1. Q PSSFWSCC
  1. CONVSCH(PSSFRQ) ;Convert numeric frequency to a schedule
  1. ;PSSFRQ - Frequency in minutes
  1. ;Return null or Schedule_0/1
  1. I '+$G(PSSFRQ) Q ""
  1. NEW PSSFWBAM,PSSFWBMN,PSSFWBNM,PSSFWRST,PSSFWBWK,PSSFWBXW,PSSFWBXL,PSSFWFLG
  1. S PSSFWFLG=0
  1. S PSSFWBAM=PSSFRQ/1440
  1. I PSSFWBAM'?.N Q ""
  1. I PSSFWBAM?.N D Q PSSFWRST_U_PSSFWFLG
  1. .S PSSFWBMN=PSSFWBAM/30 I PSSFWBMN?.N S PSSFWFLG=1,PSSFWRST="Q"_PSSFWBMN_"L" Q
  1. .S PSSFWBWK=PSSFWBAM/7 I PSSFWBWK?.N S PSSFWFLG=1,PSSFWRST="Q"_PSSFWBWK_"W" Q
  1. .S PSSFWFLG=1,PSSFWRST="Q"_PSSFWBAM_"D" Q
  1. I PSSFRQ'>10080 S PSSFWBXW=10080/PSSFRQ I PSSFWBXW?.N S PSSFWFLG=1,PSSFWRST="X"_PSSFWBXW_"W" Q PSSFWRST_U_PSSFWFLG
  1. S PSSFWBXL=43200/PSSFRQ I PSSFWBXL?.N S PSSFWFLG=1,PSSFWRST="X"_PSSFWBXL_"L" Q PSSFWRST_U_PSSFWFLG
  1. Q ""
  1. NOTALLDD(PSSGTOI,PSSIEN) ;When only OI is sent from CPRS, all DDs must be defined in 51.1 in order for the DCF value to be used.
  1. ;PSSNOTDD=1 if not all dispense drugs are defined in in 51.1 and the last good DD
  1. ;PSSGOI - Orderable Item
  1. ;PSSIEN - 51.1 ien
  1. NEW PSSDD,PSSDDIEN,PSSDDACT,PSSNODD
  1. Q:'+$G(PSSGTOI) 0
  1. Q:'+$G(PSSIEN) 0
  1. I '$O(^PS(51.1,+PSSIEN,4,0)) Q 0 ;PSS*1*231 Correct issue with orphan 0 node
  1. S PSSNODD=0
  1. F PSSDDIEN=0:0 S PSSDDIEN=$O(^PSDRUG("ASP",PSSGTOI,PSSDDIEN)) Q:'PSSDDIEN!PSSNODD D
  1. .I $$EXMT^PSSDSAPI(PSSDDIEN) Q
  1. .S PSSDDACT=$P($G(^PSDRUG(PSSDDIEN,"I")),"^") I PSSDDACT,PSSDDACT<DT Q
  1. .S PSSDD=PSSDDIEN
  1. .I '$D(^PS(51.1,+PSSIEN,4,"B",+PSSDDIEN)) S PSSNODD=1
  1. Q PSSNODD_U_$G(PSSDD)
  1. CHKIPDUR() ;Check if CPRR IP has a duration <24hrs
  1. ;*************************************************************************
  1. ;*** MOCHA 2.1b - only perform daily dose if it is not a complex order ***
  1. ;*************************************************************************
  1. ;This is for CPRS IP order
  1. ;Check: only one sequence(not complex); EFD (expected first dose); Duration <24h;
  1. ;Return: 0 or 1^# of dose(s) for admin times within the duration.
  1. NEW PSSDUR,PSSADMIN,PSSDSCNT,PSSX
  1. I '$D(PSSDBFDB)!'$D(PSSDBDS) Q 0
  1. I $O(PSSDBFDB(1)) Q 0
  1. I $G(PSSDBFDB("PACKAGE"))'="I" Q 0
  1. I $G(PSSDBDS(1,"EFD"))="" Q 0
  1. S PSSX=$G(PSSDBDS(1,"DRATE"))
  1. S PSSDUR=$S((PSSX["H"):(+PSSX*60),(PSSX["M"):+PSSX,1:0)
  1. I 'PSSDUR Q 0
  1. I PSSDUR'<1440 Q 0
  1. S PSSADMIN=$$ADMIN($G(PSSDBDFN),$G(PSSDBDS(1,"SCHEDULE")))
  1. I PSSADMIN="" Q 0
  1. S PSSDSCNT=$$DOSECNT^PSSSCHMS(PSSDBDS(1,"EFD"),PSSADMIN,PSSDUR)
  1. Q 1_U_PSSDSCNT
  1. ADMIN(DFN,PSSSCHD) ;Determine if admin times for the ward should be used
  1. NEW VAIN,PSSWARD,PSSIEN,PSSADM,PSSWDADM
  1. I $G(PSSSCHD)="" Q ""
  1. ;I '+$G(DFN) Q ""
  1. D:+$G(DFN) INP^VADPT
  1. S PSSWARD=+$G(VAIN(4))
  1. S (PSSADM,PSSWDADM)=""
  1. F PSSIEN=0:0 S PSSIEN=$O(^PS(51.1,"APPSJ",PSSSCHD,PSSIEN)) Q:(PSSIEN="")!(PSSWDADM]"") D
  1. . S:PSSADM="" PSSADM=$P($G(^PS(51.1,PSSIEN,0)),U,2)
  1. . S PSSWDADM=$P($G(^PS(51.1,PSSIEN,1,+PSSWARD,0)),U,2)
  1. I PSSWDADM]"" Q PSSWDADM
  1. Q PSSADM
  1. DOSECNT(PSSEFD,PSSAT,PSSDUR) ;count # of dose for duration <24h
  1. ;PSSEFD - Expected First Dose (dt.time)^Admin times from CPRS
  1. ;PSSDUR - duration in minutes
  1. ;Calculate # of doses for CPRS IP order with a duration
  1. ;Return p1^p2 (p1=0 unable to figure, 1 use p2 for count; p2=# doses need for this duration)
  1. NEW PSSEDT,PSSCNT,PSSSTRTM,PSSSTPTM,PSSDTFLG,PSSADMIN,PSSX
  1. Q:$G(PSSEFD)="" 0
  1. Q:$G(PSSAT)="" 0
  1. Q:'+$G(PSSDUR) 0
  1. S PSSEDT=$$FMADD^XLFDT(PSSEFD,,,+PSSDUR)
  1. S PSSCNT=0
  1. S PSSSTRTM=$E($P(PSSEFD,".",2)_"0000",1,4)
  1. S PSSSTPTM=$E($P(PSSEDT,".",2)_"0000",1,4)
  1. S PSSDTFLG=0
  1. I $P(PSSEFD,".")=$P(PSSEDT,".") S PSSDTFLG=1
  1. F PSSX=1:1 S PSSADMIN=$P(PSSAT,"-",PSSX) Q:PSSADMIN="" D
  1. . S PSSADMIN=$E($P(PSSAT,"-",PSSX)_"0000",1,4)
  1. . I PSSDTFLG D Q
  1. .. I (PSSSTRTM'>PSSADMIN),(PSSADMIN<PSSSTPTM) S PSSCNT=PSSCNT+1
  1. . I (PSSSTRTM'>PSSADMIN) S PSSCNT=PSSCNT+1
  1. . I (PSSSTPTM>PSSADMIN) S PSSCNT=PSSCNT+1
  1. Q PSSCNT
  1. SCHD ;^PSSDSAPD is too big - move it here.
  1. N PSSDBSCD,PSSDBSCP,PSSDBSCF,PSSDBSCG,PSSDBSCH,PSSDCF
  1. S PSSDBAR("FREQ")=""
  1. ;I $D(PSSDBFDB(PSSDBLP,"FREQ")) S PSSDBAR("FREQ")=PSSDBFDB(PSSDBLP,"FREQ") Q
  1. I PSSDBAR("TYPE")="SINGLE DOSE" S PSSDBAR("FREQ")="" Q
  1. ;I $G(PSSDBDS(PSSDBLP,"DRATE"))'="",$$DRT(PSSDBDS(PSSDBLP,"DRATE"))<1440 S PSSDBSDR=1
  1. S PSSDBSCD=$G(PSSDBDS(PSSDBLP,"SCHEDULE"))
  1. I PSSDBSCD="",'$D(PSSDBFDB(PSSDBLP,"FREQ")) S PSSDBCAZ(PSSDBFDB(PSSDBLP,"RX_NUM"),"FRQ_ERROR")="" Q
  1. S (PSSDBSCF,PSSDBSCH)="" S PSSDBSCP=$P(PSSDBFDB(PSSDBLP,"RX_NUM"),";")
  1. I $G(PSSDBSCD)'="" F PSSDBSCG=0:0 S PSSDBSCG=$O(^PS(51.1,"APPSJ",PSSDBSCD,PSSDBSCG)) Q:'PSSDBSCG!(PSSDBSCH) D
  1. .I $P($G(^PS(51.1,PSSDBSCG,0)),"^",5)="D" S PSSDBSCF="D"
  1. .I $P($G(^PS(51.1,PSSDBSCG,0)),"^",5)="O"!($P($G(^PS(51.1,PSSDBSCG,0)),"^",5)="OC") S PSSDBSCH=1
  1. I PSSDBSCH,'$D(PSSDBFDB(PSSDBLP,"FREQ")) S PSSDBAR("FREQ")=1 Q
  1. I $G(PSSDBSCD)["@" S PSSDBSCF="D"
  1. I $G(PSSDBSCD)'="" D
  1. . S PSSDBSCP=$S(PSSDBSCP="I":"I",1:"O")
  1. . S PSSDBAR("FREQZZ")=$$FRQ^PSSDSAPI(PSSDBSCD,PSSDBSCF,PSSDBSCP,$G(PSSDBDS(PSSDBLP,"DRATE")),$G(PSSDBFDB(PSSDBLP,"DRUG_IEN")))
  1. . S PSSDCF=$P(PSSDBAR("FREQZZ"),U,2)
  1. . I PSSDCF?1"X"1N.N1"D" S PSSDBAR("FREQZZ")=PSSDCF_U_PSSDCF,PSSDBFDB(PSSDBLP,"FREQ")=PSSDCF
  1. . S PSSDBAR("FREQ")=$P(PSSDBAR("FREQZZ"),"^")
  1. I $D(PSSDBFDB(PSSDBLP,"FREQ")) S PSSDBAR("FREQ")=PSSDBFDB(PSSDBLP,"FREQ") Q
  1. S:PSSDBAR("FREQ")="" PSSDBCAZ(PSSDBFDB(PSSDBLP,"RX_NUM"),"FRQ_ERROR")=""
  1. Q