Routine: PSIVORAL

PSIVORAL ;BIR/MLM-ACTIVITY LOGGER FOR PHARMACY EDITS ;16 DEC 97 / 1:40 PM

 ;;5.0; INPATIENT MEDICATIONS ;**58,135**;16 DEC 97

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

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

EN ; Entry point for updating activity log from Pharmacy.

OPI ; Record changes to Other print info.

 I $P($G(^PS(55,DFN,"IV",+ON55,3)),"^")'=$P(P("OPI"),"^") S P("FC")="OTHER PRINT INFO^"_$P($G(^(3)),"^")_U_$P(P("OPI"),"^") D GTFC

REMARKS ; Record changes to remarks.

 I $G(^PS(55,DFN,"IV",+ON55,1))'=P("REM") S P("FC")="REMARKS^"_$G(^(1))_U_P("REM") D GTFC

ADMIN ; Record changes to admin. times.

 I $P($G(^PS(55,DFN,"IV",+ON55,0)),U,11)'=P(11) S P("FC")="ADMINISTRATION TIMES^"_$P($G(^(0)),U,11)_U_P(11) D GTFC

INFUS ; Record changes to infusion rate.

 I $P($G(^PS(55,DFN,"IV",+ON55,0)),U,8)'=P(8) S P("FC")="INFUSION RATE^"_$P($G(^(0)),U,8)_U_P(8) D GTFC

 D:P("DTYP")=1 SOL

STOP ; Record changes to stop date.

 I $P(^PS(55,DFN,"IV",+ON55,0),U,3)'=P(3) S P("FC")="STOP DATE/TIME^",Y=$P(^(0),U,3) X ^DD("DD") S $P(P("FC"),U,3)=$P(Y,"@")_" "_$P(Y,"@",2),Y=P(3) X ^DD("DD") S $P(P("FC"),U,2)=$P(Y,"@")_" "_$P(Y,"@",2) D GTFC

 K DRGI,DRGN,TDRG,P("AGE"),P("FC")

SOL ; Record changes to Solutions.

 K TDRG F DRGI=0:0 S DRGI=$O(DRG("SOL",DRGI)) Q:'DRGI  S TDRG("NEW",$P(DRG("SOL",DRGI),U))=$P(DRG("SOL",DRGI),U,2,3)

 S P("AGE")="NEW"

 F DRGI=0:0 S DRGI=$O(^PS(55,DFN,"IV",+ON55,"SOL",DRGI)) Q:'DRGI  S X=$G(^PS(55,DFN,"IV",+ON55,"SOL",DRGI,0)),DRG=+$P(X,U),TDRG("OLD",+DRG)=$P($G(^PS(52.7,DRG,0)),U)_U_$P(X,U,2) D:$G(TDRG("NEW",DRG))'=$G(TDRG("OLD",DRG)) SOL1

 S P("AGE")="OLD" F DRGI=0:0 S DRG=$O(TDRG("NEW",DRG)) Q:'DRG  D:$G(TDRG("NEW",DRG))'=$G(TDRG("OLD",DRG)) SOL1

SOL1 ;

 I '$D(TDRG(P("AGE"),DRG)) S P("FC")="SOLUTION^"_$P($G(TDRG("OLD",DRG)),U)_U_$P($G(TDRG("NEW",DRG)),U) D GTFC

 Q:$G(TDRG("NEW",DRG))=$G(TDRG("OLD",DRG))

 S P("FC")="VOLUME^"_$P($G(TDRG("OLD",DRG)),U,2)_$S($G(TDRG("OLD",DRG))]"":" ("_$P($G(^PS(52.7,DRG,0)),U)_")",1:"")_U_$P($G(TDRG("NEW",DRG)),U,2)_$S($G(TDRG("NEW",DRG))]"":" ("_$P($G(^PS(52.7,DRG,0)),U)_")",1:"") D GTFC

GTFC ; Create field change entry in activity log.

 S ND=$G(^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,0)) S:ND="" ND="^55.151^^" S $P(ND,U,3)=$P(ND,U,3)+1,$P(ND,U,4)=$P(ND,U,4)+1,^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,0)=ND,^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,$P(ND,U,3),0)=P("FC") K ND

LOG ; Update activity log (ask for comment.)

 N ON S ON=ON55

 ;PSJPINIT is defined in PSJUTL3.

 S:+$G(PSJPINIT)'>0 PSJPINIT=DUZ

 I $G(PSIVALT)=1,'$G(PSJUNDC) K DA,DIR S DIR(0)="55.04,.04" D ^DIR K DA,DIR S PSIVAL=$S($D(DIRUT):"",1:Y)

 S:$G(PSIVALT)=2 PSIVAL="Action taken using OE/RR options." D ENTACT^PSIVAL

 K TMP

 S TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.02)=PSIVREA

 S TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.03)=$P(^VA(200,PSJPINIT,0),U)

 S TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.04)=$G(PSIVAL)

 S TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.06)=PSJPINIT

 D FILE^DIE("","TMP")

 K TMP

 D:$D(PSIVALCK) @PSIVALCK K PSIVALT,PSIVALCK,PSIVAL

PSIVORAL  ;BIR/MLM-ACTIVITY LOGGER FOR PHARMACY EDITS ;16 DEC 97 / 1:40 PM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**58,135**;16 DEC 97

 +2       ;

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

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

 +5       ;

EN        ; Entry point for updating activity log from Pharmacy.

 +1       ;

OPI       ; Record changes to Other print info.

 +1        IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,3)),"^")'=$PIECE(P("OPI"),"^")

               SET P("FC")="OTHER PRINT INFO^"_$PIECE($GET(^(3)),"^")_U_$PIECE(P("OPI"),"^")

               DO GTFC

 +2       ;

