- DIPR120 ;O-OIFO/SO-Move PRIORDATE, PRIORUSER, & PRIORVALUE To FM's #;10:20 AM 12 Dec 2002 [ 12/09/2003 4:47 PM ]
- ;;22.0;VA FileMan;**120,1002**;Mar 30, 1999
- ;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
- DIPR120 ;O-OIFO/SO-Move PRIORDATE, PRIORUSER, & PRIORVALUE To FM's #;10:20 AM 12 Dec 2002 [ 12/09/2003 4:47 PM ]
- +1 ;;22.0;VA FileMan;**120,1002**;Mar 30, 1999
- +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
