PSIVUTL1.m

PSIVUTL1 ;BIR/MLM-IV UTILITIES ;21 MAY 96 / 10:37 AM

 ;;5.0; INPATIENT MEDICATIONS ;**58,81,111,134**;16 DEC 97;Build 124

 ;

 ; Reference to ^PS(50.7 is supported by DBIA 2180

 ; Reference to ^PS(51.2 is supported by DBIA 2178

 ; Reference to ^PS(52.6 is supported by DBIA 1231

 ; Reference to ^PS(52.7 is supported by DBIA 2173.

 ; Reference to ^PS(55 is supported by DBIA 2191

 ;

DRGSC(Y,PSJSCT) ; Called to set DIC("S") when selecting orderable item.

 N OK,ND,NDU,NDI S OK=0 ;* I '$D(^PSDRUG("AP",+Y)) K PSJSCT Q 0

 S ND=$G(^PS(50.7,+Y,0))

 I $P(ND,U,3) S OK=$S('$P(ND,U,4):1,$P(ND,U,4)>DT:1,1:0)

 Q OK

 ;

IVDRGSC(Y) ; Set DIC("S") for IV additive/solution selection.

 ; Naked reference below refers to full reference in Y, which is either ^PS(52.6, or ^PS(52.7

 N Y S Y="S X(1)=$G(^(0)),X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0),$D(^PSDRUG(+$P(X(1),U,2),0)) S X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0)"

 Q Y

 ;

ENU(Y) ;Get IV additive strength.

 N X S X=$P(^PS(52.6,+Y,0),U,3),Y=$$CODES^PSIVUTL(X,52.6,2)

 Q Y

 ;

CODES(X,Y) ; Get name from code.

 S Y=$P($P(";"_$P(Y,U,3),";"_X_":",2),";")

 Q Y

 ;

GTPCI(Y) ; Set up "work" area for provider comments.

 N DIC,DINUM,DLAYGO,X S DIC="^PS(53.45,",DIC(0)="LNZ",DLAYGO=53.45,(DINUM,X)=+DUZ D ^DIC

 Q Y

 ;

WDTE(Y) ; Format and print date.

 I 'Y S Y="******"

 E  X ^DD("DD") S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)

 Q Y

GTOT(DFN,ON) ; Get order type for display.

 N DRGT,DRGI,Y

 S X=$P($G(^PS(55,DFN,"IV",ON,0)),U,4)

 S Y=$S(X="A":"F",X="H":"H",1:"I")

 I Y="F" F DRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(^PS(55,DFN,"IV",+ON,DRGT,DRGI)) Q:'DRGI  I '$P($G(^PS(55,DFN,"IV",+ON,DRGT,DRGI)),U,5) S Y="I" Q

 Q Y

 ;

PIV(ON) ; Display IV orders.

 N DRG,ON55,P,PSJORIFN,TYP,X,Y S TYP="?" I ON["V" D

 .S Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,4,5,8,9,17,23 S P(X)=$P(Y,U,X)

 .S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C"

 .S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4))

 I ON'["V" S (P(2),P(3))="",P(17)=$P($G(^PS(53.1,+ON,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(2)),U) D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4)) I $E(P("OT"))="I"  D  Q

 .S P("PD")=$P($$DRUGNAME^PSJLMUTL(PSGP,ON),"^"),P("DO")=$S($P(DN,"^",2)=.2:$P($G(^PS(55,PSGP,5,+PSJO,.2)),"^",2),1:$G(^PS(55,PSGP,5,+PSJO,.3))),P("DO")=$P(P("DO"),"^")

 .S Y=$G(^PS(53.1,+ON,.2)),P("MR")=$P($G(^PS(53.1,+ON,0)),U,3)_U_$P($G(^PS(51.2,+$P($G(^PS(53.1,+ON,0)),U,3),0)),U,3)

 .W ?9,P("PD") D PIV1 W !?11,"Give: ",P("DO")," ",$P(P("MR"),U,2)," ",$S(P(9)]"":P(9),1:P(8))

 S DRG=0 F  S DRG=$O(DRG("AD",DRG)) Q:'DRG  D PIVAD

SOL ;

 NEW NAME

 S DRG=0 F  S DRG=$O(DRG("SOL",DRG)) Q:'DRG  D

 . D NAME(DRG("SOL",DRG),39,.NAME,0)

 . W ! W:DRG=1 ?9,"in "

 . F X=0:0 S X=$O(NAME(X)) Q:'X  W ?12 W NAME(X) I X=1,DRG=1,'$D(DRG("AD",1)) D PIV1

 Q

PIVAD ; Print IV Additives.

 NEW NAME

 D NAME(DRG("AD",DRG),39,.NAME,1)

 F X=0:0 S X=$O(NAME(X)) Q:'X  W:DRG'=1 ! W ?9,NAME(X) I X=1,DRG=1 D PIV1

 Q

 ;

PIV1 ; Print Sched type, start/stop dates, and status.

 F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5))

 I '$D(PSJEXTP) W ?50,TYP,?53,P(2),?60,P(3),?67,P(17) Q

 W ?50,TYP,?53,P(2),?63,P(3),?73,P(17)

 Q

59 ; Validate the Infusion rate entered using IV Quick order code.

 N I F I=2,3,5,7,8,9,11,15,23 S P(I)=""

 S P(4)="A",P(8)=$P($G(^PS(57.1,PSJQO,1)),U,5)

 I $G(^PS(57.1,PSJQO,4,1,0)) S DRG("SOL",1)=^(0),DRG("SOL",0)=1

 I X["?" S F1=53.1,F2=59 D ENHLP^PSIVORC1 G 59

 I X]"" D ENI^PSIVSP S:$D(X) P(8)=X

 Q

WRTDRG(X,L)       ; Format and print drug name, strength and bottle no.

 N Y S Y=" "_$P(X,U,3) S:$P(X,U,4) Y=Y_" ("_$P(X,U,4)_")"

 Q $E($P(X,U,2),1,(L-$L(Y)))_Y

NAME(X,L,NAME,AD)        ; Format Additive display.

 ;INPUT : X=DRG("AD",DRG)  L=Display length   AD=for Addtive(1/0)

 ;OUTPUT: AD(X)  if X=2 that means there is a second line to display

 K NAME

 NEW Y S Y=$P(X,U,3) S:(AD&$P(X,U,4)) Y=Y_" ("_$P(X,U,4)_")"

 S:'AD Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@"))

 I ($L($P(X,U,2))+$L(Y)+1)>L S NAME(1)=$P(X,U,2),NAME(2)="   "_Y Q

 S NAME(1)=$P(X,U,2)_" "_Y

 Q

 ;

CNVTOM(RATE,TVOL) ; Convert volume to minutes

 ; Input:

 ;   RATE - Infusion Rate

 ;   TVOL - Volume being infused, EX: m100 (100 Milliliters) or l5 (5 Liters)

 ; Output:

 ;   MINS - Minutes required to infuse volume

 N DAYS,ML,MLSHR

 ; Get rate in terms of mils per hour

 I 'RATE Q 0

 I RATE<1 S RATE=1

 S TVOL=$S($E(TVOL)="m":$E(TVOL,2,9),$E(TVOL)="l":$E(TVOL,2,9)*1000,1:0) Q:'TVOL 0

 ; Find IV duration in minutes

 S MINS=(TVOL/RATE)*60

 Q MINS

 ;

GETMIN(LIM,DFN,PSJORD,DAYS) ;

 N F,DDLX

 I LIM!(LIM=0) Q LIM

 S F=$S(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"")

 N RATE S RATE=$S(PSJORD["P":+$P($G(@(F_"8)")),"^",5),PSJORD["V":+$P($G(@(F_"0)")),"^",8),1:0)

 I (",l,m,")[(","_$E(LIM)_",") D

 .I RATE D

 ..I RATE<1 S RATE=1

 ..S MIN=$$CNVTOM(RATE,LIM) I MIN S LIM=MIN

 .I 'RATE N SOL,SOLVOL,DOSVOL,DUR,STOP,OIX,X S (SOLVOL,DOSVOL)="" D

 ..S SOL=0 F  S SOL=$O(@(F_"""SOL"",SOL)")) Q:'SOL  D

 ...S SOLVOL=$P(@(F_"""SOL"",SOL,0)"),"^",2) I SOLVOL S DOSVOL=DOSVOL+SOLVOL

 ..S DDLX=$S($E(LIM)["l":(($E(LIM,2,99)*1000)/DOSVOL),1:($E(LIM,2,99)/DOSVOL))_"L"

 I (",a,")[(","_$E(LIM)_",") S DDLX=$E(LIM,2,99)_"L"

 I $G(DDLX)>0 D

 .N STOP,LASTD S DAYS="",STOP=""

 .S OIX=$P($G(@(F_".2)")),"^") S:(DDLX<1) DDLX="1L" S LASTD=$$DOSES^PSIVCAL(DDLX,.P)

 .I LASTD,$G(P(2)) S DAYS=$$FMDIFF^XLFDT(LASTD,P(2),2) I DAYS>0 S DAYS=DAYS/86400

 .I DAYS>0 S LIM=DAYS*1440

 I (",h,d,")[(","_$E(LIM)_",") S LIM=$S($E(LIM)="d":(1440*$E(LIM,2,99)),1:(60*$E(LIM,2,99))) Q

 Q LIM

PSIVUTL1  ;BIR/MLM-IV UTILITIES ;21 MAY 96 / 10:37 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**58,81,111,134**;16 DEC 97;Build 124

 +2       ;

 +3       ; Reference to ^PS(50.7 is supported by DBIA 2180

 +4       ; Reference to ^PS(51.2 is supported by DBIA 2178

 +5       ; Reference to ^PS(52.6 is supported by DBIA 1231

 +6       ; Reference to ^PS(52.7 is supported by DBIA 2173.

 +7       ; Reference to ^PS(55 is supported by DBIA 2191

 +8       ;

DRGSC(Y,PSJSCT) ; Called to set DIC("S") when selecting orderable item.

 +1       ;* I '$D(^PSDRUG("AP",+Y)) K PSJSCT Q 0

           NEW OK,ND,NDU,NDI

           SET OK=0

 +2        SET ND=$GET(^PS(50.7,+Y,0))

 +3        IF $PIECE(ND,U,3)

               SET OK=$SELECT('$PIECE(ND,U,4):1,$PIECE(ND,U,4)>DT:1,1:0)

 +4        QUIT OK

 +5       ;

IVDRGSC(Y) ; Set DIC("S") for IV additive/solution selection.

 +1       ; Naked reference below refers to full reference in Y, which is either ^PS(52.6, or ^PS(52.7

 +2        NEW Y

           SET Y="S X(1)=$G(^(0)),X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0),$D(^PSDRUG(+$P(X(1),U,2),0)) S X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0)"

 +3        QUIT Y

 +4       ;

ENU(Y)    ;Get IV additive strength.

 +1        NEW X

           SET X=$PIECE(^PS(52.6,+Y,0),U,3)

           SET Y=$$CODES^PSIVUTL(X,52.6,2)

 +2        QUIT Y

 +3       ;

CODES(X,Y) ; Get name from code.

 +1        SET Y=$PIECE($PIECE(";"_$PIECE(Y,U,3),";"_X_":",2),";")

 +2        QUIT Y

 +3       ;

GTPCI(Y)  ; Set up "work" area for provider comments.

 +1        NEW DIC,DINUM,DLAYGO,X

           SET DIC="^PS(53.45,"

           SET DIC(0)="LNZ"

           SET DLAYGO=53.45

           SET (DINUM,X)=+DUZ

           DO ^DIC

 +2        QUIT Y

 +3       ;

WDTE(Y)   ; Format and print date.

 +1        IF 'Y

               SET Y="******"

 +2       IF '$TEST

               XECUTE ^DD("DD")

               SET Y=$PIECE(Y,"@")_" "_$PIECE($PIECE(Y,"@",2),":",1,2)

 +3        QUIT Y

GTOT(DFN,ON) ; Get order type for display.

 +1        NEW DRGT,DRGI,Y

 +2        SET X=$PIECE($GET(^PS(55,DFN,"IV",ON,0)),U,4)

 +3        SET Y=$SELECT(X="A":"F",X="H":"H",1:"I")

 +4        IF Y="F"

               FOR DRGT="AD","SOL"

                   FOR DRGI=0:0

                       SET DRGI=$ORDER(^PS(55,DFN,"IV",+ON,DRGT,DRGI))

                       IF 'DRGI

                           QUIT 

                       IF '$PIECE($GET(^PS(55,DFN,"IV",+ON,DRGT,DRGI)),U,5)

                           SET Y="I"

                           QUIT 

 +5        QUIT Y

 +6       ;

PIV(ON)   ; Display IV orders.

 +1        NEW DRG,ON55,P,PSJORIFN,TYP,X,Y

           SET TYP="?"

           IF ON["V"

               Begin DoDot:1

 +2                SET Y=$GET(^PS(55,DFN,"IV",+ON,0))

                   FOR X=2,3,4,5,8,9,17,23

                       SET P(X)=$PIECE(Y,U,X)

 +3                SET TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3))

                   IF TYP'="O"

                       SET TYP="C"

 +4                SET ON55=ON

                   SET P("OT")=$SELECT(P(4)="A":"F",P(4)="H":"H",1:"I")

                   DO GTDRG^PSIVORFB

                   DO GTOT^PSIVUTL(P(4))

               End DoDot:1

 +5        IF ON'["V"

               SET (P(2),P(3))=""

               SET P(17)=$PIECE($GET(^PS(53.1,+ON,0)),U,9)

               SET Y=$GET(^(8))

               SET P(4)=$PIECE(Y,U)

               SET P(8)=$PIECE(Y,U,5)

               SET P(9)=$PIECE($GET(^(2)),U)

               DO GTDRG^PSIVORFA

               DO GTOT^PSIVUTL(P(4))

               IF $EXTRACT(P("OT"))="I"

                   Begin DoDot:1

 +6                    SET P("PD")=$PIECE($$DRUGNAME^PSJLMUTL(PSGP,ON),"^")

                       SET P("DO")=$SELECT($PIECE(DN,"^",2)=.2:$PIECE($GET(^PS(55,PSGP,5,+PSJO,.2)),"^",2),1:$GET(^PS(55,PSGP,5,+PSJO,.3)))

                       SET P("DO")=$PIECE(P("DO"),"^")

 +7                    SET Y=$GET(^PS(53.1,+ON,.2))

                       SET P("MR")=$PIECE($GET(^PS(53.1,+ON,0)),U,3)_U_$PIECE($GET(^PS(51.2,+$PIECE($GET(^PS(53.1,+ON,0)),U,3),0)),U,3)

 +8                    WRITE ?9,P("PD")

                       DO PIV1

                       WRITE !?11,"Give: ",P("DO")," ",$PIECE(P("MR"),U,2)," ",$SELECT(P(9)]"":P(9),1:P(8))

                   End DoDot:1

                   QUIT 

 +9        SET DRG=0

           FOR 

               SET DRG=$ORDER(DRG("AD",DRG))

               IF 'DRG

                   QUIT 

               DO PIVAD

SOL       ;

 +1        NEW NAME

 +2        SET DRG=0

           FOR 

               SET DRG=$ORDER(DRG("SOL",DRG))

               IF 'DRG

                   QUIT 

               Begin DoDot:1

 +3                DO NAME(DRG("SOL",DRG),39,.NAME,0)

 +4                WRITE !

                   IF DRG=1

                       WRITE ?9,"in "

 +5                FOR X=0:0

                       SET X=$ORDER(NAME(X))

                       IF 'X

                           QUIT 

                       WRITE ?12

                       WRITE NAME(X)

                       IF X=1

                           IF DRG=1

                               IF '$DATA(DRG("AD",1))

                                   DO PIV1

               End DoDot:1

 +6        QUIT 

PIVAD     ; Print IV Additives.

 +1        NEW NAME

 +2        DO NAME(DRG("AD",DRG),39,.NAME,1)

 +3        FOR X=0:0

               SET X=$ORDER(NAME(X))

               IF 'X

                   QUIT 

               IF DRG'=1

                   WRITE !

               WRITE ?9,NAME(X)

               IF X=1

                   IF DRG=1

                       DO PIV1

 +4        QUIT 

 +5       ;

PIV1      ; Print Sched type, start/stop dates, and status.

 +1        FOR X=2,3

               SET P(X)=$EXTRACT($$ENDTC^PSGMI(P(X)),1,$SELECT($DATA(PSJEXTP):8,1:5))

 +2        IF '$DATA(PSJEXTP)

               WRITE ?50,TYP,?53,P(2),?60,P(3),?67,P(17)

               QUIT 

 +3        WRITE ?50,TYP,?53,P(2),?63,P(3),?73,P(17)

 +4        QUIT 

59        ; Validate the Infusion rate entered using IV Quick order code.

 +1        NEW I

           FOR I=2,3,5,7,8,9,11,15,23

               SET P(I)=""

 +2        SET P(4)="A"

           SET P(8)=$PIECE($GET(^PS(57.1,PSJQO,1)),U,5)

 +3        IF $GET(^PS(57.1,PSJQO,4,1,0))

               SET DRG("SOL",1)=^(0)

               SET DRG("SOL",0)=1

 +4        IF X["?"

               SET F1=53.1

               SET F2=59

               DO ENHLP^PSIVORC1

               GOTO 59

 +5        IF X]""

               DO ENI^PSIVSP

               IF $DATA(X)

                   SET P(8)=X

 +6        QUIT 

WRTDRG(X,L) ; Format and print drug name, strength and bottle no.

 +1        NEW Y

           SET Y=" "_$PIECE(X,U,3)

           IF $PIECE(X,U,4)

               SET Y=Y_" ("_$PIECE(X,U,4)_")"

 +2        QUIT $EXTRACT($PIECE(X,U,2),1,(L-$LENGTH(Y)))_Y

NAME(X,L,NAME,AD) ; Format Additive display.

 +1       ;INPUT : X=DRG("AD",DRG)  L=Display length   AD=for Addtive(1/0)

 +2       ;OUTPUT: AD(X)  if X=2 that means there is a second line to display

 +3        KILL NAME

 +4        NEW Y

           SET Y=$PIECE(X,U,3)

           IF (AD&$PIECE(X,U,4))

               SET Y=Y_" ("_$PIECE(X,U,4)_")"

 +5        IF 'AD

               SET Y=Y_" "_$SELECT(P(4)="P"!($GET(P(23))="P")!$GET(P(5)):P(9),1:$PIECE(P(8),"@"))

 +6        IF ($LENGTH($PIECE(X,U,2))+$LENGTH(Y)+1)>L

               SET NAME(1)=$PIECE(X,U,2)

               SET NAME(2)="   "_Y

               QUIT 

 +7        SET NAME(1)=$PIECE(X,U,2)_" "_Y

 +8        QUIT 

 +9       ;

CNVTOM(RATE,TVOL) ; Convert volume to minutes

 +1       ; Input:

 +2       ;   RATE - Infusion Rate

 +3       ;   TVOL - Volume being infused, EX: m100 (100 Milliliters) or l5 (5 Liters)

 +4       ; Output:

 +5       ;   MINS - Minutes required to infuse volume

 +6        NEW DAYS,ML,MLSHR

 +7       ; Get rate in terms of mils per hour

 +8        IF 'RATE

               QUIT 0

 +9        IF RATE<1

               SET RATE=1

 +10       SET TVOL=$SELECT($EXTRACT(TVOL)="m":$EXTRACT(TVOL,2,9),$EXTRACT(TVOL)="l":$EXTRACT(TVOL,2,9)*1000,1:0)

           IF 'TVOL

               QUIT 0

 +11      ; Find IV duration in minutes

 +12       SET MINS=(TVOL/RATE)*60

 +13       QUIT MINS

 +14      ;

GETMIN(LIM,DFN,PSJORD,DAYS) ;

 +1        NEW F,DDLX

 +2        IF LIM!(LIM=0)

               QUIT LIM

 +3        SET F=$SELECT(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"")

 +4        NEW RATE

           SET RATE=$SELECT(PSJORD["P":+$PIECE($GET(@(F_"8)")),"^",5),PSJORD["V":+$PIECE($GET(@(F_"0)")),"^",8),1:0)

 +5        IF (",l,m,")[(","_$EXTRACT(LIM)_",")

               Begin DoDot:1

 +6                IF RATE

                       Begin DoDot:2

 +7                        IF RATE<1

                               SET RATE=1

 +8                        SET MIN=$$CNVTOM(RATE,LIM)

                           IF MIN

                               SET LIM=MIN

                       End DoDot:2

 +9                IF 'RATE

                       NEW SOL,SOLVOL,DOSVOL,DUR,STOP,OIX,X

                       SET (SOLVOL,DOSVOL)=""

                       Begin DoDot:2

 +10                       SET SOL=0

                           FOR 

                               SET SOL=$ORDER(@(F_"""SOL"",SOL)"))

                               IF 'SOL

                                   QUIT 

                               Begin DoDot:3

 +11                               SET SOLVOL=$PIECE(@(F_"""SOL"",SOL,0)"),"^",2)

                                   IF SOLVOL

                                       SET DOSVOL=DOSVOL+SOLVOL

                               End DoDot:3

 +12                       SET DDLX=$SELECT($EXTRACT(LIM)["l":(($EXTRACT(LIM,2,99)*1000)/DOSVOL),1:($EXTRACT(LIM,2,99)/DOSVOL))_"L"

                       End DoDot:2

               End DoDot:1

 +13       IF (",a,")[(","_$EXTRACT(LIM)_",")

               SET DDLX=$EXTRACT(LIM,2,99)_"L"

 +14       IF $GET(DDLX)>0

               Begin DoDot:1

 +15               NEW STOP,LASTD

                   SET DAYS=""

                   SET STOP=""

 +16               SET OIX=$PIECE($GET(@(F_".2)")),"^")

                   IF (DDLX<1)

                       SET DDLX="1L"

                   SET LASTD=$$DOSES^PSIVCAL(DDLX,.P)

 +17               IF LASTD

                       IF $GET(P(2))

                           SET DAYS=$$FMDIFF^XLFDT(LASTD,P(2),2)

                           IF DAYS>0

                               SET DAYS=DAYS/86400

 +18               IF DAYS>0

                       SET LIM=DAYS*1440

               End DoDot:1

 +19       IF (",h,d,")[(","_$EXTRACT(LIM)_",")

               SET LIM=$SELECT($EXTRACT(LIM)="d":(1440*$EXTRACT(LIM,2,99)),1:(60*$EXTRACT(LIM,2,99)))

               QUIT 

 +20       QUIT LIM