- 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 Feb 18, 2025@23:42:47 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
