PSGVW0 ;BIR/CML3-SHOWS ACTIVITY LOG ;16 DEC 97 / 1:38 PM
;;5.0;INPATIENT MEDICATIONS;**49,54,85,267,315**;16 DEC 97;Build 73
;;Per VHA Directive 2004-038, this routine should not be modified.
; Reference to ^PS(55 is supported by DBIA 2191
;
F R !!,"Show LONG, SHORT, or NO activity log? N// ",AT:DTIME D ALC Q:Q
Q:"^N"[AT S PN=1,PX="" F Q=0:0 S Q=$O(@(F_"9,"_Q_")")) Q:'Q I $D(^(Q,0)) S AND=^(0) D:'(PN#6) NPAGE Q:PX["^" D AL1
Q
AL1 S PN=PN+1,UD=$P(AND,"^",3) I AT="S",UD?4N,$E(UD)=6,UD#6000 Q
W !!?4,"Date: ",$$ENDTC^PSGMI(+AND) W:$S(UD'?4N:1,1:$E(UD,1,2)'=10) ?30,"User: ",$$ENNPN^PSGMI($P(AND,"^",2))
W !,"Activity: ORDER ",$S(UD="":"****",'$D(^PS(53.3,UD,0)):UD,$P(^(0),"^")]"":$P(^(0),"^"),1:UD)
AL2 I UD?4N,$E(UD)=6 W !?3,"Field: ",$P(AND,"^",4) S OD=$P(AND,"^",5) I OD>2000000,$P(OD,".",2) S OD=$$ENDTC^PSGMI(OD)
I AND'["SPECIAL INSTRUCTIONS"&(AND'["OTHER PRINT INFO")&(AND'["DURATION OF ADMINISTRATION") I UD?4N,$E(UD)=6 W !,"Old Data: ",OD ;*315
I AND["DURATION OF ADMINISTRATION",UD?4N,$E(UD)=6 W !,"Old Data: ",(OD/60)_" hours" ;*315
I AND["SPECIAL INSTRUCTIONS" W !,"Old Data: " D
.I ($G(PSJORD)["U") D
..N Q2 S Q2=0 F S Q2=$O(^PS(55,DFN,5,+PSJORD,9,Q,1,Q2)) Q:'Q2 W !?3,^(Q2,0)
..S Q2=0 F S Q2=$O(^PS(55,DFN,5,+PSJORD,9,Q,2,Q2)) Q:'Q2 W:(Q2=1) !,"New Data: " W !?3,^(Q2,0)
.I ($G(PSJORD)["P") N Q2 S Q2=0 F S Q2=$O(^PS(53.1,+PSJORD,"A",Q,1,Q2)) Q:'Q2 W !?3,^(Q2,0)
I AND["OTHER PRINT INFO" W !,"Old Data: " D
.I ($G(PSJORD)["U") N Q2 S Q2=0 F S Q2=$O(^PS(55,DFN,"IV",+PSJORD,"A",Q,1,1,Q2)) Q:'Q2 W !?3,^(Q2,0)
.I ($G(PSJORD)["P") N Q2 S Q2=0 F S Q2=$O(^PS(53.1,+PSJORD,"A",Q,1,Q2)) Q:'Q2 W !?3,^(Q2,0)
I UD?4N,$E(UD)=7,$P(AND,"^",4)]"" W !?3,"Field: ",$P(AND,"^",4)
Q
NPAGE I $E(IOST)="C" R !!,"Enter '^' to stop, or press RETURN to continue.",PX:DTIME
Q
ALC ;
S Q=1 W:'$T $C(7) I AT["^"!'$T S AT="^" Q
I AT="" W " (NO)" S AT="N" Q
F PX="SHORT","LONG","NO" I $P(PX,AT)="" W $P(PX,AT,2) S AT=$E(AT) Q
Q:$T S Q=0 I AT'["?" W $C(7)," ??" Q
W !!,"Enter 'LONG' (or 'L') to see ALL of the entries of this activity log. Enter 'SHORT' (or 'S') to NOT see the fields edited because of the order being",!,"renewed, discontinued, etc. Simply press the RETURN key "
W "(or enter 'NO', 'N',",!,"or '^') to NOT see the activity log." Q
;
ENA ;
I PSGORD["U" S PN=1,PX="" F Q=0:0 S Q=$O(^PS(55,PSGP,5,+PSGORD,9,Q)) Q:'Q I $D(^(Q,0)) S AND=^(0) D:'(PN#6) NPAGE Q:PX["^" D AL1
I PSGORD["P" S PN=1,PX="" F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,"A",Q)) Q:'Q I $D(^(Q,0)) S AND=^(0) D:'(PN#6) NPAGE Q:PX["^" D AL1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGVW0 2599 printed Jan 18, 2025@03:04:44 Page 2
PSGVW0 ;BIR/CML3-SHOWS ACTIVITY LOG ;16 DEC 97 / 1:38 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**49,54,85,267,315**;16 DEC 97;Build 73
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ; Reference to ^PS(55 is supported by DBIA 2191
+4 ;
+5 FOR
READ !!,"Show LONG, SHORT, or NO activity log? N// ",AT:DTIME
DO ALC
if Q
QUIT
+6 if "^N"[AT
QUIT
SET PN=1
SET PX=""
FOR Q=0:0
SET Q=$ORDER(@(F_"9,"_Q_")"))
if 'Q
QUIT
IF $DATA(^(Q,0))
SET AND=^(0)
if '(PN#6)
DO NPAGE
if PX["^"
QUIT
DO AL1
+7 QUIT
AL1 SET PN=PN+1
SET UD=$PIECE(AND,"^",3)
IF AT="S"
IF UD?4N
IF $EXTRACT(UD)=6
IF UD#6000
QUIT
+1 WRITE !!?4,"Date: ",$$ENDTC^PSGMI(+AND)
if $SELECT(UD'?4N
WRITE ?30,"User: ",$$ENNPN^PSGMI($PIECE(AND,"^",2))
+2 WRITE !,"Activity: ORDER ",$SELECT(UD="":"****",'$DATA(^PS(53.3,UD,0)):UD,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:UD)
AL2 IF UD?4N
IF $EXTRACT(UD)=6
WRITE !?3,"Field: ",$PIECE(AND,"^",4)
SET OD=$PIECE(AND,"^",5)
IF OD>2000000
IF $PIECE(OD,".",2)
SET OD=$$ENDTC^PSGMI(OD)
+1 ;*315
IF AND'["SPECIAL INSTRUCTIONS"&(AND'["OTHER PRINT INFO")&(AND'["DURATION OF ADMINISTRATION")
IF UD?4N
IF $EXTRACT(UD)=6
WRITE !,"Old Data: ",OD
+2 ;*315
IF AND["DURATION OF ADMINISTRATION"
IF UD?4N
IF $EXTRACT(UD)=6
WRITE !,"Old Data: ",(OD/60)_" hours"
+3 IF AND["SPECIAL INSTRUCTIONS"
WRITE !,"Old Data: "
Begin DoDot:1
+4 IF ($GET(PSJORD)["U")
Begin DoDot:2
+5 NEW Q2
SET Q2=0
FOR
SET Q2=$ORDER(^PS(55,DFN,5,+PSJORD,9,Q,1,Q2))
if 'Q2
QUIT
WRITE !?3,^(Q2,0)
+6 SET Q2=0
FOR
SET Q2=$ORDER(^PS(55,DFN,5,+PSJORD,9,Q,2,Q2))
if 'Q2
QUIT
if (Q2=1)
WRITE !,"New Data: "
WRITE !?3,^(Q2,0)
End DoDot:2
+7 IF ($GET(PSJORD)["P")
NEW Q2
SET Q2=0
FOR
SET Q2=$ORDER(^PS(53.1,+PSJORD,"A",Q,1,Q2))
if 'Q2
QUIT
WRITE !?3,^(Q2,0)
End DoDot:1
+8 IF AND["OTHER PRINT INFO"
WRITE !,"Old Data: "
Begin DoDot:1
+9 IF ($GET(PSJORD)["U")
NEW Q2
SET Q2=0
FOR
SET Q2=$ORDER(^PS(55,DFN,"IV",+PSJORD,"A",Q,1,1,Q2))
if 'Q2
QUIT
WRITE !?3,^(Q2,0)
+10 IF ($GET(PSJORD)["P")
NEW Q2
SET Q2=0
FOR
SET Q2=$ORDER(^PS(53.1,+PSJORD,"A",Q,1,Q2))
if 'Q2
QUIT
WRITE !?3,^(Q2,0)
End DoDot:1
+11 IF UD?4N
IF $EXTRACT(UD)=7
IF $PIECE(AND,"^",4)]""
WRITE !?3,"Field: ",$PIECE(AND,"^",4)
+12 QUIT
NPAGE IF $EXTRACT(IOST)="C"
READ !!,"Enter '^' to stop, or press RETURN to continue.",PX:DTIME
+1 QUIT
ALC ;
+1 SET Q=1
if '$TEST
WRITE $CHAR(7)
IF AT["^"!'$TEST
SET AT="^"
QUIT
+2 IF AT=""
WRITE " (NO)"
SET AT="N"
QUIT
+3 FOR PX="SHORT","LONG","NO"
IF $PIECE(PX,AT)=""
WRITE $PIECE(PX,AT,2)
SET AT=$EXTRACT(AT)
QUIT
+4 if $TEST
QUIT
SET Q=0
IF AT'["?"
WRITE $CHAR(7)," ??"
QUIT
+5 WRITE !!,"Enter 'LONG' (or 'L') to see ALL of the entries of this activity log. Enter 'SHORT' (or 'S') to NOT see the fields edited because of the order being",!,"renewed, discontinued, etc. Simply press the RETURN key "
+6 WRITE "(or enter 'NO', 'N',",!,"or '^') to NOT see the activity log."
QUIT
+7 ;
ENA ;
+1 IF PSGORD["U"
SET PN=1
SET PX=""
FOR Q=0:0
SET Q=$ORDER(^PS(55,PSGP,5,+PSGORD,9,Q))
if 'Q
QUIT
IF $DATA(^(Q,0))
SET AND=^(0)
if '(PN#6)
DO NPAGE
if PX["^"
QUIT
DO AL1
+2 IF PSGORD["P"
SET PN=1
SET PX=""
FOR Q=0:0
SET Q=$ORDER(^PS(53.1,+PSGORD,"A",Q))
if 'Q
QUIT
IF $DATA(^(Q,0))
SET AND=^(0)
if '(PN#6)
DO NPAGE
if PX["^"
QUIT
DO AL1
+3 QUIT