REMARKS   ; Record changes to remarks.

 +1        IF $GET(^PS(55,DFN,"IV",+ON55,1))'=P("REM")

               SET P("FC")="REMARKS^"_$GET(^(1))_U_P("REM")

               DO GTFC

 +2       ;

ADMIN     ; Record changes to admin. times.

 +1        IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,0)),U,11)'=P(11)

               SET P("FC")="ADMINISTRATION TIMES^"_$PIECE($GET(^(0)),U,11)_U_P(11)

               DO GTFC

 +2       ;

INFUS     ; Record changes to infusion rate.

 +1        IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,0)),U,8)'=P(8)

               SET P("FC")="INFUSION RATE^"_$PIECE($GET(^(0)),U,8)_U_P(8)

               DO GTFC

 +2        IF P("DTYP")=1

               DO SOL

 +3       ;

STOP      ; Record changes to stop date.

 +1        IF $PIECE(^PS(55,DFN,"IV",+ON55,0),U,3)'=P(3)

               SET P("FC")="STOP DATE/TIME^"

               SET Y=$PIECE(^(0),U,3)

               XECUTE ^DD("DD")

               SET $PIECE(P("FC"),U,3)=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)

               SET Y=P(3)

               XECUTE ^DD("DD")

               SET $PIECE(P("FC"),U,2)=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)

               DO GTFC

 +2        KILL DRGI,DRGN,TDRG,P("AGE"),P("FC")

 +3        QUIT

 +4       ;

SOL       ; Record changes to Solutions.

 +1        KILL TDRG

           FOR DRGI=0:0

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

               IF 'DRGI

                   QUIT

               SET TDRG("NEW",$PIECE(DRG("SOL",DRGI),U))=$PIECE(DRG("SOL",DRGI),U,2,3)

 +2        SET P("AGE")="NEW"

 +3        FOR DRGI=0:0

               SET DRGI=$ORDER(^PS(55,DFN,"IV",+ON55,"SOL",DRGI))

               IF 'DRGI

                   QUIT

               SET X=$GET(^PS(55,DFN,"IV",+ON55,"SOL",DRGI,0))

               SET DRG=+$PIECE(X,U)

               SET TDRG("OLD",+DRG)=$PIECE($GET(^PS(52.7,DRG,0)),U)_U_$PIECE(X,U,2)

               IF $GET(TDRG("NEW",DRG))'=$GET(TDRG("OLD",DRG))

                   DO SOL1

 +4        SET P("AGE")="OLD"

           FOR DRGI=0:0

               SET DRG=$ORDER(TDRG("NEW",DRG))

               IF 'DRG

                   QUIT

               IF $GET(TDRG("NEW",DRG))'=$GET(TDRG("OLD",DRG))

                   DO SOL1

 +5        QUIT

 +6       ;

SOL1      ;

 +1        IF '$DATA(TDRG(P("AGE"),DRG))

               SET P("FC")="SOLUTION^"_$PIECE($GET(TDRG("OLD",DRG)),U)_U_$PIECE($GET(TDRG("NEW",DRG)),U)

               DO GTFC

 +2        IF $GET(TDRG("NEW",DRG))=$GET(TDRG("OLD",DRG))

               QUIT

 +3        SET P("FC")="VOLUME^"_$PIECE($GET(TDRG("OLD",DRG)),U,2)_$SELECT($GET(TDRG("OLD",DRG))]"":" ("_$PIECE($GET(^PS(52.7,DRG,0)),U)_")",1:"")_U_$PIECE($GET(TDRG("NEW",DRG)),U,2)_$SELECT($GET(TDRG("NEW",DRG))]"":" ("_$PIECE($GET(^PS(52.7,DRG,0)),U)_")

",1:"")

           DO GTFC

 +4        QUIT

 +5       ;

GTFC      ; Create field change entry in activity log.

 +1        SET ND=$GET(^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,0))

           IF ND=""

               SET ND="^55.151^^"

           SET $PIECE(ND,U,3)=$PIECE(ND,U,3)+1

           SET $PIECE(ND,U,4)=$PIECE(ND,U,4)+1

           SET ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,0)=ND

           SET ^PS(55,DFN,"IV",+ON55,"A",PSIVLN,1,$PIECE(ND,U,3),0)=P("FC")

           KILL ND

 +2        QUIT

LOG       ; Update activity log (ask for comment.)

 +1        NEW ON

           SET ON=ON55

 +2       ;PSJPINIT is defined in PSJUTL3.

 +3        IF +$GET(PSJPINIT)'>0

               SET PSJPINIT=DUZ

 +4        IF $GET(PSIVALT)=1

               IF '$GET(PSJUNDC)

                   KILL DA,DIR

                   SET DIR(0)="55.04,.04"

                   DO ^DIR

                   KILL DA,DIR

                   SET PSIVAL=$SELECT($DATA(DIRUT):"",1:Y)

 +5        IF $GET(PSIVALT)=2

               SET PSIVAL="Action taken using OE/RR options."

           DO ENTACT^PSIVAL

 +6        KILL TMP

 +7        SET TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.02)=PSIVREA

 +8        SET TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.03)=$PIECE(^VA(200,PSJPINIT,0),U)

 +9        SET TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.04)=$GET(PSIVAL)

 +10       SET TMP(55.04,""_PSIVLN_","_+ON55_","_DFN_","_"",.06)=PSJPINIT

 +11       DO FILE^DIE("","TMP")

 +12       KILL TMP

 +13       IF $DATA(PSIVALCK)

               DO @PSIVALCK

           KILL PSIVALT,PSIVALCK,PSIVAL

 +14       QUIT

PSIVORAL.m