PSIVVW1 ;BIR/PR-PRINT ACTIVITY LOG ;06 APR 97 / 5:47 PM
;;5.0;INPATIENT MEDICATIONS;**58,81,267**;16 DEC 97;Build 158
;
; Reference to ^PS(55 is supported by DBIA# 2191
;
;Called at top from Patient Profile option
BEG ;Ask to view activity log
K PSIVLOG,PSIVLAB F Q=0:0 W !,"View activity log" S %=1 D YN^DICN Q:% S HELP="ACTLOG" D ^PSIVHLP
G:%<1 Q S:%=1 PSIVLOG=1
;
BEG1 ;Ask to view label log
F Q=0:0 W !!,"View label log" S %=1 D YN^DICN Q:% S HELP="LABLOG" D ^PSIVHLP2
G:%<1 Q S:%=1 PSIVLAB=1 G ENPR
;
EN ; Show activity, label, or history log.
D FULL^VALM1
S:'$D(ON55) ON55=ON
K DIR S DIR(0)="SOA^A:Activity Log;L:Label Log;H:History Log;I:Instructions History",DIR("A")="(A)ctivity (L)abel (H)istory (I)nstructions History: "
D ^DIR K DIR G:$D(DIRUT) Q N PSJHISEL S PSJHISEL=Y D:Y="H" ENHIS^PSJHIS(DFN,ON55,"V") I PSJHISEL="I" D ENHIS^PSJINHIS(DFN,ON55,"V") G EN
K PSJHIS
D:PSJHISEL="A" EN1 D:PSJHISEL="L" DATA^PSIVLTR1(DFN,+ON55) I $D(PSIVSCR),'$G(PSJDNE) D PAUSE
G EN
;
ENPR ;Entry from profile.
D HOLDHDR^PSJOE
K PSJDNE I $D(PSIVLOG) D EN1 I $D(PSIVSCR),'$D(PSJDNE) D PAUSE
I '$D(PSJDNE),$D(PSIVLAB) D DATA^PSIVLTR1(DFN,+ON55) I $D(PSIVSCR),'$G(PSJDNE) D PAUSE
I $D(PSIVSCR) K DIR S DIR(0)="E" D ^DIR K DIR
;
Q K %,COU,I,L,N,OG,P1,P17,PSIVX,USER
Q
;
EN1 ;Entry for Inmed functionality and viewing the log from IV order entry
K PSJDNE S PSIVSCR=$E(IOST)="C"
I ON["P" D Q
. NEW AT,PN,PX,UD,OD
. S AT="S",PN=1,PX="" F Q=0:0 S Q=$O(^PS(53.1,+ON,"A",Q)) Q:'Q I $D(^(Q,0)) S AND=^(0) D:'(PN#6) NPAGE^PSGVW0 Q:PX["^" D AL1^PSGVW0
. W !
I '$O(^PS(55,DFN,"IV",+ON55,"A",0)) W !!,"No activity LOG to report." G Q
D HDR F JJ=0:0 S JJ=$O(^PS(55,DFN,"IV",+ON55,"A",JJ)) Q:'JJ!$G(PSJDNE) S P1=$G(^(JJ,0)),Y=+$P(P1,"^",5) D ACT
Q
;
ACT ;This module is used for the screen profile
X ^DD("DD") W !,JJ,?3,$P(Y,"@")," ",$P(Y,"@",2),?24 S X=$$CODES^PSIVUTL($P(P1,"^",2),55.04,.02) W X
D NAME^PSJBCMA1($P(P1,U,6),.X) W ?50,X
W !?3,"Comment: ",$P(P1,"^",4) D PAUSE Q:$D(PSJDNE)
F A1=0:0 S A1=$O(^PS(55,DFN,"IV",+ON55,"A",JJ,1,A1)) Q:'A1!$D(PSJDNE) S P1=^(A1,0) D ACTW
W !
Q
;
ACTW ;
N II,NXTOPI
I $P(P1,"^")'="OTHER PRINT INFO"!($P(P1,"^",2)]"")!($P(P1,"^",3)]"") D Q
.I $P(P1,"^",2)=$P(P1,"^",3) Q
.W ! D PAUSE W !?10,"Field: '",$P(P1,"^"),"'" D PAUSE W !?3,"Changed from: '",$P(P1,"^",2),"'" D PAUSE W !?13,"To: '",$P(P1,"^",3),"'" D PAUSE
W ! D PAUSE W !?10,"Field: '",$P(P1,"^"),"'" D PAUSE W !?3,"Changed from: '"
I $P(P1,"^")="OTHER PRINT INFO" D
.N TXTLN S TXTLN=0 F S TXTLN=$O(^PS(55,DFN,"IV",+ON55,"A",JJ,2,TXTLN)) Q:'TXTLN D
..I TXTLN=1 W !?4,"'",^(TXTLN,0) Q
..W !?5,^(TXTLN,0) I '(TXTLN#12) D PAUSE
.W "'",!
D PAUSE
I $P(P1,"^")="OTHER PRINT INFO" S NXTOPI=0 D
.I '$D(^PS(55,DFN,"IV",+ON55,"A",JJ,3)) D Q
..S II=JJ F S II=$O(^PS(55,DFN,"IV",+ON55,"A",II)) Q:'II!$G(NXTOPI) I ($G(^(II,1,1,0))["OTHER PRINT INFO") S NXTOPI=II
..I '$G(NXTOPI) D Q
...S II=0 F S II=$O(^PS(55,DFN,"IV",+ON55,10,II)) Q:'II W:II=1 !?3,"To : ",!?4,"'",^(II,0) W:II>1 !?5,^(II,0)
..N TXTLN S TXTLN=0 F II=0:1 S TXTLN=$O(^PS(55,DFN,"IV",+ON55,"A",NXTOPI,2,TXTLN)) Q:'TXTLN W:II=1 !?3,"To : ",!?4,"'",^(II,0) W:(II>1) !?5,^(II,0)
.N TXTLN S TXTLN=0 F II=0:1 S TXTLN=$O(^PS(55,DFN,"IV",+ON55,"A",JJ,3,TXTLN)) Q:'TXTLN W:TXTLN=1 !?3,"To : ",!?4,"'",^(TXTLN,0) W:TXTLN>1 !?5,^(TXTLN,0) I '(TXTLN#12) D PAUSE
.I $G(II) W "'",!
D PAUSE
Q
PAUSE ;
I ($Y#IOSL)>18,PSIVSCR K DIR S DIR(0)="E" D ^DIR K DIR W !!! I $D(DUOUT)!$D(DTOUT) S (PSJS1,PSJS2,PSJS3,PSJS4)="~",(PSJDNE,PSJPR)=1
Q
;
HDR W !!,"ACTIVITY LOG:",!,"#",?3,"DATE",?14,"TIME",?24,"REASON",?50,"USER",! F I=1:1:79 W "="
Q
;
LOG1 ;This module is used for profile report. (hard printer copy usually)
Q
X ^DD("DD") W !,JJ,?3,$P(Y,"@")," ",$P(Y,"@",2),?24 S X=$$CODES^PSIVUTL($P(P1,"^",2),55.04,.02) W X
W ?50,$P(P1,"^",3),!?3,"Comment: ",$P(P1,"^",4) I ($Y#IOSL)>22,PSIVSCR D PAUSE
F PSIVX=0:0 S PSIVX=$O(^PS(55,DFN,"IV",+ON,"A",JJ,1,PSIVX)) Q:'PSIVX S P1=^(PSIVX,0) W !!?10,"Field: '",$P(P1,"^"),"'",!?3,"Changed from: '",$P(P1,"^",2),"'",!?13,"To: '",$P(P1,"^",3),"'" I ($Y#IOSL)>18,PSIVSCR D PAUSE
Q
ENLOG ;Entry for patient profile report OR patient purge report
;Called from routine PSIVPR
S (ON,ON55)=PSJORD D HDR W:'$O(^PS(55,DFN,"IV",+ON,"A",0)) !!,"No activity LOG to report."
;
K PSJDNE S PSIVSCR=$E(IOST)="C" F JJ=0:0 S JJ=$O(^PS(55,DFN,"IV",+ON,"A",JJ)) Q:'JJ!$D(PSJDNE) S P1=$S($D(^(JJ,0)):^(0),1:""),Y=+$P(P1,"^",5) D ACT
G Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVVW1 4550 printed Sep 23, 2025@19:41:20 Page 2
PSIVVW1 ;BIR/PR-PRINT ACTIVITY LOG ;06 APR 97 / 5:47 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**58,81,267**;16 DEC 97;Build 158
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191
+4 ;
+5 ;Called at top from Patient Profile option
BEG ;Ask to view activity log
+1 KILL PSIVLOG,PSIVLAB
FOR Q=0:0
WRITE !,"View activity log"
SET %=1
DO YN^DICN
if %
QUIT
SET HELP="ACTLOG"
DO ^PSIVHLP
+2 if %<1
GOTO Q
if %=1
SET PSIVLOG=1
+3 ;
BEG1 ;Ask to view label log
+1 FOR Q=0:0
WRITE !!,"View label log"
SET %=1
DO YN^DICN
if %
QUIT
SET HELP="LABLOG"
DO ^PSIVHLP2
+2 if %<1
GOTO Q
if %=1
SET PSIVLAB=1
GOTO ENPR
+3 ;
EN ; Show activity, label, or history log.
+1 DO FULL^VALM1
+2 if '$DATA(ON55)
SET ON55=ON
+3 KILL DIR
SET DIR(0)="SOA^A:Activity Log;L:Label Log;H:History Log;I:Instructions History"
SET DIR("A")="(A)ctivity (L)abel (H)istory (I)nstructions History: "
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q
NEW PSJHISEL
SET PSJHISEL=Y
if Y="H"
DO ENHIS^PSJHIS(DFN,ON55,"V")
IF PSJHISEL="I"
DO ENHIS^PSJINHIS(DFN,ON55,"V")
GOTO EN
+5 KILL PSJHIS
+6 if PSJHISEL="A"
DO EN1
if PSJHISEL="L"
DO DATA^PSIVLTR1(DFN,+ON55)
IF $DATA(PSIVSCR)
IF '$GET(PSJDNE)
DO PAUSE
+7 GOTO EN
+8 ;
ENPR ;Entry from profile.
+1 DO HOLDHDR^PSJOE
+2 KILL PSJDNE
IF $DATA(PSIVLOG)
DO EN1
IF $DATA(PSIVSCR)
IF '$DATA(PSJDNE)
DO PAUSE
+3 IF '$DATA(PSJDNE)
IF $DATA(PSIVLAB)
DO DATA^PSIVLTR1(DFN,+ON55)
IF $DATA(PSIVSCR)
IF '$GET(PSJDNE)
DO PAUSE
+4 IF $DATA(PSIVSCR)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 ;
Q KILL %,COU,I,L,N,OG,P1,P17,PSIVX,USER
+1 QUIT
+2 ;
EN1 ;Entry for Inmed functionality and viewing the log from IV order entry
+1 KILL PSJDNE
SET PSIVSCR=$EXTRACT(IOST)="C"
+2 IF ON["P"
Begin DoDot:1
+3 NEW AT,PN,PX,UD,OD
+4 SET AT="S"
SET PN=1
SET PX=""
FOR Q=0:0
SET Q=$ORDER(^PS(53.1,+ON,"A",Q))
if 'Q
QUIT
IF $DATA(^(Q,0))
SET AND=^(0)
if '(PN#6)
DO NPAGE^PSGVW0
if PX["^"
QUIT
DO AL1^PSGVW0
+5 WRITE !
End DoDot:1
QUIT
+6 IF '$ORDER(^PS(55,DFN,"IV",+ON55,"A",0))
WRITE !!,"No activity LOG to report."
GOTO Q
+7 DO HDR
FOR JJ=0:0
SET JJ=$ORDER(^PS(55,DFN,"IV",+ON55,"A",JJ))
if 'JJ!$GET(PSJDNE)
QUIT
SET P1=$GET(^(JJ,0))
SET Y=+$PIECE(P1,"^",5)
DO ACT
+8 QUIT
+9 ;
ACT ;This module is used for the screen profile
+1 XECUTE ^DD("DD")
WRITE !,JJ,?3,$PIECE(Y,"@")," ",$PIECE(Y,"@",2),?24
SET X=$$CODES^PSIVUTL($PIECE(P1,"^",2),55.04,.02)
WRITE X
+2 DO NAME^PSJBCMA1($PIECE(P1,U,6),.X)
WRITE ?50,X
+3 WRITE !?3,"Comment: ",$PIECE(P1,"^",4)
DO PAUSE
if $DATA(PSJDNE)
QUIT
+4 FOR A1=0:0
SET A1=$ORDER(^PS(55,DFN,"IV",+ON55,"A",JJ,1,A1))
if 'A1!$DATA(PSJDNE)
QUIT
SET P1=^(A1,0)
DO ACTW
+5 WRITE !
+6 QUIT
+7 ;
ACTW ;
+1 NEW II,NXTOPI
+2 IF $PIECE(P1,"^")'="OTHER PRINT INFO"!($PIECE(P1,"^",2)]"")!($PIECE(P1,"^",3)]"")
Begin DoDot:1
+3 IF $PIECE(P1,"^",2)=$PIECE(P1,"^",3)
QUIT
+4 WRITE !
DO PAUSE
WRITE !?10,"Field: '",$PIECE(P1,"^"),"'"
DO PAUSE
WRITE !?3,"Changed from: '",$PIECE(P1,"^",2),"'"
DO PAUSE
WRITE !?13,"To: '",$PIECE(P1,"^",3),"'"
DO PAUSE
End DoDot:1
QUIT
+5 WRITE !
DO PAUSE
WRITE !?10,"Field: '",$PIECE(P1,"^"),"'"
DO PAUSE
WRITE !?3,"Changed from: '"
+6 IF $PIECE(P1,"^")="OTHER PRINT INFO"
Begin DoDot:1
+7 NEW TXTLN
SET TXTLN=0
FOR
SET TXTLN=$ORDER(^PS(55,DFN,"IV",+ON55,"A",JJ,2,TXTLN))
if 'TXTLN
QUIT
Begin DoDot:2
+8 IF TXTLN=1
WRITE !?4,"'",^(TXTLN,0)
QUIT
+9 WRITE !?5,^(TXTLN,0)
IF '(TXTLN#12)
DO PAUSE
End DoDot:2
+10 WRITE "'",!
End DoDot:1
+11 DO PAUSE
+12 IF $PIECE(P1,"^")="OTHER PRINT INFO"
SET NXTOPI=0
Begin DoDot:1
+13 IF '$DATA(^PS(55,DFN,"IV",+ON55,"A",JJ,3))
Begin DoDot:2
+14 SET II=JJ
FOR
SET II=$ORDER(^PS(55,DFN,"IV",+ON55,"A",II))
if 'II!$GET(NXTOPI)
QUIT
IF ($GET(^(II,1,1,0))["OTHER PRINT INFO")
SET NXTOPI=II
+15 IF '$GET(NXTOPI)
Begin DoDot:3
+16 SET II=0
FOR
SET II=$ORDER(^PS(55,DFN,"IV",+ON55,10,II))
if 'II
QUIT
if II=1
WRITE !?3,"To : ",!?4,"'",^(II,0)
if II>1
WRITE !?5,^(II,0)
End DoDot:3
QUIT
+17 NEW TXTLN
SET TXTLN=0
FOR II=0:1
SET TXTLN=$ORDER(^PS(55,DFN,"IV",+ON55,"A",NXTOPI,2,TXTLN))
if 'TXTLN
QUIT
if II=1
WRITE !?3,"To : ",!?4,"'",^(II,0)
if (II>1)
WRITE !?5,^(II,0)
End DoDot:2
QUIT
+18 NEW TXTLN
SET TXTLN=0
FOR II=0:1
SET TXTLN=$ORDER(^PS(55,DFN,"IV",+ON55,"A",JJ,3,TXTLN))
if 'TXTLN
QUIT
if TXTLN=1
WRITE !?3,"To : ",!?4,"'",^(TXTLN,0)
if TXTLN>1
WRITE !?5,^(TXTLN,0)
IF '(TXTLN#12)
DO PAUSE
+19 IF $GET(II)
WRITE "'",!
End DoDot:1
+20 DO PAUSE
+21 QUIT
PAUSE ;
+1 IF ($Y#IOSL)>18
IF PSIVSCR
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !!!
IF $DATA(DUOUT)!$DATA(DTOUT)
SET (PSJS1,PSJS2,PSJS3,PSJS4)="~"
SET (PSJDNE,PSJPR)=1
+2 QUIT
+3 ;
HDR WRITE !!,"ACTIVITY LOG:",!,"#",?3,"DATE",?14,"TIME",?24,"REASON",?50,"USER",!
FOR I=1:1:79
WRITE "="
+1 QUIT
+2 ;
LOG1 ;This module is used for profile report. (hard printer copy usually)
+1 QUIT
+2 XECUTE ^DD("DD")
WRITE !,JJ,?3,$PIECE(Y,"@")," ",$PIECE(Y,"@",2),?24
SET X=$$CODES^PSIVUTL($PIECE(P1,"^",2),55.04,.02)
WRITE X
+3 WRITE ?50,$PIECE(P1,"^",3),!?3,"Comment: ",$PIECE(P1,"^",4)
IF ($Y#IOSL)>22
IF PSIVSCR
DO PAUSE
+4 FOR PSIVX=0:0
SET PSIVX=$ORDER(^PS(55,DFN,"IV",+ON,"A",JJ,1,PSIVX))
if 'PSIVX
QUIT
SET P1=^(PSIVX,0)
WRITE !!?10,"Field: '",$PIECE(P1,"^"),"'",!?3,"Changed from: '",$PIECE(P1,"^",2),"'",!?13,"To: '",$PIECE(P1,"^",3),"'"
IF ($Y#IOSL)>18
IF PSIVSCR
DO PAUSE
+5 QUIT
ENLOG ;Entry for patient profile report OR patient purge report
+1 ;Called from routine PSIVPR
+2 SET (ON,ON55)=PSJORD
DO HDR
if '$ORDER(^PS(55,DFN,"IV",+ON,"A",0))
WRITE !!,"No activity LOG to report."
+3 ;
+4 KILL PSJDNE
SET PSIVSCR=$EXTRACT(IOST)="C"
FOR JJ=0:0
SET JJ=$ORDER(^PS(55,DFN,"IV",+ON,"A",JJ))
if 'JJ!$DATA(PSJDNE)
QUIT
SET P1=$SELECT($DATA(^(JJ,0)):^(0),1:"")
SET Y=+$PIECE(P1,"^",5)
DO ACT
+5 GOTO Q
