- QAQADLAU ;HISC/DAD-DELETE AN AUDIT FILE ENTRY ;2/10/92 13:41
- ;;1.7;QM Integration Module;;07/25/1995
- ; REQUIRED VARIABLES
- ; QAUDIT("FILE")=FILE#
- ; QAUDIT("DA")=THE CALLING 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)
- 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
- F QAUDITD0=0:0 S QAUDITD0=$O(^QA(740.5,"AA",QAUDIT("FILE"),QAUDIT("DA"),QAUDITD0)) Q:QAUDITD0'>0 D LOOP1
- 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 %X,%Y,QAQADICT,QAQAFLD,QAUDIT,QAUDITD0,QAUDITD1
- Q
- LOOP1 ;
- F QAUDITD1=0:0 S QAUDITD1=$O(^QA(740.5,QAUDITD0,1,QAUDITD1)) Q:QAUDITD1'>0 D LOOP2
- K ^QA(740.5,QAUDITD0,1,0)
- S QAUDIT=$S($D(^QA(740.5,QAUDITD0,0))#2:^(0),1:"") Q:QAUDIT=""
- F QAUDIT(0)=.01:.01:.02 S QAQAFLD=QAUDIT(0),QAQADICT=740.5,DA=QAUDITD0,X=$P(QAUDIT,"^",100*QAQAFLD\1) D:X]"" ENKILL^QAQAXREF
- K ^QA(740.5,QAUDITD0,0)
- S QAUDIT=$S($D(^QA(740.5,0))#2:$P(^(0),"^",4),1:"") Q:QAUDIT="" S:QAUDIT $P(^(0),"^",4)=QAUDIT-1
- Q
- LOOP2 ;
- S QAUDIT=$S($D(^QA(740.5,QAUDITD0,1,QAUDITD1,0))#2:^(0),1:"") Q:QAUDIT=""
- F QAUDIT(0)=.01:.01:.04 S QAQAFLD=QAUDIT(0),QAQADICT=740.51,DA=QAUDITD1,DA(1)=QAUDITD0,X=$P(QAUDIT,"^",100*QAQAFLD\1) D:X]"" ENKILL^QAQAXREF
- K ^QA(740.5,QAUDITD0,1,QAUDITD1,0)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAQADLAU 1422 printed Feb 18, 2025@23:57:40 Page 2
- QAQADLAU ;HISC/DAD-DELETE AN AUDIT FILE ENTRY ;2/10/92 13:41
- +1 ;;1.7;QM Integration Module;;07/25/1995
- +2 ; REQUIRED VARIABLES
- +3 ; QAUDIT("FILE")=FILE#
- +4 ; QAUDIT("DA")=THE CALLING RECORD'S INTERNAL ENTRY NUMBER
- +5 if $SELECT($DATA(QAUDIT("FILE"))[0
- QUIT
- +6 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
- +7 FOR QAUDITD0=0:0
- SET QAUDITD0=$ORDER(^QA(740.5,"AA",QAUDIT("FILE"),QAUDIT("DA"),QAUDITD0))
- if QAUDITD0'>0
- QUIT
- DO LOOP1
- +8 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
- +9 KILL %X,%Y,QAQADICT,QAQAFLD,QAUDIT,QAUDITD0,QAUDITD1
- +10 QUIT
- LOOP1 ;
- +1 FOR QAUDITD1=0:0
- SET QAUDITD1=$ORDER(^QA(740.5,QAUDITD0,1,QAUDITD1))
- if QAUDITD1'>0
- QUIT
- DO LOOP2
- +2 KILL ^QA(740.5,QAUDITD0,1,0)
- +3 SET QAUDIT=$SELECT($DATA(^QA(740.5,QAUDITD0,0))#2:^(0),1:"")
- if QAUDIT=""
- QUIT
- +4 FOR QAUDIT(0)=.01:.01:.02
- SET QAQAFLD=QAUDIT(0)
- SET QAQADICT=740.5
- SET DA=QAUDITD0
- SET X=$PIECE(QAUDIT,"^",100*QAQAFLD\1)
- if X]""
- DO ENKILL^QAQAXREF
- +5 KILL ^QA(740.5,QAUDITD0,0)
- +6 SET QAUDIT=$SELECT($DATA(^QA(740.5,0))#2:$PIECE(^(0),"^",4),1:"")
- if QAUDIT=""
- QUIT
- if QAUDIT
- SET $PIECE(^(0),"^",4)=QAUDIT-1
- +7 QUIT
- LOOP2 ;
- +1 SET QAUDIT=$SELECT($DATA(^QA(740.5,QAUDITD0,1,QAUDITD1,0))#2:^(0),1:"")
- if QAUDIT=""
- QUIT
- +2 FOR QAUDIT(0)=.01:.01:.04
- SET QAQAFLD=QAUDIT(0)
- SET QAQADICT=740.51
- SET DA=QAUDITD1
- SET DA(1)=QAUDITD0
- SET X=$PIECE(QAUDIT,"^",100*QAQAFLD\1)
- if X]""
- DO ENKILL^QAQAXREF
- +3 KILL ^QA(740.5,QAUDITD0,1,QAUDITD1,0)
- +4 QUIT