QAQAUDIT ;HISC/DAD-QA PACKAGES AUDIT FILE UTILITY ;7/27/93 12:22
;;1.7;QM Integration Module;;07/25/1995
; REQUIRED VARIABLES
; QAUDIT("FILE")=FILE#^AUDIT FIELD# (AUDIT FIELD# OPTIONAL)
; QAUDIT("DA")=THE CALLING RECORD'S INTERNAL ENTRY NUMBER
; OPTIONAL VARIABLES
; QAUDIT("ACTION")=AUDITED ACTION ($S(CLOSE:c,DELETE:d,EDIT:e,OPEN:o))
; QAUDIT("COMMENT")=FREE TEXT (MAX 220 CHAR)
; QAUDIT("DUZ")=A USER'S DUZ
; QAUDIT("DT")=FILEMAN DATE/TIME, WITH SECONDS
; RETURNED VARIABLES (IF +$P(QAUDIT("FILE"),"^",2)=0)
; QAUDITD0=THE AUDIT RECORD'S INTERNAL ENTRY NUMBER
Q:$S($D(QAUDIT("FILE"))[0:1,$D(QAUDIT("DA"))[0:1,+QAUDIT("FILE")'>0:1,+QAUDIT("DA")'>0:1,1:0)
K QAUDIT("SAVE DA"),QAUDIT("X") S:$D(X)#2 QAUDIT("X")=X S:$D(DA)#2 QAUDIT("SAVE DA")=DA S %X="DA(",%Y="QAUDIT(""SAVE DA""," D %XY^%RCR
S:$D(QAUDIT("DUZ"))[0 QAUDIT("DUZ")=$S($D(DUZ)#2:DUZ,1:"") I $D(QAUDIT("DT"))[0 S %H=$H D YMD^%DTC S QAUDIT("DT")=X+%
S:$D(QAUDIT("ACTION"))[0 QAUDIT("ACTION")="" S:$D(QAUDIT("COMMENT"))[0 QAUDIT("COMMENT")="" S:(QAUDIT("ACTION")="")&($L(QAUDIT("COMMENT"))'>192) QAUDIT("COMMENT")=QAUDIT("COMMENT")_" *** NO ACTION SPECIFIED ***"
S QAUDIT("COMMENT")=$E(QAUDIT("COMMENT"),1,220),QAUDIT("ACTION")=$E(QAUDIT("ACTION")) S:QAUDIT("ACTION")?1U QAUDIT("ACTION")=$C($A(QAUDIT("ACTION"))+32) S:$P(^DD(740.51,.03,0),"^",3)'[(QAUDIT("ACTION")_":") QAUDIT("ACTION")=""
S QAUDIT("FIELD")=$P(QAUDIT("FILE"),"^",2),QAUDIT("FILE")=+QAUDIT("FILE")
S QAUDITD0=$O(^QA(740.5,"AA",QAUDIT("FILE"),QAUDIT("DA"),0)) G:QAUDITD0 SKIP
S QAUDIT=$S($D(^QA(740.5,0))#2:^(0),1:"QA AUDIT^740.5IP^^"),QAUDITD0=$P(QAUDIT,"^",3)+1,QAUDIT(0)=$P(QAUDIT,"^",4)+1
F QAUDITD0=QAUDITD0:1 L +^QA(740.5,QAUDITD0,0):0 Q:$T&'$D(^QA(740.5,QAUDITD0,0)) L -^QA(740.5,QAUDITD0,0):0
S ^QA(740.5,0)=$P(QAUDIT,"^",1,2)_"^"_QAUDITD0_"^"_QAUDIT(0),^QA(740.5,QAUDITD0,0)=QAUDIT("FILE")_"^"_QAUDIT("DA") L -^QA(740.5,QAUDITD0,0):0
S DA=QAUDITD0 F QAUDIT(1)=.01,.02 F QAUDIT(2)=0:0 S QAUDIT(2)=$O(^DD(740.5,QAUDIT(1),1,QAUDIT(2))) Q:QAUDIT(2)'>0 S X=$S(QAUDIT(1)=.01:QAUDIT("FILE"),1:QAUDIT("DA")) X:$D(^DD(740.5,QAUDIT(1),1,QAUDIT(2),1))#2 ^(1)
SKIP ;
S QAUDIT=$S($D(^QA(740.5,QAUDITD0,1,0))#2:^(0),1:"^740.51^DAI^^"),QAUDITD1=$P(QAUDIT,"^",3)+1,QAUDIT(0)=$P(QAUDIT,"^",4)+1
F QAUDITD1=QAUDITD1:1 L +^QA(740.5,QAUDITD0,1,QAUDITD1,0):0 Q:$T&'$D(^QA(740.5,QAUDITD0,1,QAUDITD1,0)) L -^QA(740.5,QAUDITD0,1,QAUDITD1,0):0
S ^QA(740.5,QAUDITD0,1,0)=$P(QAUDIT,"^",1,2)_"^"_QAUDITD1_"^"_QAUDIT(0),^QA(740.5,QAUDITD0,1,QAUDITD1,0)=QAUDIT("DT")_"^"_QAUDIT("DUZ")_"^"_QAUDIT("ACTION")_"^"_QAUDIT("COMMENT") L -^QA(740.5,QAUDITD0,1,QAUDITD1,0):0
S DA=QAUDITD1,DA(1)=QAUDITD0 F QAUDIT(1)=.01:.01:.04 F QAUDIT(2)=0:0 S QAUDIT(2)=$O(^DD(740.51,QAUDIT(1),1,QAUDIT(2))) Q:QAUDIT(2)'>0 D LOOP
G:+QAUDIT("FIELD")=0 EXIT
S QAUDIT=$P(^DD(QAUDIT("FILE"),QAUDIT("FIELD"),0),"^",4),QAUDIT(1)=$P(QAUDIT,";"),QAUDIT(2)=$P(QAUDIT,";",2),$P(^QA(QAUDIT("FILE"),QAUDIT("DA"),QAUDIT(1)),"^",QAUDIT(2))=QAUDITD0,DA=QAUDIT("DA")
F QAUDIT=0:0 S QAUDIT=$O(^DD(QAUDIT("FILE"),QAUDIT("FIELD"),1,QAUDIT)) Q:QAUDIT'>0 S X=QAUDITD0 X:$D(^DD(QAUDIT("FILE"),QAUDIT("FIELD"),1,QAUDIT,1))#2 ^(1)
K QAUDITD0
EXIT ;
S:$D(QAUDIT("X"))#2 X=QAUDIT("X") S:$D(QAUDIT("SAVE DA"))#2 DA=QAUDIT("SAVE DA") S %X="QAUDIT(""SAVE DA"",",%Y="DA(" D %XY^%RCR
K %,%H,%X,%Y,QAUDIT,QAUDITD1
Q
LOOP ;
S X=$S(QAUDIT(1)=.01:QAUDIT("DT"),QAUDIT(1)=.02:QAUDIT("DUZ"),QAUDIT(1)=.03:QAUDIT("ACTION"),QAUDIT(1)=.04:QAUDIT("COMMENT"))
I X]"" X:$D(^DD(740.51,QAUDIT(1),1,QAUDIT(2),1))#2 ^(1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAQAUDIT 3544 printed Apr 09, 2024@21:33:49 Page 2
QAQAUDIT ;HISC/DAD-QA PACKAGES AUDIT FILE UTILITY ;7/27/93 12:22
+1 ;;1.7;QM Integration Module;;07/25/1995
+2 ; REQUIRED VARIABLES
+3 ; QAUDIT("FILE")=FILE#^AUDIT FIELD# (AUDIT FIELD# OPTIONAL)
+4 ; QAUDIT("DA")=THE CALLING RECORD'S INTERNAL ENTRY NUMBER
+5 ; OPTIONAL VARIABLES
+6 ; QAUDIT("ACTION")=AUDITED ACTION ($S(CLOSE:c,DELETE:d,EDIT:e,OPEN:o))
+7 ; QAUDIT("COMMENT")=FREE TEXT (MAX 220 CHAR)
+8 ; QAUDIT("DUZ")=A USER'S DUZ
+9 ; QAUDIT("DT")=FILEMAN DATE/TIME, WITH SECONDS
+10 ; RETURNED VARIABLES (IF +$P(QAUDIT("FILE"),"^",2)=0)
+11 ; QAUDITD0=THE AUDIT RECORD'S INTERNAL ENTRY NUMBER
+12 if $SELECT($DATA(QAUDIT("FILE"))[0
QUIT
+13 KILL QAUDIT("SAVE DA"),QAUDIT("X")
if $DATA(X)#2
SET QAUDIT("X")=X
if $DATA(DA)#2
SET QAUDIT("SAVE DA")=DA
SET %X="DA("
SET %Y="QAUDIT(""SAVE DA"","
DO %XY^%RCR
+14 if $DATA(QAUDIT("DUZ"))[0
SET QAUDIT("DUZ")=$SELECT($DATA(DUZ)#2:DUZ,1:"")
IF $DATA(QAUDIT("DT"))[0
SET %H=$HOROLOG
DO YMD^%DTC
SET QAUDIT("DT")=X+%
+15 if $DATA(QAUDIT("ACTION"))[0
SET QAUDIT("ACTION")=""
if $DATA(QAUDIT("COMMENT"))[0
SET QAUDIT("COMMENT")=""
if (QAUDIT("ACTION")="")&($LENGTH(QAUDIT("COMMENT"))'>192)
SET QAUDIT("COMMENT")=QAUDIT("COMMENT")_" *** NO ACTION SPECIFIED ***"
+16 SET QAUDIT("COMMENT")=$EXTRACT(QAUDIT("COMMENT"),1,220)
SET QAUDIT("ACTION")=$EXTRACT(QAUDIT("ACTION"))
if QAUDIT("ACTION")?1U
SET QAUDIT("ACTION")=$CHAR($ASCII(QAUDIT("ACTION"))+32)
if $PIECE(^DD(740.51,.03,0),"^",3)'[(QAUDIT("ACTION")_"
SET QAUDIT("ACTION")=""
+17 SET QAUDIT("FIELD")=$PIECE(QAUDIT("FILE"),"^",2)
SET QAUDIT("FILE")=+QAUDIT("FILE")
+18 SET QAUDITD0=$ORDER(^QA(740.5,"AA",QAUDIT("FILE"),QAUDIT("DA"),0))
if QAUDITD0
GOTO SKIP
+19 SET QAUDIT=$SELECT($DATA(^QA(740.5,0))#2:^(0),1:"QA AUDIT^740.5IP^^")
SET QAUDITD0=$PIECE(QAUDIT,"^",3)+1
SET QAUDIT(0)=$PIECE(QAUDIT,"^",4)+1
+20 FOR QAUDITD0=QAUDITD0:1
LOCK +^QA(740.5,QAUDITD0,0):0
if $TEST&'$DATA(^QA(740.5,QAUDITD0,0))
QUIT
LOCK -^QA(740.5,QAUDITD0,0):0
+21 SET ^QA(740.5,0)=$PIECE(QAUDIT,"^",1,2)_"^"_QAUDITD0_"^"_QAUDIT(0)
SET ^QA(740.5,QAUDITD0,0)=QAUDIT("FILE")_"^"_QAUDIT("DA")
LOCK -^QA(740.5,QAUDITD0,0):0
+22 SET DA=QAUDITD0
FOR QAUDIT(1)=.01,.02
FOR QAUDIT(2)=0:0
SET QAUDIT(2)=$ORDER(^DD(740.5,QAUDIT(1),1,QAUDIT(2)))
if QAUDIT(2)'>0
QUIT
SET X=$SELECT(QAUDIT(1)=.01:QAUDIT("FILE"),1:QAUDIT("DA"))
if $DATA(^DD(740.5,QAUDIT(1),1,QAUDIT(2),1))#2
XECUTE ^(1)
SKIP ;
+1 SET QAUDIT=$SELECT($DATA(^QA(740.5,QAUDITD0,1,0))#2:^(0),1:"^740.51^DAI^^")
SET QAUDITD1=$PIECE(QAUDIT,"^",3)+1
SET QAUDIT(0)=$PIECE(QAUDIT,"^",4)+1
+2 FOR QAUDITD1=QAUDITD1:1
LOCK +^QA(740.5,QAUDITD0,1,QAUDITD1,0):0
if $TEST&'$DATA(^QA(740.5,QAUDITD0,1,QAUDITD1,0))
QUIT
LOCK -^QA(740.5,QAUDITD0,1,QAUDITD1,0):0
+3 SET ^QA(740.5,QAUDITD0,1,0)=$PIECE(QAUDIT,"^",1,2)_"^"_QAUDITD1_"^"_QAUDIT(0)
SET ^QA(740.5,QAUDITD0,1,QAUDITD1,0)=QAUDIT("DT")_"^"_QAUDIT("DUZ")_"^"_QAUDIT("ACTION")_"^"_QAUDIT("COMMENT")
LOCK -^QA(740.5,QAUDITD0,1,QAUDITD1,0):0
+4 SET DA=QAUDITD1
SET DA(1)=QAUDITD0
FOR QAUDIT(1)=.01:.01:.04
FOR QAUDIT(2)=0:0
SET QAUDIT(2)=$ORDER(^DD(740.51,QAUDIT(1),1,QAUDIT(2)))
if QAUDIT(2)'>0
QUIT
DO LOOP
+5 if +QAUDIT("FIELD")=0
GOTO EXIT
+6 SET QAUDIT=$PIECE(^DD(QAUDIT("FILE"),QAUDIT("FIELD"),0),"^",4)
SET QAUDIT(1)=$PIECE(QAUDIT,";")
SET QAUDIT(2)=$PIECE(QAUDIT,";",2)
SET $PIECE(^QA(QAUDIT("FILE"),QAUDIT("DA"),QAUDIT(1)),"^",QAUDIT(2))=QAUDITD0
SET DA=QAUDIT("DA")
+7 FOR QAUDIT=0:0
SET QAUDIT=$ORDER(^DD(QAUDIT("FILE"),QAUDIT("FIELD"),1,QAUDIT))
if QAUDIT'>0
QUIT
SET X=QAUDITD0
if $DATA(^DD(QAUDIT("FILE"),QAUDIT("FIELD"),1,QAUDIT,1))#2
XECUTE ^(1)
+8 KILL QAUDITD0
EXIT ;
+1 if $DATA(QAUDIT("X"))#2
SET X=QAUDIT("X")
if $DATA(QAUDIT("SAVE DA"))#2
SET DA=QAUDIT("SAVE DA")
SET %X="QAUDIT(""SAVE DA"","
SET %Y="DA("
DO %XY^%RCR
+2 KILL %,%H,%X,%Y,QAUDIT,QAUDITD1
+3 QUIT
LOOP ;
+1 SET X=$SELECT(QAUDIT(1)=.01:QAUDIT("DT"),QAUDIT(1)=.02:QAUDIT("DUZ"),QAUDIT(1)=.03:QAUDIT("ACTION"),QAUDIT(1)=.04:QAUDIT("COMMENT"))
+2 IF X]""
if $DATA(^DD(740.51,QAUDIT(1),1,QAUDIT(2),1))#2
XECUTE ^(1)
+3 QUIT
