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