- PSSDSEXC ;BIR/RTR-Exceptions for Dose call ;02/24/09
- ;;1.0;PHARMACY DATA MANAGEMENT;**117,160,178,206,224**;9/30/97;Build 3
- ;
- ;Called from PSSDSAPD, this routine takes the results from the call to First DataBank and creates displayable TMP
- ;globals for the calling applications. Typically, PSSDBASA indicates a CPRS call, and PSSDBASB indicates a pharmacy call
- ;
- ;PSSDBCAR ARRAY pieces, set mostly in PSSDSAPD and a few other rotuines:
- ;1 = S for Single Dose, D for Daily Dose, B for Both
- ;2 = Drug Name
- ;3 = Drug Internal Entry Number
- ;4 = Frequency Flag
- ;5 = 1 for Maintenance Dose, 0 for Single Dose
- ;6 = 1 to only Show General information (Or General Dose error) and errors (No Single Dose or Daily DOse Messages)
- ;7 = 1 To NEVER show General Dosing information, overrides piece 8
- ;8 = 1 Show General Dosing Guidelines even though piece 1 = "S"
- ;9 = FDB ROUTE
- ;10 = 1 to show General Dosing exception in place of General Dosing information when no General Dosing Information exists
- ;11 = 1 to indicate to show the Daily Dose Error message, (generally screened out in this case)
- ; because you added up previous Dosages at this Dosing Sequence,
- ;12 = 1 to screen out frequency exceptions
- ;13 = 1, set in this routine and PSSDSAPD, to indicate the need to show the generic exception message
- ;14 = 1 to exclude from all Dose checks based on Schedule
- ;15 = 1 to exclude from Daily Dose check based on Schedule
- ;16 = 1 to indicate this Dosing sequence is part of a complex order
- ;17 = 1 to indicate a GCNSECNQ number problem
- ;18 = 1 to indicate there is an Input Exception
- ;19 = 1 to indicate missing age
- ;20 = 1 to indicate Free Text Dose can't be evaluated
- ;21 = 1 to indicate Free Text Infusion Rate exception
- ;22 = 1 to indicate FDB Warning exists
- ;23 = 1 for missing Dose Route or Dose Type
- ;24 = 1 Indicates Single Dose message or error/exception was shown, and no Daily message **Added for 2.1 **
- ;25 = 1 Indicates missing weight for drug requiring weight
- ;26 = 1 Indicates missing BSA for drug requiring BSA
- ;27 = 1 Indicates a 2.1 Drug or Order level message tweak was done in PSSDSEXD
- ;28 = 1 Indicates in 2.1 show custom max daily dose message
- ;29 = 1 Indicates in 2.1 max daily dose frequency out of range, show custom frequency message
- ;30 = 1 Indicates in 2.1 NotScreened message tweak in CHECKMSG^PSSDSEXD
- ;31 = 1 Indicates doseRouteDescription is null (Invalid Route passed into FDB)
- ;32 = Text to append to errors/exceptions if Piece 31 is 1
- ;33 = 1 Indicates in 2.1 Dummy Data is being used for call to FDB
- ;34 = 1 to indicate unableToCheck MaxSingleDose
- ;35 = 1 to indicate unableToCheck MaxDailyDose
- ;
- ;PSSDBCAX holds the errors to show
- ;
- ;2.1 PSSDBSNO checks added - if 0, all schedule are excluded from Doising checks
- FMT ;PSSDBDGO =1 if you went to interface, 0 if you did not go to interface; PSSDBSNO IS 0 if all schedules are excluded
- N PSSDWLP,PSSDWL1,PSSDWLPV,PSSDWRSN
- I PSSDBASA,PSSDBDGO,PSSDBSNO S ^TMP($J,PSSDBASF,"OUT",0)=^TMP($J,PSSDBASE,"OUT",0)
- I PSSDBASB,PSSDBDGO,PSSDBSNO S ^TMP($J,PSSDBASG,"OUT",0)=^TMP($J,PSSDBASE,"OUT",0)
- I $P($G(^TMP($J,PSSDBASE,"OUT",0)),"^")=-1 Q
- ;
- ;
- ;Set errors
- S PSSDWLP="" F S PSSDWLP=$O(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP)) Q:PSSDWLP="" D:'$P(PSSDWLP,";",5)&('$P(PSSDBCAR(PSSDWLP),"^",14)) ;2.1 piece 14 check added
- .D CKWRN^PSSDSAPK F PSSDWL1=0:0 S PSSDWL1=$O(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1)) Q:'PSSDWL1 D NOTS^PSSDSAPA D:'$$ERR1^PSSDSAPK
- ..I $P(PSSDBCAR(PSSDWLP),"^",22),$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"SEV"))'="Warning" Q
- ..I '$P(PSSDBCAR(PSSDWLP),"^",22) I $P(PSSDBCAR(PSSDWLP),"^",19)!$P(PSSDBCAR(PSSDWLP),"^",20)!$P(PSSDBCAR(PSSDWLP),"^",21) Q
- ..S $P(PSSDBCAR(PSSDWLP),"^",24)=1 D RTEXT^PSSDSUTL(PSSDWLP,0) ;2.1
- ..I $G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))'="" D
- ...I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
- ...I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
- ..I $G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT"))'="" S PSSDWLPV=$S($G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"SEV"))="Warning":0,1:1) D
- ...I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=$S(PSSDWLPV:PSSDWRSN,1:"")_$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")) D:'PSSDWLPV
- ....S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"WARN")="Warning"
- ...I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")=$S(PSSDWLPV:PSSDWRSN,1:"")_$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")) D:'PSSDWLPV
- ....S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"WARN")="Warning"
- ;
- ;
- I PSSDBSNO D EXCP
- I PSSDBSNO D MESQ
- I 'PSSDBDGO!(PSSDBSNO) D
- .I PSSDBASA D Q
- ..I $D(^TMP($J,PSSDBASF,"OUT")) S ^TMP($J,PSSDBASF,"OUT",0)=1 Q
- ..S ^TMP($J,PSSDBASF,"OUT",0)=0
- .I PSSDBASB D Q
- ..I $D(^TMP($J,PSSDBASG,"OUT")) S ^TMP($J,PSSDBASG,"OUT",0)=1 Q
- ..S ^TMP($J,PSSDBASG,"OUT",0)=0
- Q
- ;
- ;
- EXCP ;Set Exceptions
- N PSSDWE1,PSSDWE2,PSSDWE3,PSSDWE4,PSSDWEE1,PSSDWEE2,PSSDWEX1,PSSDWEX2,PSSDWEX3,PSSDWEX4,PSSDWEX5,PSSDWEX6,PSSDWEX7,PSSDWSR1,PSSDWSR2,PSSDWSR3,PSSDWER1,PSSDWER2,PSSDWEGC,PSSDWER9,PSSNOE9,PSSDWEEX
- S PSSDWEX3="" F S PSSDWEX3=$O(PSSDBCAR(PSSDWEX3)) Q:PSSDWEX3="" D ADOSE^PSSDSAPK D:'$P(PSSDBCAR(PSSDWEX3),"^",14) ;2.1 Piece 14 check added
- .I '$O(PSSDBCAX(PSSDWEX3,0)) Q
- .S PSSDWEX4=0 F PSSDWEX7=0:0 S PSSDWEX7=$O(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX7)) Q:'PSSDWEX7 S PSSDWEX4=PSSDWEX7
- .S PSSDWEX4=PSSDWEX4+1
- .F PSSDWEX5=0:0 S PSSDWEX5=$O(PSSDBCAX(PSSDWEX3,PSSDWEX5)) Q:'PSSDWEX5 I PSSDWEX5=2!(PSSDWEX5=3)!(PSSDWEX5>11) D
- ..I $P(PSSDBCAR(PSSDWEX3),"^",19)!($P(PSSDBCAR(PSSDWEX3),"^",20)) Q
- ..I $P(PSSDBCAR(PSSDWEX3),"^",21) I PSSDWEX5'=3,PSSDWEX5'=12,PSSDWEX5'=13,PSSDWEX5'=14 Q
- ..S PSSDWEX6=$T(ERROR+PSSDWEX5) S PSSDWSR1=$P(PSSDWEX6,";;",4) S $P(PSSDBCAR(PSSDWEX3),"^",24)=1 ;piece 24 added for 2.1
- ..S ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)="^^^^^^"_$S(PSSDWSR1:"Daily Dose Range Check Error Summary for Drug: ",1:"Dosing Checks could not be performed for Drug: ")_$P(PSSDBCAR(PSSDWEX3),"^",2)_"^^^" D DSQ
- ..S PSSDWEX4=PSSDWEX4+1
- ;
- ;
- ;Loop through EXCEPTION global, call RESET if Free Text Dosage error exists and EXCEPTION from interface exists, then set 2 processing global outputs
- K PSSDWE3
- S PSSDWE1="" F S PSSDWE1=$O(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1)) Q:PSSDWE1="" D NOEXP^PSSDSAPK I '$D(PSSNOE9(PSSDWE1)) S PSSDWEX1(PSSDWE1)="" D:$D(PSSDBCAX(PSSDWE1,1)) RESET D
- .I $P(PSSDBCAR(PSSDWE1),"^",22)!($P(PSSDBCAR(PSSDWE1),"^",14)) Q ;2.1 piece 14 check added
- .S PSSDWE4=1,(PSSDWSR3,PSSDWER1,PSSDWER2,PSSDWER9)=0
- .S PSSDWEE1=$P($G(PSSDBCAR(PSSDWE1)),"^",2),PSSDWEE2=$P($G(PSSDBCAR(PSSDWE1)),"^",3)
- .D RTEXT^PSSDSUTL(PSSDWE1,1)
- .F PSSDWE2=0:0 S PSSDWE2=$O(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)) Q:'PSSDWE2 S PSSDWSR2=$S($P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2),"^",7)["Summary":1,1:0) D
- ..S PSSDWEGC=$P($G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10) I $$ERR2^PSSDSAPK Q
- ..I $P(PSSDBCAR(PSSDWE1),"^",19),PSSDWEGC'["patient parameters" Q
- ..I '$P(PSSDBCAR(PSSDWE1),"^",19),$P(PSSDBCAR(PSSDWE1),"^",23),PSSDWEGC'["Dose Type",PSSDWEGC'["Dose Route" Q
- ..S $P(PSSDBCAR(PSSDWE1),"^",24)=1 ;2.1
- ..I 'PSSDWSR2 D Q
- ...I PSSDWE4=1 D S PSSDWE4=2
- ....I PSSDBASA D HDER1
- ....I PSSDBASB D HDER2
- ...I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)=$S('PSSDWER1:PSSDWRSN,1:" ")_$P($G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10) I PSSDWEGC'["Frequency",PSSDWER9 D HDER3
- ...I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)=$S('PSSDWER1:PSSDWRSN,1:" ")_$P($G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10) I PSSDWEGC'["Frequency",PSSDWER9 D HDER4
- ...S PSSDWE4=PSSDWE4+1,PSSDWER1=1
- ..I 'PSSDWSR3 D S PSSDWE4=PSSDWE4+1
- ...S PSSDWSR3=1
- ...I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)=$P($G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",7)
- ...I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)=$P($G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",7)
- ..I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)=$S('PSSDWER2:PSSDWRSN,1:" ")_$P($G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10)
- ..I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)=$S('PSSDWER2:PSSDWRSN,1:" ")_$P($G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10)
- ..S PSSDWE4=PSSDWE4+1,PSSDWER2=1
- ;
- ;
- ;If Free Text error message existed, but no Exception came back from Interface set the Free Text exception
- S PSSDWEX2="" F S PSSDWEX2=$O(PSSDBCAR(PSSDWEX2)) Q:PSSDWEX2="" I '$P(PSSDBCAR(PSSDWEX2),"^",19),'$P(PSSDBCAR(PSSDWEX2),"^",22),'$P(PSSDBCAR(PSSDWEX2),"^",14) D ;2.1 piece 14 check added
- .I '$D(PSSDWEX1(PSSDWEX2)),$D(PSSDBCAX(PSSDWEX2,1)),'$D(PSSNOE9(PSSDWEX2)) D
- ..S $P(PSSDBCAR(PSSDWEX2),"^",24)=1,PSSDWEEX=$S('$P(PSSDBCAR(PSSDWEX2),"^",15)&('$P(PSSDBCAR(PSSDWEX2),"^",16))&($P(PSSDBCAR(PSSDWEX2),"^",5)):"Dosing Checks",1:"Maximum Single Dose Check") ;2.1
- ..D RTEXT^PSSDSUTL(PSSDWEX2,1)
- ..I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=PSSDWEEX_" could not be done for Drug: "_$P(PSSDBCAR(PSSDWEX2),"^",2) ;2.1 change
- ..I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=PSSDWEEX_" could not be performed for Drug: "_$P(PSSDBCAR(PSSDWEX2),"^",2) ;2.1 change
- ..I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=PSSDWRSN_"Free Text Dosage could not be evaluated"
- ..I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=PSSDWRSN_"Free Text Dosage could not be evaluated"
- ..S ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)="^^^^^^Dosing Checks could not be performed for Drug: "_$P(PSSDBCAR(PSSDWEX2),"^",2)_"^^^"_"Free Text Dosage could not be evaluated"
- D CONTINUE^PSSDSEXD ;; Mocha 2.1 Drug Level Message tweaks ;;
- Q
- ;
- ;
- MESQ ;Set Messages
- N PSSDWE5,PSSDWDRG,PSSDWIEN,PSSDWGFB,PSSDWSPS,PSSDWADJ
- S PSSDWE5="" F S PSSDWE5=$O(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5)) Q:PSSDWE5="" I $D(PSSDBCAR(PSSDWE5)),'$P(PSSDBCAR(PSSDWE5),"^",14) D ;2.1 piece 14 check added
- .S PSSDWDRG=$P(PSSDBCAR(PSSDWE5),"^",2),PSSDWIEN=$P(PSSDBCAR(PSSDWE5),"^",3),PSSDWADJ=0 Q:PSSDWDRG=""!('PSSDWIEN)
- .I $G(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","STATUSCODE",PSSDWIEN))=5 S $P(PSSDBCAR(PSSDWE5),"^",13)=1
- .I $P(PSSDBCAR(PSSDWE5),"^")="S" D:'$P(PSSDBCAR(PSSDWE5),"^",6) SING D:$P(PSSDBCAR(PSSDWE5),"^",6)!($P(PSSDBCAR(PSSDWE5),"^",8)) GEN Q
- .S PSSDWGFB=0 I $P(PSSDBCAR(PSSDWE5),"^")="D" D:'$P(PSSDBCAR(PSSDWE5),"^",6) DAILY D Q ;line broken up and piece 24 check added at end
- ..I $$SHOGEN D GEN
- .D SING,DAILY I $$SHOGEN D GEN
- Q
- ;
- ;
- SHOGEN() ;General Dosing Guidelines - Piece 25 and piece 15 check added for 2.1
- I $P(PSSDBCAR(PSSDWE5),"^",16)!($P(PSSDWE5,";",5)) Q 0 ;complex orders, remove in 2.2
- I PSSDWGFB!('$P(PSSDBCAR(PSSDWE5),"^",4))!($D(PSSDBCAX(PSSDWE5,1)))!($P(PSSDBCAR(PSSDWE5),"^",8))!($P(PSSDBCAR(PSSDWE5),"^",6))!(($P(PSSDBCAR(PSSDWE5),"^",24))&($P(PSSDBCAR(PSSDWE5),"^",15))) Q 1
- Q 0
- ;
- ;
- SING ;Set Single Dose
- I $P(PSSDBCAR(PSSDWE5),"^",6) Q
- N PSSDWE6
- S PSSDWE6=$G(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","STATUSCODE",PSSDWIEN))
- S:PSSDWE6=5 $P(PSSDBCAR(PSSDWE5),U,34)=1
- I PSSDWE6=1 S PSSDWSPS=1 Q
- I PSSDWE6>1,PSSDWE6<5 D Q
- .S $P(PSSDBCAR(PSSDWE5),"^",24)=1 ;2.1
- .I PSSDBASA D
- ..S ^TMP($J,PSSDBASF,"OUT","DOSE",PSSDWE5,PSSDWDRG,"1_SINGLE","MESSAGE",PSSDWIEN)=PSSDWDRG_": "_^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","MESSAGE",PSSDWIEN)
- .I PSSDBASB D S ^TMP($J,PSSDBASG,"OUT",PSSDWE5,"MESSAGE","1_SINGLE",PSSDWIEN)=PSSDWDRG_": "_^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","MESSAGE",PSSDWIEN)
- ..I $G(PSSDBADJ(PSSDWE5))'="" D ADJUS S PSSDWADJ=1
- Q
- ;
- ;
- DAILY ;Set Daily (Range) Dose
- I $P(PSSDBCAR(PSSDWE5),"^",6)!($P(PSSDBCAR(PSSDWE5),"^",15)) Q ;2.1 piece 15 check added
- N PSSDWE9
- S PSSDWE9=$G(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"DAILYMAX","STATUSCODE",PSSDWIEN))
- S:PSSDWE9=5 $P(PSSDBCAR(PSSDWE5),U,35)=1
- Q:PSSDWE9=1
- ;I PSSDWE9=4,$G(PSSDBFRC(PSSDWE5,"CONJ"))="T" Q
- ; -- if status code is between (2 and 4) or ( in 2.1 if show custom max daily dose message flag=1)
- I (PSSDWE9>1&(PSSDWE9<5))!($P(PSSDBCAR(PSSDWE5),"^",28)) D S $P(PSSDBCAR(PSSDWE5),"^",24)="" D KGEN Q
- .I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","DOSE",PSSDWE5,PSSDWDRG,"2_RANGE","MESSAGE",PSSDWIEN)=PSSDWDRG_": "_$G(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"DAILYMAX","MESSAGE",PSSDWIEN))
- .I PSSDBASB D S ^TMP($J,PSSDBASG,"OUT",PSSDWE5,"MESSAGE","2_RANGE",PSSDWIEN)=PSSDWDRG_": "_$G(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"DAILYMAX","MESSAGE",PSSDWIEN))
- ..I $G(PSSDBADJ(PSSDWE5))'="",'PSSDWADJ D ADJUS
- I PSSDWE9=5,'$P(PSSDBCAR(PSSDWE5),"^",29) S PSSDWGFB=1
- Q
- ;
- ;
- GEN ;General Dosing Guidelines
- I $P(PSSDBCAR(PSSDWE5),"^",7) Q
- I $P(PSSDBCAR(PSSDWE5),"^",15),$G(PSSDWSPS) D KGEN Q
- I $P(PSSDBCAR(PSSDWE5),"^",16)!($P(PSSDWE5,";",5)) Q ;complex orders, remove in 2.2
- ;I $D(PSSDBCDP(PSSDWE5)) D SGEN^PSSDSAPA Q ; works with CRT+31^PSSDSAPD - add both back in 2.2
- I $G(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"GENERAL","MESSAGE",PSSDWIEN))'="" D Q
- .I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","DOSE",PSSDWE5,PSSDWDRG,"3_GENERAL","MESSAGE",PSSDWIEN,1)=^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"GENERAL","MESSAGE",PSSDWIEN)
- .I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWE5,"MESSAGE","3_GENERAL",PSSDWIEN,1)=^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"GENERAL","MESSAGE",PSSDWIEN)
- Q
- ;
- ;
- KGEN ;Kill General Dosing
- I PSSDBASA K ^TMP($J,PSSDBASF,"OUT","DOSE",PSSDWE5,PSSDWDRG,"3_GENERAL","MESSAGE",PSSDWIEN,1)
- I PSSDBASB K ^TMP($J,PSSDBASG,"OUT",PSSDWE5,"MESSAGE","3_GENERAL",PSSDWIEN,1)
- Q
- ;
- ;
- GENERR ;Set General Dosing Guidelines exception
- Q
- D GENERRX^PSSDSAPK
- Q
- ;
- ;
- RESET ;Reset main exception global if Free text dose could not be evaluated
- N PSSDWB1,PSSDWB2,PSSDWB3
- S PSSDWB1="" F S PSSDWB1=$O(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB1)) Q:PSSDWB1="" D
- .S PSSDWB2=$G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB1))
- .I $P(PSSDWB2,"^",10)'="Invalid or Undefined Dose",$P(PSSDWB2,"^",10)'="Invalid or Undefined Dose Unit" S PSSDWB3(PSSDWB1)=^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB1)
- .K ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB1)
- S ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,1)="^^^^^^Dosing Checks could not be performed for Drug: "_$P(PSSDBCAR(PSSDWE1),"^",2)_"^^^Free Text Dosage could not be evaluated"
- S PSSDWB2=2,PSSDWB1="" F S PSSDWB1=$O(PSSDWB3(PSSDWB1)) Q:PSSDWB1="" D
- .S ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB2)=PSSDWB3(PSSDWB1)
- .S PSSDWB2=PSSDWB2+1
- Q
- ;
- ;
- ERROR ;List of errors, for complex orders piece 3 = 1 if only for Daily Dose and adding previous Dosing sequences
- ;;1;;Free Text Dosage could not be evaluated
- ;;2;;Invalid or Undefined Frequency
- ;;3;;Free Text Infusion Rate could not be evaluated
- ;;4;;Not all Dose types are Maintenance;;1
- ;;5;;Not all Dose Units are defined or are the same;;1
- ;;6;;Not all Med Routes are defined or are the same;;1
- ;;7;;Not all Frequencies are valid;;1
- ;;8;;Not all Durations are the same;;1
- ;;9;;At least one Duration is less than one day;;1
- ;;10;;At least one Schedule is a Day of Week Schedule;;1
- ;;11;;One or more Free Text Dosages could not be evaluated;;1
- ;;12;;One or more required patient parameters unavailable: Height
- ;;13;;One or more required patient parameters unavailable: Weight
- ;;14;;One or more required patient parameters unavailable: Height, Weight
- ;;15;;Frequency greater than order duration
- Q
- ;
- ;
- DFM() ;get Dose Form Indicator
- N PSSDFDFK,PSSDFDFL
- I $G(PSSDBAR("UNIT"))="" Q 0
- S PSSDFDFL=0 F PSSDFDFK=0:0 S PSSDFDFK=$O(^PS(51.24,"C",PSSDBAR("UNIT"),PSSDFDFK)) Q:'PSSDFDFK!(PSSDFDFL) I '$$SCREEN^XTID(51.24,.01,PSSDFDFK_",") S PSSDFDFL=PSSDFDFK
- I PSSDFDFL,$P($G(^PS(51.24,PSSDFDFL,0)),"^",3) Q 1
- Q 0
- ;
- ;
- HDER1 ;Set header for exceptions for Output 1
- I PSSDWEGC["Frequency" D S PSSDWER9=1 Q
- .S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)="Max Daily Dose Check could not be performed for Drug: "_PSSDWEE1
- S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)=$S('$P(PSSDBCAR(PSSDWE1),"^",15)&('$P(PSSDBCAR(PSSDWE1),"^",16)):"Dosing Checks",1:"Maximum Single Dose Check")_" could not be done for Drug: "_PSSDWEE1 Q
- Q
- ;
- ;
- HDER2 ;Set header for exceptions for Output 2
- I PSSDWEGC["Frequency" D S PSSDWER9=1 Q
- .S ^TMP($J,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)="Max Daily Dose Check could not be performed for Drug: "_PSSDWEE1
- S ^TMP($J,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)=$S('$P(PSSDBCAR(PSSDWE1),"^",15)&('$P(PSSDBCAR(PSSDWE1),"^",16)):"Dosing Checks",1:"Maximum Single Dose Check")_" could not be performed for Drug: "_PSSDWEE1 Q
- Q
- ;
- ;
- HDER3 ;Reset header node for Output 1 to Non-Frequency header
- S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,1)="Maximum Single Dose Check could not be done for Drug: "_PSSDWEE1 ;2.1 CHANGE
- Q
- ;
- ;
- HDER4 ;Reset header node for Output 2 to Non-frequency header
- S ^TMP($J,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",1)="Maximum Single Dose Check could not be performed for Drug: "_PSSDWEE1 ;2.1 CHANGE
- Q
- ;
- ;
- ADJU ;Set Adjusted Dose message
- S:$G(PSSDBFDB(PSSDBLP,"ADJ_MSG"))'="" PSSDBADJ(PSSDBFDB(PSSDBLP,"RX_NUM"))=$G(PSSDBFDB(PSSDBLP,"ADJ_MSG"))
- Q
- ;
- ;
- ADJUS ;Set Adjusted Dose message in Output
- S ^TMP($J,PSSDBASG,"OUT",PSSDWE5,"MESSAGE",".5_SINGLE",PSSDWIEN)=$G(PSSDBADJ(PSSDWE5))
- Q
- ;
- ;
- DSQ ;
- S ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)=^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)_$P(PSSDWEX6,";;",3)
- I $G(PSSDBCAX(PSSDWEX3,PSSDWEX5))="" Q
- S ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)=^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)_$G(PSSDBCAX(PSSDWEX3,PSSDWEX5))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSEXC 18611 printed Feb 18, 2025@23:57:18 Page 2
- PSSDSEXC ;BIR/RTR-Exceptions for Dose call ;02/24/09
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**117,160,178,206,224**;9/30/97;Build 3
- +2 ;
- +3 ;Called from PSSDSAPD, this routine takes the results from the call to First DataBank and creates displayable TMP
- +4 ;globals for the calling applications. Typically, PSSDBASA indicates a CPRS call, and PSSDBASB indicates a pharmacy call
- +5 ;
- +6 ;PSSDBCAR ARRAY pieces, set mostly in PSSDSAPD and a few other rotuines:
- +7 ;1 = S for Single Dose, D for Daily Dose, B for Both
- +8 ;2 = Drug Name
- +9 ;3 = Drug Internal Entry Number
- +10 ;4 = Frequency Flag
- +11 ;5 = 1 for Maintenance Dose, 0 for Single Dose
- +12 ;6 = 1 to only Show General information (Or General Dose error) and errors (No Single Dose or Daily DOse Messages)
- +13 ;7 = 1 To NEVER show General Dosing information, overrides piece 8
- +14 ;8 = 1 Show General Dosing Guidelines even though piece 1 = "S"
- +15 ;9 = FDB ROUTE
- +16 ;10 = 1 to show General Dosing exception in place of General Dosing information when no General Dosing Information exists
- +17 ;11 = 1 to indicate to show the Daily Dose Error message, (generally screened out in this case)
- +18 ; because you added up previous Dosages at this Dosing Sequence,
- +19 ;12 = 1 to screen out frequency exceptions
- +20 ;13 = 1, set in this routine and PSSDSAPD, to indicate the need to show the generic exception message
- +21 ;14 = 1 to exclude from all Dose checks based on Schedule
- +22 ;15 = 1 to exclude from Daily Dose check based on Schedule
- +23 ;16 = 1 to indicate this Dosing sequence is part of a complex order
- +24 ;17 = 1 to indicate a GCNSECNQ number problem
- +25 ;18 = 1 to indicate there is an Input Exception
- +26 ;19 = 1 to indicate missing age
- +27 ;20 = 1 to indicate Free Text Dose can't be evaluated
- +28 ;21 = 1 to indicate Free Text Infusion Rate exception
- +29 ;22 = 1 to indicate FDB Warning exists
- +30 ;23 = 1 for missing Dose Route or Dose Type
- +31 ;24 = 1 Indicates Single Dose message or error/exception was shown, and no Daily message **Added for 2.1 **
- +32 ;25 = 1 Indicates missing weight for drug requiring weight
- +33 ;26 = 1 Indicates missing BSA for drug requiring BSA
- +34 ;27 = 1 Indicates a 2.1 Drug or Order level message tweak was done in PSSDSEXD
- +35 ;28 = 1 Indicates in 2.1 show custom max daily dose message
- +36 ;29 = 1 Indicates in 2.1 max daily dose frequency out of range, show custom frequency message
- +37 ;30 = 1 Indicates in 2.1 NotScreened message tweak in CHECKMSG^PSSDSEXD
- +38 ;31 = 1 Indicates doseRouteDescription is null (Invalid Route passed into FDB)
- +39 ;32 = Text to append to errors/exceptions if Piece 31 is 1
- +40 ;33 = 1 Indicates in 2.1 Dummy Data is being used for call to FDB
- +41 ;34 = 1 to indicate unableToCheck MaxSingleDose
- +42 ;35 = 1 to indicate unableToCheck MaxDailyDose
- +43 ;
- +44 ;PSSDBCAX holds the errors to show
- +45 ;
- +46 ;2.1 PSSDBSNO checks added - if 0, all schedule are excluded from Doising checks
- FMT ;PSSDBDGO =1 if you went to interface, 0 if you did not go to interface; PSSDBSNO IS 0 if all schedules are excluded
- +1 NEW PSSDWLP,PSSDWL1,PSSDWLPV,PSSDWRSN
- +2 IF PSSDBASA
- IF PSSDBDGO
- IF PSSDBSNO
- SET ^TMP($JOB,PSSDBASF,"OUT",0)=^TMP($JOB,PSSDBASE,"OUT",0)
- +3 IF PSSDBASB
- IF PSSDBDGO
- IF PSSDBSNO
- SET ^TMP($JOB,PSSDBASG,"OUT",0)=^TMP($JOB,PSSDBASE,"OUT",0)
- +4 IF $PIECE($GET(^TMP($JOB,PSSDBASE,"OUT",0)),"^")=-1
- QUIT
- +5 ;
- +6 ;
- +7 ;Set errors
- +8 ;2.1 piece 14 check added
- SET PSSDWLP=""
- FOR
- SET PSSDWLP=$ORDER(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP))
- if PSSDWLP=""
- QUIT
- if '$PIECE(PSSDWLP,";",5)&('$PIECE(PSSDBCAR(PSSDWLP),"^",14))
- Begin DoDot:1
- +9 DO CKWRN^PSSDSAPK
- FOR PSSDWL1=0:0
- SET PSSDWL1=$ORDER(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1))
- if 'PSSDWL1
- QUIT
- DO NOTS^PSSDSAPA
- if '$$ERR1^PSSDSAPK
- Begin DoDot:2
- +10 IF $PIECE(PSSDBCAR(PSSDWLP),"^",22)
- IF $GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"SEV"))'="Warning"
- QUIT
- +11 IF '$PIECE(PSSDBCAR(PSSDWLP),"^",22)
- IF $PIECE(PSSDBCAR(PSSDWLP),"^",19)!$PIECE(PSSDBCAR(PSSDWLP),"^",20)!$PIECE(PSSDBCAR(PSSDWLP),"^",21)
- QUIT
- +12 ;2.1
- SET $PIECE(PSSDBCAR(PSSDWLP),"^",24)=1
- DO RTEXT^PSSDSUTL(PSSDWLP,0)
- +13 IF $GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))'=""
- Begin DoDot:3
- +14 IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
- +15 IF PSSDBASB
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
- End DoDot:3
- +16 IF $GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT"))'=""
- SET PSSDWLPV=$SELECT($GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"SEV"))="Warning":0,1:1)
- Begin DoDot:3
- +17 IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=$SELECT(PSSDWLPV:PSSDWRSN,1:"")_$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT"))
- if 'PSSDWLPV
- Begin DoDot:4
- +18 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"WARN")="Warning"
- End DoDot:4
- +19 IF PSSDBASB
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")=$SELECT(PSSDWLPV:PSSDWRSN,1:"")_$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT"))
- if 'PSSDWLPV
- Begin DoDot:4
- +20 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"WARN")="Warning"
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 ;
- +22 ;
- +23 IF PSSDBSNO
- DO EXCP
- +24 IF PSSDBSNO
- DO MESQ
- +25 IF 'PSSDBDGO!(PSSDBSNO)
- Begin DoDot:1
- +26 IF PSSDBASA
- Begin DoDot:2
- +27 IF $DATA(^TMP($JOB,PSSDBASF,"OUT"))
- SET ^TMP($JOB,PSSDBASF,"OUT",0)=1
- QUIT
- +28 SET ^TMP($JOB,PSSDBASF,"OUT",0)=0
- End DoDot:2
- QUIT
- +29 IF PSSDBASB
- Begin DoDot:2
- +30 IF $DATA(^TMP($JOB,PSSDBASG,"OUT"))
- SET ^TMP($JOB,PSSDBASG,"OUT",0)=1
- QUIT
- +31 SET ^TMP($JOB,PSSDBASG,"OUT",0)=0
- End DoDot:2
- QUIT
- End DoDot:1
- +32 QUIT
- +33 ;
- +34 ;
- EXCP ;Set Exceptions
- +1 NEW PSSDWE1,PSSDWE2,PSSDWE3,PSSDWE4,PSSDWEE1,PSSDWEE2,PSSDWEX1,PSSDWEX2,PSSDWEX3,PSSDWEX4,PSSDWEX5,PSSDWEX6,PSSDWEX7,PSSDWSR1,PSSDWSR2,PSSDWSR3,PSSDWER1,PSSDWER2,PSSDWEGC,PSSDWER9,PSSNOE9,PSSDWEEX
- +2 ;2.1 Piece 14 check added
- SET PSSDWEX3=""
- FOR
- SET PSSDWEX3=$ORDER(PSSDBCAR(PSSDWEX3))
- if PSSDWEX3=""
- QUIT
- DO ADOSE^PSSDSAPK
- if '$PIECE(PSSDBCAR(PSSDWEX3),"^",14)
- Begin DoDot:1
- +3 IF '$ORDER(PSSDBCAX(PSSDWEX3,0))
- QUIT
- +4 SET PSSDWEX4=0
- FOR PSSDWEX7=0:0
- SET PSSDWEX7=$ORDER(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX7))
- if 'PSSDWEX7
- QUIT
- SET PSSDWEX4=PSSDWEX7
- +5 SET PSSDWEX4=PSSDWEX4+1
- +6 FOR PSSDWEX5=0:0
- SET PSSDWEX5=$ORDER(PSSDBCAX(PSSDWEX3,PSSDWEX5))
- if 'PSSDWEX5
- QUIT
- IF PSSDWEX5=2!(PSSDWEX5=3)!(PSSDWEX5>11)
- Begin DoDot:2
- +7 IF $PIECE(PSSDBCAR(PSSDWEX3),"^",19)!($PIECE(PSSDBCAR(PSSDWEX3),"^",20))
- QUIT
- +8 IF $PIECE(PSSDBCAR(PSSDWEX3),"^",21)
- IF PSSDWEX5'=3
- IF PSSDWEX5'=12
- IF PSSDWEX5'=13
- IF PSSDWEX5'=14
- QUIT
- +9 ;piece 24 added for 2.1
- SET PSSDWEX6=$TEXT(ERROR+PSSDWEX5)
- SET PSSDWSR1=$PIECE(PSSDWEX6,";;",4)
- SET $PIECE(PSSDBCAR(PSSDWEX3),"^",24)=1
- +10 SET ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)="^^^^^^"_$SELECT(PSSDWSR1:"Daily Dose Range Check Error Summary for Drug: ",1:"Dosing Checks could not be performed for Drug: ")_$PIECE(PSSDBCAR(PSSDWEX
- 3),"^",2)_"^^^"
- DO DSQ
- +11 SET PSSDWEX4=PSSDWEX4+1
- End DoDot:2
- End DoDot:1
- +12 ;
- +13 ;
- +14 ;Loop through EXCEPTION global, call RESET if Free Text Dosage error exists and EXCEPTION from interface exists, then set 2 processing global outputs
- +15 KILL PSSDWE3
- +16 SET PSSDWE1=""
- FOR
- SET PSSDWE1=$ORDER(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1))
- if PSSDWE1=""
- QUIT
- DO NOEXP^PSSDSAPK
- IF '$DATA(PSSNOE9(PSSDWE1))
- SET PSSDWEX1(PSSDWE1)=""
- if $DATA(PSSDBCAX(PSSDWE1,1))
- DO RESET
- Begin DoDot:1
- +17 ;2.1 piece 14 check added
- IF $PIECE(PSSDBCAR(PSSDWE1),"^",22)!($PIECE(PSSDBCAR(PSSDWE1),"^",14))
- QUIT
- +18 SET PSSDWE4=1
- SET (PSSDWSR3,PSSDWER1,PSSDWER2,PSSDWER9)=0
- +19 SET PSSDWEE1=$PIECE($GET(PSSDBCAR(PSSDWE1)),"^",2)
- SET PSSDWEE2=$PIECE($GET(PSSDBCAR(PSSDWE1)),"^",3)
- +20 DO RTEXT^PSSDSUTL(PSSDWE1,1)
- +21 FOR PSSDWE2=0:0
- SET PSSDWE2=$ORDER(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2))
- if 'PSSDWE2
- QUIT
- SET PSSDWSR2=$SELECT($PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2),"^",7)["Summary":1,1:0)
- Begin DoDot:2
- +22 SET PSSDWEGC=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10)
- IF $$ERR2^PSSDSAPK
- QUIT
- +23 IF $PIECE(PSSDBCAR(PSSDWE1),"^",19)
- IF PSSDWEGC'["patient parameters"
- QUIT
- +24 IF '$PIECE(PSSDBCAR(PSSDWE1),"^",19)
- IF $PIECE(PSSDBCAR(PSSDWE1),"^",23)
- IF PSSDWEGC'["Dose Type"
- IF PSSDWEGC'["Dose Route"
- QUIT
- +25 ;2.1
- SET $PIECE(PSSDBCAR(PSSDWE1),"^",24)=1
- +26 IF 'PSSDWSR2
- Begin DoDot:3
- +27 IF PSSDWE4=1
- Begin DoDot:4
- +28 IF PSSDBASA
- DO HDER1
- +29 IF PSSDBASB
- DO HDER2
- End DoDot:4
- SET PSSDWE4=2
- +30 IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)=$SELECT('PSSDWER1:PSSDWRSN,1:" ")_$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10)
- IF PSSDWEGC'["Frequency"
- IF PSSDWER9
- DO HDER3
- +31 IF PSSDBASB
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)=$SELECT('PSSDWER1:PSSDWRSN,1:" ")_$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10)
- IF PSSDWEGC'["Frequency"
- IF PSSDWER9
- DO HDER4
- +32 SET PSSDWE4=PSSDWE4+1
- SET PSSDWER1=1
- End DoDot:3
- QUIT
- +33 IF 'PSSDWSR3
- Begin DoDot:3
- +34 SET PSSDWSR3=1
- +35 IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",7)
- +36 IF PSSDBASB
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",7)
- End DoDot:3
- SET PSSDWE4=PSSDWE4+1
- +37 IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)=$SELECT('PSSDWER2:PSSDWRSN,1:" ")_$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10)
- +38 IF PSSDBASB
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)=$SELECT('PSSDWER2:PSSDWRSN,1:" ")_$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE2)),"^",10)
- +39 SET PSSDWE4=PSSDWE4+1
- SET PSSDWER2=1
- End DoDot:2
- End DoDot:1
- +40 ;
- +41 ;
- +42 ;If Free Text error message existed, but no Exception came back from Interface set the Free Text exception
- +43 ;2.1 piece 14 check added
- SET PSSDWEX2=""
- FOR
- SET PSSDWEX2=$ORDER(PSSDBCAR(PSSDWEX2))
- if PSSDWEX2=""
- QUIT
- IF '$PIECE(PSSDBCAR(PSSDWEX2),"^",19)
- IF '$PIECE(PSSDBCAR(PSSDWEX2),"^",22)
- IF '$PIECE(PSSDBCAR(PSSDWEX2),"^",14)
- Begin DoDot:1
- +44 IF '$DATA(PSSDWEX1(PSSDWEX2))
- IF $DATA(PSSDBCAX(PSSDWEX2,1))
- IF '$DATA(PSSNOE9(PSSDWEX2))
- Begin DoDot:2
- +45 ;2.1
- SET $PIECE(PSSDBCAR(PSSDWEX2),"^",24)=1
- SET PSSDWEEX=$SELECT('$PIECE(PSSDBCAR(PSSDWEX2),"^",15)&('$PIECE(PSSDBCAR(PSSDWEX2),"^",16))&($PIECE(PSSDBCAR(PSSDWEX2),"^",5)):"Dosing Checks",1:"Maximum Single Dose Check")
- +46 DO RTEXT^PSSDSUTL(PSSDWEX2,1)
- +47 ;2.1 change
- IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=PSSDWEEX_" could not be done for Drug: "_$PIECE(PSSDBCAR(PSSDWEX2),"^",2)
- +48 ;2.1 change
- IF PSSDBASB
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=PSSDWEEX_" could not be performed for Drug: "_$PIECE(PSSDBCAR(PSSDWEX2),"^",2)
- +49 IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=PSSDWRSN_"Free Text Dosage could not be evaluated"
- +50 IF PSSDBASB
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=PSSDWRSN_"Free Text Dosage could not be evaluated"
- +51 SET ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)="^^^^^^Dosing Checks could not be performed for Drug: "_$PIECE(PSSDBCAR(PSSDWEX2),"^",2)_"^^^"_"Free Text Dosage could not be evaluated"
- End DoDot:2
- End DoDot:1
- +52 ;; Mocha 2.1 Drug Level Message tweaks ;;
- DO CONTINUE^PSSDSEXD
- +53 QUIT
- +54 ;
- +55 ;
- MESQ ;Set Messages
- +1 NEW PSSDWE5,PSSDWDRG,PSSDWIEN,PSSDWGFB,PSSDWSPS,PSSDWADJ
- +2 ;2.1 piece 14 check added
- SET PSSDWE5=""
- FOR
- SET PSSDWE5=$ORDER(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5))
- if PSSDWE5=""
- QUIT
- IF $DATA(PSSDBCAR(PSSDWE5))
- IF '$PIECE(PSSDBCAR(PSSDWE5),"^",14)
- Begin DoDot:1
- +3 SET PSSDWDRG=$PIECE(PSSDBCAR(PSSDWE5),"^",2)
- SET PSSDWIEN=$PIECE(PSSDBCAR(PSSDWE5),"^",3)
- SET PSSDWADJ=0
- if PSSDWDRG=""!('PSSDWIEN)
- QUIT
- +4 IF $GET(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","STATUSCODE",PSSDWIEN))=5
- SET $PIECE(PSSDBCAR(PSSDWE5),"^",13)=1
- +5 IF $PIECE(PSSDBCAR(PSSDWE5),"^")="S"
- if '$PIECE(PSSDBCAR(PSSDWE5),"^",6)
- DO SING
- if $PIECE(PSSDBCAR(PSSDWE5),"^",6)!($PIECE(PSSDBCAR(PSSDWE5),"^",8))
- DO GEN
- QUIT
- +6 ;line broken up and piece 24 check added at end
- SET PSSDWGFB=0
- IF $PIECE(PSSDBCAR(PSSDWE5),"^")="D"
- if '$PIECE(PSSDBCAR(PSSDWE5),"^",6)
- DO DAILY
- Begin DoDot:2
- +7 IF $$SHOGEN
- DO GEN
- End DoDot:2
- QUIT
- +8 DO SING
- DO DAILY
- IF $$SHOGEN
- DO GEN
- End DoDot:1
- +9 QUIT
- +10 ;
- +11 ;
- SHOGEN() ;General Dosing Guidelines - Piece 25 and piece 15 check added for 2.1
- +1 ;complex orders, remove in 2.2
- IF $PIECE(PSSDBCAR(PSSDWE5),"^",16)!($PIECE(PSSDWE5,";",5))
- QUIT 0
- +2 IF PSSDWGFB!('$PIECE(PSSDBCAR(PSSDWE5),"^",4))!($DATA(PSSDBCAX(PSSDWE5,1)))!($PIECE(PSSDBCAR(PSSDWE5),"^",8))!($PIECE(PSSDBCAR(PSSDWE5),"^",6))!(($PIECE(PSSDBCAR(PSSDWE5),"^",24))&($PIECE(PSSDBCAR(PSSDWE5),"^",15)))
- QUIT 1
- +3 QUIT 0
- +4 ;
- +5 ;
- SING ;Set Single Dose
- +1 IF $PIECE(PSSDBCAR(PSSDWE5),"^",6)
- QUIT
- +2 NEW PSSDWE6
- +3 SET PSSDWE6=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","STATUSCODE",PSSDWIEN))
- +4 if PSSDWE6=5
- SET $PIECE(PSSDBCAR(PSSDWE5),U,34)=1
- +5 IF PSSDWE6=1
- SET PSSDWSPS=1
- QUIT
- +6 IF PSSDWE6>1
- IF PSSDWE6<5
- Begin DoDot:1
- +7 ;2.1
- SET $PIECE(PSSDBCAR(PSSDWE5),"^",24)=1
- +8 IF PSSDBASA
- Begin DoDot:2
- +9 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE",PSSDWE5,PSSDWDRG,"1_SINGLE","MESSAGE",PSSDWIEN)=PSSDWDRG_": "_^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","MESSAGE",PSSDWIEN)
- End DoDot:2
- +10 IF PSSDBASB
- Begin DoDot:2
- +11 IF $GET(PSSDBADJ(PSSDWE5))'=""
- DO ADJUS
- SET PSSDWADJ=1
- End DoDot:2
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE5,"MESSAGE","1_SINGLE",PSSDWIEN)=PSSDWDRG_": "_^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","MESSAGE",PSSDWIEN)
- End DoDot:1
- QUIT
- +12 QUIT
- +13 ;
- +14 ;
- DAILY ;Set Daily (Range) Dose
- +1 ;2.1 piece 15 check added
- IF $PIECE(PSSDBCAR(PSSDWE5),"^",6)!($PIECE(PSSDBCAR(PSSDWE5),"^",15))
- QUIT
- +2 NEW PSSDWE9
- +3 SET PSSDWE9=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"DAILYMAX","STATUSCODE",PSSDWIEN))
- +4 if PSSDWE9=5
- SET $PIECE(PSSDBCAR(PSSDWE5),U,35)=1
- +5 if PSSDWE9=1
- QUIT
- +6 ;I PSSDWE9=4,$G(PSSDBFRC(PSSDWE5,"CONJ"))="T" Q
- +7 ; -- if status code is between (2 and 4) or ( in 2.1 if show custom max daily dose message flag=1)
- +8 IF (PSSDWE9>1&(PSSDWE9<5))!($PIECE(PSSDBCAR(PSSDWE5),"^",28))
- Begin DoDot:1
- +9 IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","DOSE",PSSDWE5,PSSDWDRG,"2_RANGE","MESSAGE",PSSDWIEN)=PSSDWDRG_": "_$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"DAILYMAX","MESSAGE",PSSDWIEN))
- +10 IF PSSDBASB
- Begin DoDot:2
- +11 IF $GET(PSSDBADJ(PSSDWE5))'=""
- IF 'PSSDWADJ
- DO ADJUS
- End DoDot:2
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE5,"MESSAGE","2_RANGE",PSSDWIEN)=PSSDWDRG_": "_$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"DAILYMAX","MESSAGE",PSSDWIEN))
- End DoDot:1
- SET $PIECE(PSSDBCAR(PSSDWE5),"^",24)=""
- DO KGEN
- QUIT
- +12 IF PSSDWE9=5
- IF '$PIECE(PSSDBCAR(PSSDWE5),"^",29)
- SET PSSDWGFB=1
- +13 QUIT
- +14 ;
- +15 ;
- GEN ;General Dosing Guidelines
- +1 IF $PIECE(PSSDBCAR(PSSDWE5),"^",7)
- QUIT
- +2 IF $PIECE(PSSDBCAR(PSSDWE5),"^",15)
- IF $GET(PSSDWSPS)
- DO KGEN
- QUIT
- +3 ;complex orders, remove in 2.2
- IF $PIECE(PSSDBCAR(PSSDWE5),"^",16)!($PIECE(PSSDWE5,";",5))
- QUIT
- +4 ;I $D(PSSDBCDP(PSSDWE5)) D SGEN^PSSDSAPA Q ; works with CRT+31^PSSDSAPD - add both back in 2.2
- +5 IF $GET(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"GENERAL","MESSAGE",PSSDWIEN))'=""
- Begin DoDot:1
- +6 IF PSSDBASA
- SET ^TMP($JOB,PSSDBASF,"OUT","DOSE",PSSDWE5,PSSDWDRG,"3_GENERAL","MESSAGE",PSSDWIEN,1)=^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"GENERAL","MESSAGE",PSSDWIEN)
- +7 IF PSSDBASB
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE5,"MESSAGE","3_GENERAL",PSSDWIEN,1)=^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"GENERAL","MESSAGE",PSSDWIEN)
- End DoDot:1
- QUIT
- +8 QUIT
- +9 ;
- +10 ;
- KGEN ;Kill General Dosing
- +1 IF PSSDBASA
- KILL ^TMP($JOB,PSSDBASF,"OUT","DOSE",PSSDWE5,PSSDWDRG,"3_GENERAL","MESSAGE",PSSDWIEN,1)
- +2 IF PSSDBASB
- KILL ^TMP($JOB,PSSDBASG,"OUT",PSSDWE5,"MESSAGE","3_GENERAL",PSSDWIEN,1)
- +3 QUIT
- +4 ;
- +5 ;
- GENERR ;Set General Dosing Guidelines exception
- +1 QUIT
- +2 DO GENERRX^PSSDSAPK
- +3 QUIT
- +4 ;
- +5 ;
- RESET ;Reset main exception global if Free text dose could not be evaluated
- +1 NEW PSSDWB1,PSSDWB2,PSSDWB3
- +2 SET PSSDWB1=""
- FOR
- SET PSSDWB1=$ORDER(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB1))
- if PSSDWB1=""
- QUIT
- Begin DoDot:1
- +3 SET PSSDWB2=$GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB1))
- +4 IF $PIECE(PSSDWB2,"^",10)'="Invalid or Undefined Dose"
- IF $PIECE(PSSDWB2,"^",10)'="Invalid or Undefined Dose Unit"
- SET PSSDWB3(PSSDWB1)=^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB1)
- +5 KILL ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB1)
- End DoDot:1
- +6 SET ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,1)="^^^^^^Dosing Checks could not be performed for Drug: "_$PIECE(PSSDBCAR(PSSDWE1),"^",2)_"^^^Free Text Dosage could not be evaluated"
- +7 SET PSSDWB2=2
- SET PSSDWB1=""
- FOR
- SET PSSDWB1=$ORDER(PSSDWB3(PSSDWB1))
- if PSSDWB1=""
- QUIT
- Begin DoDot:1
- +8 SET ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWB2)=PSSDWB3(PSSDWB1)
- +9 SET PSSDWB2=PSSDWB2+1
- End DoDot:1
- +10 QUIT
- +11 ;
- +12 ;
- ERROR ;List of errors, for complex orders piece 3 = 1 if only for Daily Dose and adding previous Dosing sequences
- +1 ;;1;;Free Text Dosage could not be evaluated
- +2 ;;2;;Invalid or Undefined Frequency
- +3 ;;3;;Free Text Infusion Rate could not be evaluated
- +4 ;;4;;Not all Dose types are Maintenance;;1
- +5 ;;5;;Not all Dose Units are defined or are the same;;1
- +6 ;;6;;Not all Med Routes are defined or are the same;;1
- +7 ;;7;;Not all Frequencies are valid;;1
- +8 ;;8;;Not all Durations are the same;;1
- +9 ;;9;;At least one Duration is less than one day;;1
- +10 ;;10;;At least one Schedule is a Day of Week Schedule;;1
- +11 ;;11;;One or more Free Text Dosages could not be evaluated;;1
- +12 ;;12;;One or more required patient parameters unavailable: Height
- +13 ;;13;;One or more required patient parameters unavailable: Weight
- +14 ;;14;;One or more required patient parameters unavailable: Height, Weight
- +15 ;;15;;Frequency greater than order duration
- +16 QUIT
- +17 ;
- +18 ;
- DFM() ;get Dose Form Indicator
- +1 NEW PSSDFDFK,PSSDFDFL
- +2 IF $GET(PSSDBAR("UNIT"))=""
- QUIT 0
- +3 SET PSSDFDFL=0
- FOR PSSDFDFK=0:0
- SET PSSDFDFK=$ORDER(^PS(51.24,"C",PSSDBAR("UNIT"),PSSDFDFK))
- if 'PSSDFDFK!(PSSDFDFL)
- QUIT
- IF '$$SCREEN^XTID(51.24,.01,PSSDFDFK_",")
- SET PSSDFDFL=PSSDFDFK
- +4 IF PSSDFDFL
- IF $PIECE($GET(^PS(51.24,PSSDFDFL,0)),"^",3)
- QUIT 1
- +5 QUIT 0
- +6 ;
- +7 ;
- HDER1 ;Set header for exceptions for Output 1
- +1 IF PSSDWEGC["Frequency"
- Begin DoDot:1
- +2 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)="Max Daily Dose Check could not be performed for Drug: "_PSSDWEE1
- End DoDot:1
- SET PSSDWER9=1
- QUIT
- +3 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,PSSDWE4)=$SELECT('$PIECE(PSSDBCAR(PSSDWE1),"^",15)&('$PIECE(PSSDBCAR(PSSDWE1),"^",16)):"Dosing Checks",1:"Maximum Single Dose Check")_" could not be done for Drug: "_PSSDWEE1
- QUIT
- +4 QUIT
- +5 ;
- +6 ;
- HDER2 ;Set header for exceptions for Output 2
- +1 IF PSSDWEGC["Frequency"
- Begin DoDot:1
- +2 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)="Max Daily Dose Check could not be performed for Drug: "_PSSDWEE1
- End DoDot:1
- SET PSSDWER9=1
- QUIT
- +3 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",PSSDWE4)=$SELECT('$PIECE(PSSDBCAR(PSSDWE1),"^",15)&('$PIECE(PSSDBCAR(PSSDWE1),"^",16)):"Dosing Checks",1:"Maximum Single Dose Check")_" could not be performed for Drug: "_PSSDWEE1
- QUIT
- +4 QUIT
- +5 ;
- +6 ;
- HDER3 ;Reset header node for Output 1 to Non-Frequency header
- +1 ;2.1 CHANGE
- SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWE1,1)="Maximum Single Dose Check could not be done for Drug: "_PSSDWEE1
- +2 QUIT
- +3 ;
- +4 ;
- HDER4 ;Reset header node for Output 2 to Non-frequency header
- +1 ;2.1 CHANGE
- SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE1,"EXCEPTIONS",1)="Maximum Single Dose Check could not be performed for Drug: "_PSSDWEE1
- +2 QUIT
- +3 ;
- +4 ;
- ADJU ;Set Adjusted Dose message
- +1 if $GET(PSSDBFDB(PSSDBLP,"ADJ_MSG"))'=""
- SET PSSDBADJ(PSSDBFDB(PSSDBLP,"RX_NUM"))=$GET(PSSDBFDB(PSSDBLP,"ADJ_MSG"))
- +2 QUIT
- +3 ;
- +4 ;
- ADJUS ;Set Adjusted Dose message in Output
- +1 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWE5,"MESSAGE",".5_SINGLE",PSSDWIEN)=$GET(PSSDBADJ(PSSDWE5))
- +2 QUIT
- +3 ;
- +4 ;
- DSQ ;
- +1 SET ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)=^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)_$PIECE(PSSDWEX6,";;",3)
- +2 IF $GET(PSSDBCAX(PSSDWEX3,PSSDWEX5))=""
- QUIT
- +3 SET ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)=^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX3,PSSDWEX4)_$GET(PSSDBCAX(PSSDWEX3,PSSDWEX5))
- +4 QUIT