- PSIVCHK1 ;BIR/PR,MLM-CHECK ORDER FOR INTEGRITY ;23 Oct 98 / 10:00 AM
- ;;5.0; INPATIENT MEDICATIONS ;**21,41,50,74,111,113**;16 DEC 97;Build 63
- ;
- ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- ; Reference to ^PSDRUG is supported by DBIA# 2192.
- ;
- ;Need DFN and ON
- ;
- I P(9)="",P("TYP")="P" S ERR=1 W !,"*** No schedule exists for this order!"
- I P(11)="",P("TYP")="P",'P(15),$S(($G(P(15))="O"):0,($G(P(15))="OC"):0,$$DOW^PSIVUTL($P(P(9)," PRN")):1,1:P(9)'["PRN") D
- . I $$DOW^PSIVUTL(P(9)) S P(15)="D"
- . I P(15)="D" S ERR=1 W !,"*** This is a 'DAY OF THE WEEK' schedule and MUST have admin times!" Q
- . I $G(P(15)) Q:$$ODD^PSGS0(P(15))
- . I $$ONETIME^PSIVEDT1($G(P(9)))!$$PRNOK^PSGS0($G(P(9)))!$$ONCALL^PSIVEDT1($G(P(9))) Q
- . S ERR=1 W !,"*** There are no administration times defined for this order!"
- S PDM=11 S PDM=0 F DRGT="AD","SOL" I $D(DRG(DRGT)) F DRGI=0:0 S DRGI=$O(DRG(DRGT,DRGI)) Q:'DRGI!PDM I $P(P("PD"),U)=$P(DRG(DRGT,DRGI),U,6) S PDM=11
- I $E(P("OT"))'="I",'PDM D GTPD^PSIVORE2 S PDM=11
- I $E(P("OT"))="I",'PDM W !!,"ERROR,",!,"The Orderable item does not match any of the additives or solutions entered.",!,"At least 1 additive or solution must match the Orderable item entered",!,"for this order!",!! S ERR=1
- F DRGT="AD","SOL" S FIL=$S(DRGT="AD":52.6,1:52.7) F DRGI=0:0 S DRGI=$O(DRG(DRGT,DRGI)) Q:'DRGI S CHK=DRG(DRGT,DRGI) D DRG,@DRGT
- NEW DRGSOL,DRGAD,X S (DRGSOL,DRGAD)=0
- F X=0:0 S X=$O(DRG("SOL",X)) Q:'X S DRGSOL=DRGSOL+1
- F X=0:0 S X=$O(DRG("AD",X)) Q:'X S DRGAD=DRGAD+1
- I 'DRGAD,("P"[P("TYP")) S:'ERR ERR=2 W !,"WARNING, You have not defined an additive."
- I DRGAD+DRGSOL<1 S ERR=1 W !,"ERROR, You have not defined any additives or solutions."
- I 'DRGSOL,("P"'[P("TYP")) S ERR=1 W !,"ERROR, No solution entered for order."
- I "AP"[P("TYP"),(DRGSOL'=1) S:'ERR ERR=2 W !,"WARNING, This order should have one solution defined, you have ",DRGSOL,!," solutions defined."
- I ERR W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR
- K CHK,P("TYP")
- Q
- ;
- AD ; Check additives.
- I '$D(^PS(FIL,+DRG(1),0)) S ERR=1 W !,"ERROR, Additive entered does not exist in additive file." Q
- I $$ENU^PSIVUTL(DRG(1))'=$P(DRG(3)," ",2,99)!(+DRG(3)'>0) S ERR=1 W !,"ERROR, Invalid strength entered for ",DRG(2),!,"... should be in ",$$ENU^PSIVUTL(DRG(1))," ... please reenter."
- I P("TYP")="P",DRG(4)]"" S ERR=1 W !,"ERROR, Piggyback or intermittent syringe type order and you have a bottle #",!,"defined for ",DRG(2)
- Q
- ;
- SOL ; Check solutions.
- I '$D(^PS(FIL,+DRG(1),0)) S ERR=1 W !,"ERROR, Solution entered does not exist in solution file." Q
- I DRG(3)>9999!(DRG(3)'>0) S ERR=1 W !,"ERROR, Volume on ",DRG(2)," is an invalid strength." Q
- Q
- ;
- DRG ; Put drug data in DRG and check if active.
- F X=1:1:6 S DRG(X)=$P(CHK,U,X)
- I $S('$G(^PS(FIL,+DRG(1),"I")):0,^("I")>DT:0,1:1)!($S('$G(^PSDRUG(+$P($G(^PS(FIL,DRG(1),0)),U,2),"I")):0,^("I")>DT:0,1:1)) S ERR=1 W !,"ERROR, ",DRG(2)," is an inactive drug!"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVCHK1 3014 printed Feb 18, 2025@23:30:22 Page 2
- PSIVCHK1 ;BIR/PR,MLM-CHECK ORDER FOR INTEGRITY ;23 Oct 98 / 10:00 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**21,41,50,74,111,113**;16 DEC 97;Build 63
- +2 ;
- +3 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- +4 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- +5 ; Reference to ^PSDRUG is supported by DBIA# 2192.
- +6 ;
- +7 ;Need DFN and ON
- +8 ;
- +9 IF P(9)=""
- IF P("TYP")="P"
- SET ERR=1
- WRITE !,"*** No schedule exists for this order!"
- +10 IF P(11)=""
- IF P("TYP")="P"
- IF 'P(15)
- IF $SELECT(($GET(P(15))="O"):0,($GET(P(15))="OC"):0,$$DOW^PSIVUTL($PIECE(P(9)," PRN")):1,1:P(9)'["PRN")
- Begin DoDot:1
- +11 IF $$DOW^PSIVUTL(P(9))
- SET P(15)="D"
- +12 IF P(15)="D"
- SET ERR=1
- WRITE !,"*** This is a 'DAY OF THE WEEK' schedule and MUST have admin times!"
- QUIT
- +13 IF $GET(P(15))
- if $$ODD^PSGS0(P(15))
- QUIT
- +14 IF $$ONETIME^PSIVEDT1($GET(P(9)))!$$PRNOK^PSGS0($GET(P(9)))!$$ONCALL^PSIVEDT1($GET(P(9)))
- QUIT
- +15 SET ERR=1
- WRITE !,"*** There are no administration times defined for this order!"
- End DoDot:1
- +16 SET PDM=11
- SET PDM=0
- FOR DRGT="AD","SOL"
- IF $DATA(DRG(DRGT))
- FOR DRGI=0:0
- SET DRGI=$ORDER(DRG(DRGT,DRGI))
- if 'DRGI!PDM
- QUIT
- IF $PIECE(P("PD"),U)=$PIECE(DRG(DRGT,DRGI),U,6)
- SET PDM=11
- +17 IF $EXTRACT(P("OT"))'="I"
- IF 'PDM
- DO GTPD^PSIVORE2
- SET PDM=11
- +18 IF $EXTRACT(P("OT"))="I"
- IF 'PDM
- WRITE !!,"ERROR,",!,"The Orderable item does not match any of the additives or solutions entered.",!,"At least 1 additive or solution must match the Orderable item entered",!,"for this order!",!!
- SET ERR=1
- +19 FOR DRGT="AD","SOL"
- SET FIL=$SELECT(DRGT="AD":52.6,1:52.7)
- FOR DRGI=0:0
- SET DRGI=$ORDER(DRG(DRGT,DRGI))
- if 'DRGI
- QUIT
- SET CHK=DRG(DRGT,DRGI)
- DO DRG
- DO @DRGT
- +20 NEW DRGSOL,DRGAD,X
- SET (DRGSOL,DRGAD)=0
- +21 FOR X=0:0
- SET X=$ORDER(DRG("SOL",X))
- if 'X
- QUIT
- SET DRGSOL=DRGSOL+1
- +22 FOR X=0:0
- SET X=$ORDER(DRG("AD",X))
- if 'X
- QUIT
- SET DRGAD=DRGAD+1
- +23 IF 'DRGAD
- IF ("P"[P("TYP"))
- if 'ERR
- SET ERR=2
- WRITE !,"WARNING, You have not defined an additive."
- +24 IF DRGAD+DRGSOL<1
- SET ERR=1
- WRITE !,"ERROR, You have not defined any additives or solutions."
- +25 IF 'DRGSOL
- IF ("P"'[P("TYP"))
- SET ERR=1
- WRITE !,"ERROR, No solution entered for order."
- +26 IF "AP"[P("TYP")
- IF (DRGSOL'=1)
- if 'ERR
- SET ERR=2
- WRITE !,"WARNING, This order should have one solution defined, you have ",DRGSOL,!," solutions defined."
- +27 IF ERR
- WRITE $CHAR(7)
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +28 KILL CHK,P("TYP")
- +29 QUIT
- +30 ;
- AD ; Check additives.
- +1 IF '$DATA(^PS(FIL,+DRG(1),0))
- SET ERR=1
- WRITE !,"ERROR, Additive entered does not exist in additive file."
- QUIT
- +2 IF $$ENU^PSIVUTL(DRG(1))'=$PIECE(DRG(3)," ",2,99)!(+DRG(3)'>0)
- SET ERR=1
- WRITE !,"ERROR, Invalid strength entered for ",DRG(2),!,"... should be in ",$$ENU^PSIVUTL(DRG(1))," ... please reenter."
- +3 IF P("TYP")="P"
- IF DRG(4)]""
- SET ERR=1
- WRITE !,"ERROR, Piggyback or intermittent syringe type order and you have a bottle #",!,"defined for ",DRG(2)
- +4 QUIT
- +5 ;
- SOL ; Check solutions.
- +1 IF '$DATA(^PS(FIL,+DRG(1),0))
- SET ERR=1
- WRITE !,"ERROR, Solution entered does not exist in solution file."
- QUIT
- +2 IF DRG(3)>9999!(DRG(3)'>0)
- SET ERR=1
- WRITE !,"ERROR, Volume on ",DRG(2)," is an invalid strength."
- QUIT
- +3 QUIT
- +4 ;
- DRG ; Put drug data in DRG and check if active.
- +1 FOR X=1:1:6
- SET DRG(X)=$PIECE(CHK,U,X)
- +2 IF $SELECT('$GET(^PS(FIL,+DRG(1),"I")):0,^("I")>DT:0,1:1)!($SELECT('$GET(^PSDRUG(+$PIECE($GET(^PS(FIL,DRG(1),0)),U,2),"I")):0,^("I")>DT:0,1:1))
- SET ERR=1
- WRITE !,"ERROR, ",DRG(2)," is an inactive drug!"
- +3 QUIT
