| 1 | PSIVCHK1 ;BIR/PR,MLM-CHECK ORDER FOR INTEGRITY ;23 Oct 98 / 10:00 AM
 | 
|---|
| 2 |  ;;5.0; INPATIENT MEDICATIONS ;**21,41,50,74,111**;16 DEC 97
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; Reference to ^PS(52.6 is supported by DBIA# 1231.
 | 
|---|
| 5 |  ; Reference to ^PS(52.7 is supported by DBIA# 2173.
 | 
|---|
| 6 |  ; Reference to ^PSDRUG is supported by DBIA# 2192.
 | 
|---|
| 7 |  ;
 | 
|---|
| 8 |  ;Need DFN and ON
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  I P(9)="",P("TYP")="P" S ERR=1 W !,"*** No schedule exists for this order!"
 | 
|---|
| 11 |  I P(11)="",P("TYP")="P",'P(15),$S(P(9)="ONE TIME"!(P(9)="ON CALL")!(P(9)="1 TIME"):0,"^NOW^STAT^ONCE^ONE-TIME^ONETIME^1TIME^1-TIME^ONCALL^ON-CALL^"[(U_$P(P(9)," ")_U):0,$$DOW^PSIVUTL($P(P(9)," PRN")):1,1:(P(9)'["PRN")) D
 | 
|---|
| 12 |  . I $$DOW^PSIVUTL(P(9)) S P(15)="D"
 | 
|---|
| 13 |  . I P(15)="D" S ERR=1 W !,"*** This is a 'DAY OF THE WEEK' schedule and MUST have admin times!" Q
 | 
|---|
| 14 |  . S ERR=1 W !,"*** There are no administration times defined for this order!"
 | 
|---|
| 15 |  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
 | 
|---|
| 16 |  I $E(P("OT"))'="I",'PDM D GTPD^PSIVORE2 S PDM=11
 | 
|---|
| 17 |  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
 | 
|---|
| 18 |  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
 | 
|---|
| 19 |  NEW DRGSOL,DRGAD,X S (DRGSOL,DRGAD)=0
 | 
|---|
| 20 |  F X=0:0 S X=$O(DRG("SOL",X)) Q:'X  S DRGSOL=DRGSOL+1
 | 
|---|
| 21 |  F X=0:0 S X=$O(DRG("AD",X)) Q:'X  S DRGAD=DRGAD+1
 | 
|---|
| 22 |  I 'DRGAD,("P"[P("TYP")) S:'ERR ERR=2 W !,"WARNING, You have not defined an additive."
 | 
|---|
| 23 |  I DRGAD+DRGSOL<1 S ERR=1 W !,"ERROR, You have not defined any additives or solutions."
 | 
|---|
| 24 |  I 'DRGSOL,("P"'[P("TYP")) S ERR=1 W !,"ERROR, No solution entered for order."
 | 
|---|
| 25 |  I "AP"[P("TYP"),(DRGSOL'=1) S:'ERR ERR=2 W !,"WARNING, This order should have one solution defined, you have ",DRGSOL,!,"   solutions defined."
 | 
|---|
| 26 |  I ERR W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR
 | 
|---|
| 27 |  K CHK,P("TYP")
 | 
|---|
| 28 |  Q
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 | AD ; Check additives.
 | 
|---|
| 31 |  I '$D(^PS(FIL,+DRG(1),0)) S ERR=1 W !,"ERROR, Additive entered does not exist in additive file." Q
 | 
|---|
| 32 |  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."
 | 
|---|
| 33 |  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)
 | 
|---|
| 34 |  Q
 | 
|---|
| 35 |  ;
 | 
|---|
| 36 | SOL ; Check solutions.
 | 
|---|
| 37 |  I '$D(^PS(FIL,+DRG(1),0)) S ERR=1 W !,"ERROR, Solution entered does not exist in solution file." Q
 | 
|---|
| 38 |  I DRG(3)>9999!(DRG(3)'>0) S ERR=1 W !,"ERROR, Volume on ",DRG(2)," is an invalid strength." Q
 | 
|---|
| 39 |  Q
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 | DRG ; Put drug data in DRG and check if active.
 | 
|---|
| 42 |  F X=1:1:6 S DRG(X)=$P(CHK,U,X)
 | 
|---|
| 43 |  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!"
 | 
|---|
| 44 |  Q
 | 
|---|