- 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 Feb 18, 2025@23:57:51 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