DIPR120 ;O-OIFO/SO-Move PRIORDATE, PRIORUSER, & PRIORVALUE To FM's #;10:20 AM 12 Dec 2002
;;22.0;VA FileMan;**120**;Mar 30, 1999;Build 1
;Per VHA Directive 10-93-142, this routine should not be modified.
N COUNT,X,IEN,SADAT,SAVAL,SAUSER
S X="Beginning Pre-Installation..." D MES^XPDUTL(X)
S COUNT=0
D RPDATE,RPUSER,RPVAL
S X=" " D MES^XPDUTL(X)
I '$D(SADAT) D APDATE
I '$D(SAUSER) D APUSER
I '$D(SAVAL) D APVAL
D END
Q
RPDATE ; Find & Remove PRIORDATE
I $D(^DD("FUNC",91,0))#2,$P(^DD("FUNC",91,0),U)="PRIORDATE",'$D(^DD("FUNC",91,1)) S SADAT=1
I '$D(SADAT),$D(^DD("FUNC",91,0))#2 D S SADAT=1
. N I S I=91 D ERRMES Q
S IEN=99
F S IEN=$O(^DD("FUNC","B","PRIORDATE",IEN)) Q:'IEN D
. I ^DD("FUNC",IEN,9)'="When it has an argument (Fieldname), returns as a multiple all prior Date/Times of auditing, most recent first. Without an argument, it is most recent audited Date/Time for the Entry" Q
. S X="Deleting Function PRIORDATE" D MES^XPDUTL(X)
. K ^DD("FUNC",IEN)
. K ^DD("FUNC","B","PRIORDATE",IEN)
. S COUNT=COUNT-1
Q
;
RPUSER ; Find & Remove PRIORUSER
I $D(^DD("FUNC",92,0))#2,$P(^DD("FUNC",92,0),U)="PRIORUSER",'$D(^DD("FUNC",92,1)) S SAUSER=1
I '$D(SAUSER),$D(^DD("FUNC",92,0))#2 D S SAUSER=1
. N I S I=92 D ERRMES Q
S IEN=99
F S IEN=$O(^DD("FUNC","B","PRIORUSER",IEN)) Q:'IEN D
. I ^DD("FUNC",IEN,9)'="When it has an argument (Fieldname), returns as a multiple all prior audited Users, most recent first. Without an argument, it is most recent audited User for the Entry" Q
. S X="Deleting Function PRIORUSER" D MES^XPDUTL(X)
. K ^DD("FUNC",IEN)
. K ^DD("FUNC","B","PRIORUSER",IEN)
. S COUNT=COUNT-1
Q
;
RPVAL ; Find & Remove PRIORVALUE
I $D(^DD("FUNC",90,0))#2,$P(^DD("FUNC",90,0),U)="PRIORVALUE",'$D(^DD("FUNC",90,1)) S SAVAL=1
I '$D(SAVAL),$D(^DD("FUNC",90,0))#2 D S SAVAL=1
. N I S I=90 D ERRMES Q
S IEN=99
F S IEN=$O(^DD("FUNC","B","PRIORVALUE",IEN)) Q:'IEN D
. I ^DD("FUNC",IEN,9)'="Takes name of an Audited Field. Returns as a multiple all prior values of the field, most recent first." Q
. S X="Deleting Function PRIORVALUE" D MES^XPDUTL(X)
. K ^DD("FUNC",IEN)
. K ^DD("FUNC","B","PRIORVALUE",IEN)
. S COUNT=COUNT-1
Q
;
APDATE ; Add PRIORDATE at IEN 91
S X="Installing Function PRIORDATE at #91" D MES^XPDUTL(X)
S ^DD("FUNC",91,0)="PRIORDATE"
S ^DD("FUNC",91,3)="VARIABLE"
S ^DD("FUNC",91,9)="When it has an argument (Fieldname), returns as a multiple all prior Date/Times of auditing, most recent first. Without an argument, it is most recent audited Date/Time for the Entry"
S ^DD("FUNC","B","PRIORDATE",91)=""
S COUNT=COUNT+1
Q
;
APUSER ; Add PRIORUSER at IEN 92
S X="Installing Function PRIORUSER at #92" D MES^XPDUTL(X)
S ^DD("FUNC",92,0)="PRIORUSER"
S ^DD("FUNC",92,3)="VARIABLE"
S ^DD("FUNC",92,9)="When it has an argument (Fieldname), returns as a multiple all prior audited Users, most recent first. Without an argument, it is most recent audited User for the Entry"
S ^DD("FUNC","B","PRIORUSER",92)=""
S COUNT=COUNT+1
Q
;
APVAL ; Add PRIORVALUE at IEN 90
S X="Installing Function PRIORVALUE at #90" D MES^XPDUTL(X)
S ^DD("FUNC",90,0)="PRIORVALUE"
S ^DD("FUNC",90,9)="Takes name of an Audited Field. Returns as a multiple all prior values of the field, most recent first."
S ^DD("FUNC","B","PRIORVALUE",90)=""
S COUNT=COUNT+1
Q
;
END I COUNT=0 D ENDMES Q ; Count piece doesn't need updating
; Update 4th piece of Zeroth node
L +^DD("FUNC",0):5 S $P(^(0),"^",4)=$P(^DD("FUNC",0),"^",4)+COUNT I L -^DD("FUNC",0)
D ENDMES
Q
;
ENDMES ;
S X="Done..." D MES^XPDUTL(X)
Q
ERRMES ;
S X="The "_$P(^DD("FUNC",I,0),U)_" Function needs to be evaluated by SD&D." D MES^XPDUTL(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIPR120 3775 printed Sep 23, 2025@20:29:18 Page 2
DIPR120 ;O-OIFO/SO-Move PRIORDATE, PRIORUSER, & PRIORVALUE To FM's #;10:20 AM 12 Dec 2002
+1 ;;22.0;VA FileMan;**120**;Mar 30, 1999;Build 1
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 NEW COUNT,X,IEN,SADAT,SAVAL,SAUSER
+4 SET X="Beginning Pre-Installation..."
DO MES^XPDUTL(X)
+5 SET COUNT=0
+6 DO RPDATE
DO RPUSER
DO RPVAL
+7 SET X=" "
DO MES^XPDUTL(X)
+8 IF '$DATA(SADAT)
DO APDATE
+9 IF '$DATA(SAUSER)
DO APUSER
+10 IF '$DATA(SAVAL)
DO APVAL
+11 DO END
+12 QUIT
RPDATE ; Find & Remove PRIORDATE
+1 IF $DATA(^DD("FUNC",91,0))#2
IF $PIECE(^DD("FUNC",91,0),U)="PRIORDATE"
IF '$DATA(^DD("FUNC",91,1))
SET SADAT=1
+2 IF '$DATA(SADAT)
IF $DATA(^DD("FUNC",91,0))#2
Begin DoDot:1
+3 NEW I
SET I=91
DO ERRMES
QUIT
End DoDot:1
SET SADAT=1
+4 SET IEN=99
+5 FOR
SET IEN=$ORDER(^DD("FUNC","B","PRIORDATE",IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 IF ^DD("FUNC",IEN,9)'="When it has an argument (Fieldname), returns as a multiple all prior Date/Times of auditing, most recent first. Without an argument, it is most recent audited Date/Time for the Entry"
QUIT
+7 SET X="Deleting Function PRIORDATE"
DO MES^XPDUTL(X)
+8 KILL ^DD("FUNC",IEN)
+9 KILL ^DD("FUNC","B","PRIORDATE",IEN)
+10 SET COUNT=COUNT-1
End DoDot:1
+11 QUIT
+12 ;
RPUSER ; Find & Remove PRIORUSER
+1 IF $DATA(^DD("FUNC",92,0))#2
IF $PIECE(^DD("FUNC",92,0),U)="PRIORUSER"
IF '$DATA(^DD("FUNC",92,1))
SET SAUSER=1
+2 IF '$DATA(SAUSER)
IF $DATA(^DD("FUNC",92,0))#2
Begin DoDot:1
+3 NEW I
SET I=92
DO ERRMES
QUIT
End DoDot:1
SET SAUSER=1
+4 SET IEN=99
+5 FOR
SET IEN=$ORDER(^DD("FUNC","B","PRIORUSER",IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 IF ^DD("FUNC",IEN,9)'="When it has an argument (Fieldname), returns as a multiple all prior audited Users, most recent first. Without an argument, it is most recent audited User for the Entry"
QUIT
+7 SET X="Deleting Function PRIORUSER"
DO MES^XPDUTL(X)
+8 KILL ^DD("FUNC",IEN)
+9 KILL ^DD("FUNC","B","PRIORUSER",IEN)
+10 SET COUNT=COUNT-1
End DoDot:1
+11 QUIT
+12 ;
RPVAL ; Find & Remove PRIORVALUE
+1 IF $DATA(^DD("FUNC",90,0))#2
IF $PIECE(^DD("FUNC",90,0),U)="PRIORVALUE"
IF '$DATA(^DD("FUNC",90,1))
SET SAVAL=1
+2 IF '$DATA(SAVAL)
IF $DATA(^DD("FUNC",90,0))#2
Begin DoDot:1
+3 NEW I
SET I=90
DO ERRMES
QUIT
End DoDot:1
SET SAVAL=1
+4 SET IEN=99
+5 FOR
SET IEN=$ORDER(^DD("FUNC","B","PRIORVALUE",IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 IF ^DD("FUNC",IEN,9)'="Takes name of an Audited Field. Returns as a multiple all prior values of the field, most recent first."
QUIT
+7 SET X="Deleting Function PRIORVALUE"
DO MES^XPDUTL(X)
+8 KILL ^DD("FUNC",IEN)
+9 KILL ^DD("FUNC","B","PRIORVALUE",IEN)
+10 SET COUNT=COUNT-1
End DoDot:1
+11 QUIT
+12 ;
APDATE ; Add PRIORDATE at IEN 91
+1 SET X="Installing Function PRIORDATE at #91"
DO MES^XPDUTL(X)
+2 SET ^DD("FUNC",91,0)="PRIORDATE"
+3 SET ^DD("FUNC",91,3)="VARIABLE"
+4 SET ^DD("FUNC",91,9)="When it has an argument (Fieldname), returns as a multiple all prior Date/Times of auditing, most recent first. Without an argument, it is most recent audited Date/Time for the Entry"
+5 SET ^DD("FUNC","B","PRIORDATE",91)=""
+6 SET COUNT=COUNT+1
+7 QUIT
+8 ;
APUSER ; Add PRIORUSER at IEN 92
+1 SET X="Installing Function PRIORUSER at #92"
DO MES^XPDUTL(X)
+2 SET ^DD("FUNC",92,0)="PRIORUSER"
+3 SET ^DD("FUNC",92,3)="VARIABLE"
+4 SET ^DD("FUNC",92,9)="When it has an argument (Fieldname), returns as a multiple all prior audited Users, most recent first. Without an argument, it is most recent audited User for the Entry"
+5 SET ^DD("FUNC","B","PRIORUSER",92)=""
+6 SET COUNT=COUNT+1
+7 QUIT
+8 ;
APVAL ; Add PRIORVALUE at IEN 90
+1 SET X="Installing Function PRIORVALUE at #90"
DO MES^XPDUTL(X)
+2 SET ^DD("FUNC",90,0)="PRIORVALUE"
+3 SET ^DD("FUNC",90,9)="Takes name of an Audited Field. Returns as a multiple all prior values of the field, most recent first."
+4 SET ^DD("FUNC","B","PRIORVALUE",90)=""
+5 SET COUNT=COUNT+1
+6 QUIT
+7 ;
END ; Count piece doesn't need updating
IF COUNT=0
DO ENDMES
QUIT
+1 ; Update 4th piece of Zeroth node
+2 LOCK +^DD("FUNC",0):5
SET $PIECE(^(0),"^",4)=$PIECE(^DD("FUNC",0),"^",4)+COUNT
IF $TEST
LOCK -^DD("FUNC",0)
+3 DO ENDMES
+4 QUIT
+5 ;
ENDMES ;
+1 SET X="Done..."
DO MES^XPDUTL(X)
+2 QUIT
ERRMES ;
+1 SET X="The "_$PIECE(^DD("FUNC",I,0),U)_" Function needs to be evaluated by SD&D."
DO MES^XPDUTL(X)
+2 QUIT
