- 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 Feb 18, 2025@23:31:37 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