Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRJSAU

LRJSAU.m

Go to the documentation of this file. 
  1. LRJSAU ;ALB/PO/DK/TMK Lab Audit Manager ;13 Jul 2009  2:29 AM
  1.  ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
  1.  ;
  1. F60 ;File 60 entry point
  1.  D EN2
  1.  K ^TMP("LRJ SYS F60 AUD MANAGER",$J)
  1.  Q
  1.  ;
  1. EN2 ; -- main entry point for LRJ SYS AUF60 MANAGER (file 60)
  1.  ; -- required interface routine variable
  1.  N LRJSROU S LRJSROU="LRJSAU"
  1.  K ^TMP("LRJ SYS F60 AUD MANAGER",$J)
  1.  D MSG2^LRJSAU60
  1.  D EN^VALM("LRJ SYS MAP AUF60")
  1.  Q
  1.  ;
  1. HDR2 ; -- header code
  1.  S VALMHDR(1)="                         Lab File 60 Audit Manager"
  1.  S VALMHDR(2)="                         Version: "_$$VERNUM()_"     Build: "_$$BLDNUM()
  1.  Q
  1.  ;
  1. BUILD ; -- build display array
  1.  K ^TMP("LRJ SYS F60 AUD MANAGER",$J)
  1.  S VALMCNT=0
  1.  D AUDCHK^LRJSAU60(1)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  N X
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("LRJ SYS F60 AUD MANAGER",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  K ^TMP("LRJ SYS F60 AUD MANAGER",$J)
  1.  D CHGCAP^VALM("HEADER","")
  1.  S VALMCNT=0
  1.  Q
  1.  ;
  1. BLDNUM() ; -- returns the build number
  1.  QUIT +$PIECE($PIECE($TEXT(LRJSAU+1),";",7),"Build ",2)
  1.  ;
  1. VERNUM() ; -- returns the version number for this build
  1.  QUIT +$PIECE($TEXT(LRJSAU+1),";",3)
  1.  ;
  1. CLEAR ; -- clean up entries
  1.  D REFRESH
  1.  Q
  1.  ;
  1. REFRESH ; -- refresh display
  1.  D BUILD
  1.  D CHGCAP^VALM("HEADER","")
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. KILL ; -- kill off build data
  1.  K ^TMP("LRJ SYS F60 AUD MANAGER",$J)
  1.  K ^TMP($J,"LRAUDREQ")
  1.  S VALMBG=1
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. AUDSET ; enable audit fields for file 60
  1.  ; called from POST^LR425
  1.  ; ICR 4122
  1.  N LRI,LRAFLDS,LRSUB,LRSTR,LRAUDFIL
  1.  F LRI=1:1 S LRAFLDS=$P($TEXT(AFLDS+LRI),";;",2) Q:LRAFLDS="$$END$$"  D
  1.  . S LRAUDFIL=+$P($P(LRAFLDS,"^"),";",2) ; Pull off subfield # to get subfile if there
  1.  . I LRAUDFIL D  ; Get subfile #
  1.  . . S LRAUDFIL=$$GFLDSB^LRJSAU60(+LRAFLDS,LRAUDFIL)
  1.  . S:'LRAUDFIL LRAUDFIL=+LRAFLDS
  1.  . ;the following turns audit on for fields specified in SRS
  1.  . D TURNON^DIAUTL(LRAUDFIL,$P(LRAFLDS,"^",2))
  1.  Q
  1.  ;
  1. ADD(VALMCNT,MSG,LRBOLD) ; -- add line to build display
  1.  SET VALMCNT=VALMCNT+1
  1.  DO SET^VALM10(VALMCNT,MSG)
  1.  IF $GET(LRBOLD) DO CNTRL^VALM10(VALMCNT,1,79,IOINHI,IOINORM)
  1.  QUIT
  1.  ;
  1.  ; AFLDS data: 1st ^ piece: File #_[;_field # of subfile]-> if needed
  1.  ;             2nd ^ piece: the field #'s within that file/subfile to audit, separated by ;
  1. AFLDS ;fields to be audited according to SRS
  1.  ;;60^.01;3;4;8;17;18;64.1
  1.  ;;60;100^.01;1;2;95.3
  1.  ;;60;200^.01
  1.  ;;60;300^.01
  1.  ;;60;2^.01
  1.  ;;60;6^.01;1
  1.  ;;60;500^.01
  1.  ;;60;500.1^.01
  1.  ;;$$END$$