LRMIAU2 ;DALISC/RBN - AUDIT/ALERT BANNER GENERATOR ;03/07/12 16:25
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
Q
;
BANNER(LRABORT,LRPGDATA) ;
; Displays the MI Audit Trail edit banner history
N LR63539,X,HDRSHO
N LRIEN,LRIENS,LRMSG,DIERR
S LRABORT=$G(LRABORT)
S HDRSHO=0
;
S LR63539=0
F S LR63539=$O(^LR(LRDFN,"MI",LRIDT,32,LR63539)) Q:'LR63539 D Q:LRABORT ;
. ; first record?
. I $$WILLSHO(LRDFN,LRIDT,LR63539) D ;
. . I 'HDRSHO D ;
. . . S X="* * * Start Audit Log * * *"
. . . W !,$$CJ^XLFSTR(X,IOM)
. . . S HDRSHO=1
. . ;
. . D NP Q:LRABORT
. . D SHOW(LRDFN,LRIDT,LR63539,.LRPGDATA,.LRABORT)
. Q:LRABORT
. ;
. ; last record?
. I LR63539=$O(^LR(LRDFN,"MI",LRIDT,32," "),-1) D ;
. . Q:'HDRSHO
. . D NP Q:LRABORT
. . S X="* * * End Audit Log * * *"
. . W !,$$CJ^XLFSTR(X,IOM)
. . D NP
. ;
Q
;
WILLSHO(LRDFN,LRIDT,R32) ;
; Does this record qualify?
N STATUS,DATA
S STATUS=1
S DATA=^LR(LRDFN,"MI",LRIDT,32,R32,0)
I $P(DATA,U,4)=1 S STATUS=0 ;TYPE=ROUTINE EDIT
Q STATUS
;
SHOW(LRDFN,LRIDT,LR63539,LRPGDATA,LRABORT) ;
; Displays a particular audit trail entry
;
N DATE,TECH,JUST,FAC,TEST,TYPE,SUBSCR,APPROV
N LRIEN,DIERR,LRDATA,LRMSG,D63539
S LR63539=$G(LR63539)
S LRABORT=$G(LRABORT)
S LRIEN=LR63539_","_LRIDT_","_LRDFN_","
S ACCN=$P(^LR(LRDFN,"MI",LRIDT,0),U,6)
D GETS^DIQ(63.539,LRIEN,".01;1;2;3;4;6;7;14;","EI","LRDATA","LRMSG")
M D63539=LRDATA(63.539,LRIEN)
K LRDATA
S DATE=$G(D63539(1,"E"))
S TECH=$G(D63539(2,"E"))
S JUST=$G(D63539(4,"E"))
S FAC=$G(D63539(7,"E"))
S TEST=$G(D63539(14,"E"))
S TYPE=$G(D63539(3,"E"))
S SUBSCR=$G(D63539(6,"I"))
I TYPE="" S TYPE="TEST NOT COMPLETED"
I $$UP^XLFSTR(TYPE)["ROUTINE" Q
S APPROV=1
I "^1^5^8^11^16^"[("^"_SUBSCR_"^") D ;
. S X=$G(^LR(LRDFN,"MI",LRIDT,SUBSCR))
. I '$P(X,U,1) S APPROV=0
;
D NP Q:LRABORT
S X=" This report has been revised "
S X=$$CJ^XLFSTR(X,IOM,"*")
W !,X
D NP Q:LRABORT
W !," Test: "_TEST_" "_ACCN
D NP Q:LRABORT
W !," Revised by: "_TECH_" on "_DATE_" at "_FAC
D NP Q:LRABORT
W !," Revision type: "_TYPE
D NP Q:LRABORT
W !," Justification: "_JUST
D NP Q:LRABORT
;
I 'APPROV D Q:LRABORT ;
. W !," **** THIS REPORT HAS NOT BEEN REAPPROVED/REVALIDATED ****"
. D NP Q:LRABORT
;
Q
;
NP ;
; Convenience method
D NP^LRMIPSZ1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIAU2 2426 printed Oct 16, 2024@18:17:39 Page 2
LRMIAU2 ;DALISC/RBN - AUDIT/ALERT BANNER GENERATOR ;03/07/12 16:25
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 QUIT
+4 ;
BANNER(LRABORT,LRPGDATA) ;
+1 ; Displays the MI Audit Trail edit banner history
+2 NEW LR63539,X,HDRSHO
+3 NEW LRIEN,LRIENS,LRMSG,DIERR
+4 SET LRABORT=$GET(LRABORT)
+5 SET HDRSHO=0
+6 ;
+7 SET LR63539=0
+8 ;
FOR
SET LR63539=$ORDER(^LR(LRDFN,"MI",LRIDT,32,LR63539))
if 'LR63539
QUIT
Begin DoDot:1
+9 ; first record?
+10 ;
IF $$WILLSHO(LRDFN,LRIDT,LR63539)
Begin DoDot:2
+11 ;
IF 'HDRSHO
Begin DoDot:3
+12 SET X="* * * Start Audit Log * * *"
+13 WRITE !,$$CJ^XLFSTR(X,IOM)
+14 SET HDRSHO=1
End DoDot:3
+15 ;
+16 DO NP
if LRABORT
QUIT
+17 DO SHOW(LRDFN,LRIDT,LR63539,.LRPGDATA,.LRABORT)
End DoDot:2
+18 if LRABORT
QUIT
+19 ;
+20 ; last record?
+21 ;
IF LR63539=$ORDER(^LR(LRDFN,"MI",LRIDT,32," "),-1)
Begin DoDot:2
+22 if 'HDRSHO
QUIT
+23 DO NP
if LRABORT
QUIT
+24 SET X="* * * End Audit Log * * *"
+25 WRITE !,$$CJ^XLFSTR(X,IOM)
+26 DO NP
End DoDot:2
+27 ;
End DoDot:1
if LRABORT
QUIT
+28 QUIT
+29 ;
WILLSHO(LRDFN,LRIDT,R32) ;
+1 ; Does this record qualify?
+2 NEW STATUS,DATA
+3 SET STATUS=1
+4 SET DATA=^LR(LRDFN,"MI",LRIDT,32,R32,0)
+5 ;TYPE=ROUTINE EDIT
IF $PIECE(DATA,U,4)=1
SET STATUS=0
+6 QUIT STATUS
+7 ;
SHOW(LRDFN,LRIDT,LR63539,LRPGDATA,LRABORT) ;
+1 ; Displays a particular audit trail entry
+2 ;
+3 NEW DATE,TECH,JUST,FAC,TEST,TYPE,SUBSCR,APPROV
+4 NEW LRIEN,DIERR,LRDATA,LRMSG,D63539
+5 SET LR63539=$GET(LR63539)
+6 SET LRABORT=$GET(LRABORT)
+7 SET LRIEN=LR63539_","_LRIDT_","_LRDFN_","
+8 SET ACCN=$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,6)
+9 DO GETS^DIQ(63.539,LRIEN,".01;1;2;3;4;6;7;14;","EI","LRDATA","LRMSG")
+10 MERGE D63539=LRDATA(63.539,LRIEN)
+11 KILL LRDATA
+12 SET DATE=$GET(D63539(1,"E"))
+13 SET TECH=$GET(D63539(2,"E"))
+14 SET JUST=$GET(D63539(4,"E"))
+15 SET FAC=$GET(D63539(7,"E"))
+16 SET TEST=$GET(D63539(14,"E"))
+17 SET TYPE=$GET(D63539(3,"E"))
+18 SET SUBSCR=$GET(D63539(6,"I"))
+19 IF TYPE=""
SET TYPE="TEST NOT COMPLETED"
+20 IF $$UP^XLFSTR(TYPE)["ROUTINE"
QUIT
+21 SET APPROV=1
+22 ;
IF "^1^5^8^11^16^"[("^"_SUBSCR_"^")
Begin DoDot:1
+23 SET X=$GET(^LR(LRDFN,"MI",LRIDT,SUBSCR))
+24 IF '$PIECE(X,U,1)
SET APPROV=0
End DoDot:1
+25 ;
+26 DO NP
if LRABORT
QUIT
+27 SET X=" This report has been revised "
+28 SET X=$$CJ^XLFSTR(X,IOM,"*")
+29 WRITE !,X
+30 DO NP
if LRABORT
QUIT
+31 WRITE !," Test: "_TEST_" "_ACCN
+32 DO NP
if LRABORT
QUIT
+33 WRITE !," Revised by: "_TECH_" on "_DATE_" at "_FAC
+34 DO NP
if LRABORT
QUIT
+35 WRITE !," Revision type: "_TYPE
+36 DO NP
if LRABORT
QUIT
+37 WRITE !," Justification: "_JUST
+38 DO NP
if LRABORT
QUIT
+39 ;
+40 ;
IF 'APPROV
Begin DoDot:1
+41 WRITE !," **** THIS REPORT HAS NOT BEEN REAPPROVED/REVALIDATED ****"
+42 DO NP
if LRABORT
QUIT
End DoDot:1
if LRABORT
QUIT
+43 ;
+44 QUIT
+45 ;
NP ;
+1 ; Convenience method
+2 DO NP^LRMIPSZ1
+3 QUIT
