source: WorldVistAEHR/trunk/r/QUALITY_ASSURANCE_INTEGRATION-QAQ/QAQAUDIT.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1QAQAUDIT ;HISC/DAD-QA PACKAGES AUDIT FILE UTILITY ;7/27/93 12:22
2 ;;1.7;QM Integration Module;;07/25/1995
3 ; REQUIRED VARIABLES
4 ; QAUDIT("FILE")=FILE#^AUDIT FIELD# (AUDIT FIELD# OPTIONAL)
5 ; QAUDIT("DA")=THE CALLING RECORD'S INTERNAL ENTRY NUMBER
6 ; OPTIONAL VARIABLES
7 ; QAUDIT("ACTION")=AUDITED ACTION ($S(CLOSE:c,DELETE:d,EDIT:e,OPEN:o))
8 ; QAUDIT("COMMENT")=FREE TEXT (MAX 220 CHAR)
9 ; QAUDIT("DUZ")=A USER'S DUZ
10 ; QAUDIT("DT")=FILEMAN DATE/TIME, WITH SECONDS
11 ; RETURNED VARIABLES (IF +$P(QAUDIT("FILE"),"^",2)=0)
12 ; QAUDITD0=THE AUDIT RECORD'S INTERNAL ENTRY NUMBER
13 Q:$S($D(QAUDIT("FILE"))[0:1,$D(QAUDIT("DA"))[0:1,+QAUDIT("FILE")'>0:1,+QAUDIT("DA")'>0:1,1:0)
14 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
15 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+%
16 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 ***"
17 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")=""
18 S QAUDIT("FIELD")=$P(QAUDIT("FILE"),"^",2),QAUDIT("FILE")=+QAUDIT("FILE")
19 S QAUDITD0=$O(^QA(740.5,"AA",QAUDIT("FILE"),QAUDIT("DA"),0)) G:QAUDITD0 SKIP
20 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
21 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
22 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
23 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)
24SKIP ;
25 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
26 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
27 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
28 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
29 G:+QAUDIT("FIELD")=0 EXIT
30 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")
31 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)
32 K QAUDITD0
33EXIT ;
34 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
35 K %,%H,%X,%Y,QAUDIT,QAUDITD1
36 Q
37LOOP ;
38 S X=$S(QAUDIT(1)=.01:QAUDIT("DT"),QAUDIT(1)=.02:QAUDIT("DUZ"),QAUDIT(1)=.03:QAUDIT("ACTION"),QAUDIT(1)=.04:QAUDIT("COMMENT"))
39 I X]"" X:$D(^DD(740.51,QAUDIT(1),1,QAUDIT(2),1))#2 ^(1)
40 Q
Note: See TracBrowser for help on using the repository browser.