FSCAUDIT ;SLC/STAFF-NOIS Audit ;9/6/98 20:28
;;1.1;NOIS;;Sep 06, 1998
;
AUDIT(CALL,OLDV,NEWV) ; from FSCLMPE1, FSCRPCEB, FSCRPCEC, FSCRPCW
; Call is the internal entry number from 7100
; OLDV will be a subscripted variable OLDV(DATENAME)=VALUE
; NEWV will be a subscripted variable NEWV(DATENAME)=VALUE
;
I '$G(CALL) Q
N ABBREV,CNT,LASTLINE,OK,STR K STR
S CNT=0,ABBREV="" F S ABBREV=$O(OLDV(ABBREV)) Q:ABBREV="" D
.I OLDV(ABBREV)'=NEWV(ABBREV) D
..I 'CNT S CNT=CNT+1,STR(CNT)="*** "_$$FMTE^XLFDT($$NOW^XLFDT)_" "_$$VALUE^FSCGET(DUZ,7100,5)
..S CNT=CNT+1
..I ABBREV="SUBJECT" S STR(CNT)=$P($G(^FSC("FLD",+$O(^FSC("FLD","AC",ABBREV,0)),0)),U)_": changed from "_OLDV(ABBREV)_" to "_NEWV(ABBREV) Q ; treated separate because no 2nd piece since '^' is allowed in value
..S STR(CNT)=$P($G(^FSC("FLD",+$O(^FSC("FLD","AC",ABBREV,0)),0)),U)_": changed from "
..I $L(STR(CNT))+$L($P(OLDV(ABBREV),U,2))+4<245 S STR(CNT)=STR(CNT)_$P(OLDV(ABBREV),U,2)_" to "
..E S CNT=CNT+1,STR(CNT)=$P(OLDV(ABBREV),U,2)_" to "
..I $L(STR(CNT))+$L($P(NEWV(ABBREV),U,2))<245 S STR(CNT)=STR(CNT)_$P(NEWV(ABBREV),U,2)
..E S CNT=CNT+1,STR(CNT)=$P(NEWV(ABBREV),U,2)
I CNT D I 'OK Q
.S OK=1
.S CNT=CNT+1,STR(CNT)="" ; add an extra line
.L +^FSCD("CALL",CALL):30 I '$T S OK=0 Q
.S LASTLINE=+$O(^FSCD("CALL",CALL,100,"A"),-1)
.S CNT=0 F S CNT=$O(STR(CNT)) Q:CNT<1 D
..S LASTLINE=LASTLINE+1
..S ^FSCD("CALL",CALL,100,LASTLINE,0)=STR(CNT)
.S ^FSCD("CALL",CALL,100,0)="^^"_LASTLINE_U_LASTLINE_U_DT_U
.L -^FSCD("CALL",CALL)
D UPDATE(CALL)
K STR
Q
;
DESC(CALL,OLDV,NEWV) ; from FSCLMPE1, FSCRPCEC, FSCRPCEF
I '$G(CALL) Q
N ABBREV,CNT,LASTLINE,OK,STR K STR
S CNT=0,ABBREV="" F S ABBREV=$O(OLDV(ABBREV)) Q:ABBREV="" D
.I OLDV(ABBREV)'=NEWV(ABBREV) D
..I 'CNT S CNT=CNT+1,STR(CNT)="*** "_$$FMTE^XLFDT($$NOW^XLFDT)_" "_$$VALUE^FSCGET(DUZ,7100,5)
..S CNT=CNT+1
..S STR(CNT)=$P($G(^FSC("FLD",+$O(^FSC("FLD","AC",ABBREV,0)),0)),U)_": edited."
I CNT D I 'OK Q
.S OK=1
.S CNT=CNT+1,STR(CNT)="" ; add an extra line
.L +^FSCD("CALL",CALL):30 I '$T S OK=0 Q
.S LASTLINE=+$O(^FSCD("CALL",CALL,100,"A"),-1)
.S CNT=0 F S CNT=$O(STR(CNT)) Q:CNT<1 D
..S LASTLINE=LASTLINE+1
..S ^FSCD("CALL",CALL,100,LASTLINE,0)=STR(CNT)
.S ^FSCD("CALL",CALL,100,0)="^^"_LASTLINE_U_LASTLINE_U_DT_U
.L -^FSCD("CALL",CALL)
D UPDATE(CALL)
K STR
Q
;
UPDATE(DA) ; from FSCEB, FSCEU, FSCRPCEB, FSCRPCEC, FSCRPCEN, FSCRPCF
N DIE,DR
S DIE="^FSCD(""CALL"",",DR="123///NOW;124///`"_DUZ
L +^FSCD("CALL",CALL):30 I '$T Q ; *** needs ok
D ^DIE
L -^FSCD("CALL",CALL)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCAUDIT 2631 printed Dec 13, 2024@02:17:24 Page 2
FSCAUDIT ;SLC/STAFF-NOIS Audit ;9/6/98 20:28
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
AUDIT(CALL,OLDV,NEWV) ; from FSCLMPE1, FSCRPCEB, FSCRPCEC, FSCRPCW
+1 ; Call is the internal entry number from 7100
+2 ; OLDV will be a subscripted variable OLDV(DATENAME)=VALUE
+3 ; NEWV will be a subscripted variable NEWV(DATENAME)=VALUE
+4 ;
+5 IF '$GET(CALL)
QUIT
+6 NEW ABBREV,CNT,LASTLINE,OK,STR
KILL STR
+7 SET CNT=0
SET ABBREV=""
FOR
SET ABBREV=$ORDER(OLDV(ABBREV))
if ABBREV=""
QUIT
Begin DoDot:1
+8 IF OLDV(ABBREV)'=NEWV(ABBREV)
Begin DoDot:2
+9 IF 'CNT
SET CNT=CNT+1
SET STR(CNT)="*** "_$$FMTE^XLFDT($$NOW^XLFDT)_" "_$$VALUE^FSCGET(DUZ,7100,5)
+10 SET CNT=CNT+1
+11 ; treated separate because no 2nd piece since '^' is allowed in value
IF ABBREV="SUBJECT"
SET STR(CNT)=$PIECE($GET(^FSC("FLD",+$ORDER(^FSC("FLD","AC",ABBREV,0)),0)),U)_": changed from "_OLDV(ABBREV)_" to "_NEWV(ABBREV)
QUIT
+12 SET STR(CNT)=$PIECE($GET(^FSC("FLD",+$ORDER(^FSC("FLD","AC",ABBREV,0)),0)),U)_": changed from "
+13 IF $LENGTH(STR(CNT))+$LENGTH($PIECE(OLDV(ABBREV),U,2))+4<245
SET STR(CNT)=STR(CNT)_$PIECE(OLDV(ABBREV),U,2)_" to "
+14 IF '$TEST
SET CNT=CNT+1
SET STR(CNT)=$PIECE(OLDV(ABBREV),U,2)_" to "
+15 IF $LENGTH(STR(CNT))+$LENGTH($PIECE(NEWV(ABBREV),U,2))<245
SET STR(CNT)=STR(CNT)_$PIECE(NEWV(ABBREV),U,2)
+16 IF '$TEST
SET CNT=CNT+1
SET STR(CNT)=$PIECE(NEWV(ABBREV),U,2)
End DoDot:2
End DoDot:1
+17 IF CNT
Begin DoDot:1
+18 SET OK=1
+19 ; add an extra line
SET CNT=CNT+1
SET STR(CNT)=""
+20 LOCK +^FSCD("CALL",CALL):30
IF '$TEST
SET OK=0
QUIT
+21 SET LASTLINE=+$ORDER(^FSCD("CALL",CALL,100,"A"),-1)
+22 SET CNT=0
FOR
SET CNT=$ORDER(STR(CNT))
if CNT<1
QUIT
Begin DoDot:2
+23 SET LASTLINE=LASTLINE+1
+24 SET ^FSCD("CALL",CALL,100,LASTLINE,0)=STR(CNT)
End DoDot:2
+25 SET ^FSCD("CALL",CALL,100,0)="^^"_LASTLINE_U_LASTLINE_U_DT_U
+26 LOCK -^FSCD("CALL",CALL)
End DoDot:1
IF 'OK
QUIT
+27 DO UPDATE(CALL)
+28 KILL STR
+29 QUIT
+30 ;
DESC(CALL,OLDV,NEWV) ; from FSCLMPE1, FSCRPCEC, FSCRPCEF
+1 IF '$GET(CALL)
QUIT
+2 NEW ABBREV,CNT,LASTLINE,OK,STR
KILL STR
+3 SET CNT=0
SET ABBREV=""
FOR
SET ABBREV=$ORDER(OLDV(ABBREV))
if ABBREV=""
QUIT
Begin DoDot:1
+4 IF OLDV(ABBREV)'=NEWV(ABBREV)
Begin DoDot:2
+5 IF 'CNT
SET CNT=CNT+1
SET STR(CNT)="*** "_$$FMTE^XLFDT($$NOW^XLFDT)_" "_$$VALUE^FSCGET(DUZ,7100,5)
+6 SET CNT=CNT+1
+7 SET STR(CNT)=$PIECE($GET(^FSC("FLD",+$ORDER(^FSC("FLD","AC",ABBREV,0)),0)),U)_": edited."
End DoDot:2
End DoDot:1
+8 IF CNT
Begin DoDot:1
+9 SET OK=1
+10 ; add an extra line
SET CNT=CNT+1
SET STR(CNT)=""
+11 LOCK +^FSCD("CALL",CALL):30
IF '$TEST
SET OK=0
QUIT
+12 SET LASTLINE=+$ORDER(^FSCD("CALL",CALL,100,"A"),-1)
+13 SET CNT=0
FOR
SET CNT=$ORDER(STR(CNT))
if CNT<1
QUIT
Begin DoDot:2
+14 SET LASTLINE=LASTLINE+1
+15 SET ^FSCD("CALL",CALL,100,LASTLINE,0)=STR(CNT)
End DoDot:2
+16 SET ^FSCD("CALL",CALL,100,0)="^^"_LASTLINE_U_LASTLINE_U_DT_U
+17 LOCK -^FSCD("CALL",CALL)
End DoDot:1
IF 'OK
QUIT
+18 DO UPDATE(CALL)
+19 KILL STR
+20 QUIT
+21 ;
UPDATE(DA) ; from FSCEB, FSCEU, FSCRPCEB, FSCRPCEC, FSCRPCEN, FSCRPCF
+1 NEW DIE,DR
+2 SET DIE="^FSCD(""CALL"","
SET DR="123///NOW;124///`"_DUZ
+3 ; *** needs ok
LOCK +^FSCD("CALL",CALL):30
IF '$TEST
QUIT
+4 DO ^DIE
+5 LOCK -^FSCD("CALL",CALL)
+6 QUIT
