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