LRJSAU2 ;ALB/GTS/DK/TMK - Lab Vista Audit Utilities;08/16/2010 15:53:28
;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
;
;
KILL ;Kill off build data
K ^TMP("LRJ SYS MAP AUD MSG",$J)
K ^TMP("LRJ SYS MAP AUD MANAGER",$J)
Q
;
LISTHLMM(LRHLARY) ; Store audit information in the display array
; INPUT -
; LRHLARY - Array of raw extract data
;
N LRREF,LRFROM,LRTO
;get top level with date information
S LRREF=$P(LRHLARY,")")_",1)"
S LRFROM=$P($G(@LRREF),"^")
S LRTO=$P($G(@LRREF),"^",2)
D KILL
D KILL^VALM10()
D CRTRPTAR(LRHLARY,LRFROM,LRTO,"DISPLAY","")
Q
;
CRTRPTAR(LRHLARY,LRFROM,LRTO,LROUTPT,LRMMARY) ; Store info in the display array
; INPUT -
; LRHLARY - Array of raw extract data
; LRFROM - Start date for report
; LRTO - End date for report
; LROUTPT - "DISPLAY" for Listman; "MAIL" for mail message
; LRMMARY - Mail message output array
;
N X,XN,XP,NODE,X1,X2,X3
N LRFSTLNE,LRPARAM,LRLNCTN,LRLNCNT,LRVALST
S VALM("TITLE")=AUDES_" Audit Message"
S:$G(LRMMARY)="" LRMMARY=""
S:$G(LROUTPT)="" LROUTPT="DISPLAY"
S LRFSTLNE=0
S X=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
I LROUTPT="MAIL" D
.S LRLNCNT=0
.D LRADDNOD^LRJSAU3(.LRLNCNT,X,"",LROUTPT,LRMMARY)
Q
;
;THE FOLLOWING API is to be called from a Taskman
;scheduled job LRJ SYS MAP [autyp] TASKMAN RPT where autyp=audit type
;;;TASKMAN should call D TSKMMARY^LRJSAU2(AUTYP,AUDES,"^TMP(""LRJ SYS F60 AUD MANAGER"",$J)","^TMP(""LRJ SYS F60 AUD MANAGER"",$J)")
TSKMMARY(AUTYP,AUDES,AUFMT) ;TASKMAN API for Mail Message array
;
;INPUT (Roots for arrays to be created)
;AUTYP=Audit Type (AUF60 = File 60, AUF60XT = File 60 extract delimited file
;AUDES=Description (File 60 Audit, New Person Audit)
; LRHLARY - Array of Raw Data
; LRMMARY - Mail Message array to send in message
;AUFMT=format (Readable Display=DISPLAY; Delimited file =FILE)
;
;
N $ESTACK,$ETRAP S $ETRAP="D TSKERR^LRJSAU2"
N LRFROM,LRTO,LRTOMM,LRMSUBJ,XQSND,ERR,LRTOVA,LRTASKVA,LRINSTVA,AUSUB,TSKCALL,ZTIO
;
;;TO DO: GIVE INSTRUCTIONS FOR SCHEDULING THE FREQUENCY OF TASK JOB VIA TASKMAN
;;
D NOW^%DTC
S LRTO=$E(%,1,12) ;NOW is end date/time
K %,X,%H,%I(1),%I(2),%I(3)
S LRFROM=$$GET^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST END DATE",1,"Q")
;
;If report hasn't been run before, generate for previous 7 days
I LRFROM="" D
.S X1=LRTO
.S X2=-7
.D C^%DTC
.S LRFROM=X
.K X,%H
;
D EN^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST END DATE",,LRTO,.ERR)
D EN^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST START DATE",,LRFROM,.ERR)
;
S TSKCALL=1,ZTIO=""
I AUTYP["AUF60" D AUDISP^LRJSAU60
I AUTYP'["AUF60" Q
S AUSUB=$S(AUTYP["AUF60":"F60",1:"")
S (LRHLARY,LRMMARY)="^TMP(""LRJ SYS ""_AUSUB_"" AUD MANAGER"",$J)"
I AUTYP["XT" S (LRHLARY,LRMMARY)="^TMP(""LRJ SYS ""_AUSUB_"" AUD MANAGER"",$J,""EXTRACT"")"
;
I $D(@LRHLARY) D
. S LRLPCNT=1
. S @LRMMARY@(LRLPCNT)=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
. I AUFMT="DISPLAY" D
. . F XCAT="NEW","OLD" D
. . . S (LRNODE,LRSUB)=0
. . . I '$D(@LRHLARY@(XCAT)) D Q
. . . . S LRLPCNT=LRLPCNT+1
. . . . S @LRMMARY@(LRLPCNT)=" No "_$S(XCAT="NEW":"new",1:"modified")_" entries"
. . . S LRLPCNT=LRLPCNT+1
. . . S @LRMMARY@(LRLPCNT)=""
. . . S LRLPCNT=LRLPCNT+1
. . . S @LRMMARY@(LRLPCNT)=$S(XCAT="NEW":"New",1:"Modified")_" entries"
. . . S LRLPCNT=LRLPCNT+1
. . . S @LRMMARY@(LRLPCNT)=""
. . . F S LRNODE=$O(@LRHLARY@(XCAT,LRNODE)) Q:LRNODE="" D
. . . . F S LRSUB=$O(@LRHLARY@(XCAT,LRNODE,LRSUB)) Q:LRSUB="" D
. . . . . S LRLPCNT=LRLPCNT+1
. . . . . S @LRMMARY@(LRLPCNT)=$G(@LRHLARY@(XCAT,LRNODE,LRSUB))
. . S LRMSUBJ=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
. . S LRTOMM("G.LRJ "_AUTYP_" AUDIT TASK REPORT")=""
. . S XQSND=DUZ
. . D SNDMSG(LRMSUBJ,XQSND,LRMMARY,.LRTOMM,1) ;"1" = created by Taskman; send to Mailgroup
. ;Send Extract message with attachments
. Q:AUFMT="DISPLAY"
. S LRMSUBJ=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
. ;
. ;Check for Network addresses and mail attachment
. S LRINSTVA("ADDR FLAGS")="R" ;Do not Restrict Message addressing
. S LRINSTVA("FROM")="LSRP_"_AUTYP_" USER_ACTION"
. S XQSND=DUZ
. S LRTOVA(XQSND)=""
. ;Array of raw extract, Array of message text for networkd address, Message subject
. ;
. S LRTOMM("G.LRJ "_AUTYP_" AUDIT TASK REPORT")=""
. D OUTLKARY(LRHLARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ)
. D SNDMSG(LRMSUBJ,XQSND,"^TMP($J,""LRNETMSG"")",.LRTOMM,1)
. ;
K @LRHLARY,@LRMMARY,^TMP($J,"LRNETMSG")
Q
;
TSKERR ; Error trap to send bulletin if queued report encounters a system error
N XMTEXT,XMY,XMSUB,XQSND
S XMY("G.LRJ "_AUTYP_" AUDIT TASK REPORT")=""
S XMSUB=AUDES_" AUTOMATED REPORT ERROR"
S XMTEXT(1)="This message is to inform you that the "_AUDES_" automated report"
S XMTEXT(2)="has encountered an error and did not complete. Please contact your"
S XMTEXT(3)="system manager for further details."
S XMTEXT(4)=" "
S XMTEXT(5)="ERROR OCCURRED: "_$$FMTE^XLFDT($$NOW^XLFDT,"2")
S XMTEXT(6)="ERROR MESSAGE : "_$$EC^%ZOSV
S XQSND=DUZ
D SNDMSG(XMSUB,XQSND,"XMTEXT",.XMY,1)
;
; log error in standard error trap
D ^%ZTER
D UNWIND^%ZTER
Q
;
CRTMMARY(LRHLARY,AUTYP,AUDES,AURTN,LRMMARY) ;Load Mail Message array
;INPUT
; LRHLARY - Array of Raw Data
;AUTYP = audit type (ex: AUF60 for File 60 audit
;AUDES = audit description (ex. File 60, New Person)
;AURTN = audit specific utility routine (ex. LRJSAU60 for file 60)
; LRMMARY - Mail Message array to send in message
;
N LRMSUBJ,XQSND,LRFROM,LRTO,XQSND,LRNODE,LRSAVE,LRLPCNT,XCAT,LRSUB,LRREF,LRTOMM
;
D LISTHLMM(LRHLARY)
;get top level with date information
;may seem like duplicate work since LISTHLMM has the same logic
;but LISTHLMM also called from other routine(s)
;may be safer to keep this logic here
S LRREF=$P(LRHLARY,")")_",1)"
S LRFROM=$P($G(@LRREF),"^")
S LRTO=$P($G(@LRREF),"^",2)
I LRFROM="" D Q
. W !,?10,"First invoke ""DF"" option"
. D PAUSE^VALM1
. I AUTYP["F60" D F60^LRJSAU
;
S LRMSUBJ=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
S XQSND=DUZ,LRLPCNT=1
I '$G(LRMMARY) S LRMMARY="^TMP(""LRJ SYS "_$E(AUTYP,3,99)_" AUD MANAGER"",$J)"
S @LRMMARY@(LRLPCNT)=LRMSUBJ
F XCAT="NEW","OLD" D
. S (LRNODE,LRSUB)=0
. I '$D(@VALMAR@(XCAT)) D Q
. . S LRLPCNT=LRLPCNT+1
. . S @LRMMARY@(LRLPCNT)=" No "_$S(XCAT="NEW":"new",1:"modified")_" entries"
. S LRLPCNT=LRLPCNT+1
. S @LRMMARY@(LRLPCNT)=$S(XCAT="NEW":"New",1:"Modified")_" entries"
D SNDMSG(LRMSUBJ,XQSND,LRMMARY,.LRTOMM,0)
S @LRREF=LRFROM_"^"_LRTO
;I $O(@VALMAR@(0))="" K @LRMMARY@(1),@LRMMARY@(2),@LRMMARY@(3)
Q
;
SNDMSG(LRMSUBJ,XQSND,LRMSGARY,LRTOMM,LRTASK) ;Send message to requestor
;INPUT:
; LRMSUBJ - Subject of message being generated
; XQSND - User's DUZ, Group Name, or S.server name
; LRMSGARY - Array containing message text
; LRTOMM - Array containing users, groups, etc who should receive the message
; LRTASK - If defined, indicates this is called from TASKMAN job
;
N LRINSTMM,LRTASKMM,XMERR,XMZ,LRLPCNT,LRTYPE
;
S:'$D(LRTASK) LRTASK=0
I 'LRTASK D
. K XMERR
. S LRINSTMM("ADDR FLAGS")="R" ;Do not Restrict Message addressing
. S LRTYPE="S"
. D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
. S LRLPCNT=""
. F S LRLPCNT=$O(^TMP("XMY",$J,LRLPCNT)) Q:LRLPCNT="" S LRTOMM(LRLPCNT)=""
;
I +$G(XMERR)'>0 DO
. ;no need to set additional VistA recipients - added LRTOMM as parameter
. S LRINSTMM("FROM")="LSRP_"_AUTYP_"_USER_ACTION"
. S LRMSUBJ=$E(LRMSUBJ,1,65)
. D SENDMSG^XMXAPI(XQSND,LRMSUBJ,LRMSGARY,.LRTOMM,.LRINSTMM,.LRTASKMM)
;
;K @LRMSGARY,^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG")
Q
;
;Following Protocol invokes this API: LRJ SYS MAP AUF60 SEND EXT
CRTXTMM(LRHLARY,AUTYP,AUDES,AURTN) ;Load Mail Message array
;INPUT
; LRHLARY - Array of Raw Data [^TMP($J,"LRJ SYS") when called by LRJ SYS MAP HL SEND MSG]
;
N LRMSUBJ,XQSND
S LRREF=$P(LRHLARY,"""EXTRACT""")_"1,0)"
S LRMSUBJ=$G(@LRREF)
I LRMSUBJ="" D Q
. W !,?10,"First invoke ""DF"" option"
. D PAUSE^VALM1
. I AUTYP["F60" D F60^LRJSAU
;
S XQSND=DUZ
D SNDEXT(LRMSUBJ,XQSND,LRHLARY)
Q
;
SNDEXT(LRMSUBJ,XQSND,LREXTARY) ;Send extract to requestor
;INPUT:
; LRMSUBJ - Subject of message being generated
; XQSND - User's DUZ, Group Name, or S.server name
; LREXTARY - Array containing message text.
;
N LRINSTMM,LRINSTVA,LRTASKMM,LRTASKVA,LRTOMM,LRTOVA,XMERR,XMZ,LRLPCNT,LRTYPE
;
S LRINSTMM("ADDR FLAGS")="R" ;Do not Restrict Message addressing
S LRTYPE="S"
K XMERR
D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
;
;Check for Network addresses and mail attachment
S LRINSTVA("ADDR FLAGS")="R" ;Do not Restrict Message addressing
S LRINSTVA("FROM")="LSRP_"_AUTYP_"_USER_ACTION"
S LRMSUBJ=$E(LRMSUBJ,1,65)
S LRLPCNT=""
F S LRLPCNT=$O(^TMP("XMY",$J,LRLPCNT)) Q:LRLPCNT="" S LRTOVA(LRLPCNT)=""
I +$G(XMERR)'>0 DO
.D OUTLKARY(LREXTARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ)
.D SENDMSG^XMXAPI(XQSND,LRMSUBJ,"^TMP($J,""LRNETMSG"")",.LRTOVA,.LRINSTVA,.LRTASKVA)
;
K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG")
Q
;
OUTLKARY(LRHLARY,LRHLOTLK,LRMSUBJ) ;Create array of attachments
;INPUT:
; LRHLARY - Array containing message text
; LRHLOTLK - Array containing message text for network addresses
; LRMSUBJ - Subject of message
;
N LRFILNM,LRFILNM1,LRFILNM2,LRDTTM,LRCRLF,LRSTR,LRNODE,LROUTNOD,LRNODATA,XSUB
S LRSTR=""
S LRNODATA=0
S LRCRLF=$C(13,10)
K @LRHLOTLK
S @LRHLOTLK@(1)="Extract Generated......: "_$$FMTE^XLFDT($$NOW^XLFDT)_LRCRLF
S @LRHLOTLK@(2)=" "
S @LRHLOTLK@(3)="Extract Requested......: "_LRMSUBJ_LRCRLF
S @LRHLOTLK@(4)=" "
;
S LRDTTM=$$NOW^XLFDT
S LRFILNM1=AUTYP_"_EXT_NEW_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".csv"
S LRFILNM2=AUTYP_"_EXT_MOD_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".csv"
S @LRHLOTLK@(5)=$S($D(@LRHLARY@("NEW")):"Attached LMOF",1:"No")_" NEW "_AUDES_" Entries"_$S($D(@LRHLARY@("NEW")):": "_LRFILNM1,1:"")_LRCRLF
S @LRHLOTLK@(6)=" "
S @LRHLOTLK@(7)=$S($D(@LRHLARY@("OLD")):"Attached LMOF",1:"No")_" MODIFIED "_AUDES_" Entries"_$S($D(@LRHLARY@("OLD")):": "_LRFILNM2,1:"")_LRCRLF
S:($O(@LRHLARY@(0))="") LRNODATA=1
S @LRHLOTLK@(8)=" "
S:(LRNODATA=0) @LRHLOTLK@(9)=" "
S:(LRNODATA=1) @LRHLOTLK@(9)="No data was extracted for date range!!"
;
;Begin output of "NEW" entries
F XSUB="NEW","OLD" D
. S LRNODE=0,LRSTR="",LROUTNOD=$S(XSUB="NEW":10,XSUB="OLD"&($D(@LRHLARY@("NEW"))):LROUTNOD+4,1:10)
. I $D(@LRHLARY@(XSUB)) D
. . S LRFILNM=$S(XSUB="NEW":LRFILNM1,1:LRFILNM2)
. . S @LRHLOTLK@(LROUTNOD)=$$UUBEGFN(LRFILNM)
. . F S LRNODE=$O(@LRHLARY@(XSUB,LRNODE)) Q:(LRNODE)="" D
. . . S LRSTR=LRSTR_@LRHLARY@(XSUB,LRNODE)_LRCRLF
. . . D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
. . S:(LRSTR'="") @LRHLOTLK@(LROUTNOD+1)=$$UUEN(LRSTR)
. . S @LRHLOTLK@(LROUTNOD+2)=" "
. . S @LRHLOTLK@(LROUTNOD+3)="end"
Q
;
UUBEGFN(LRFILENM) ; Construct uuencode "begin" coding
; Call with LRFILENM = name of uuencoded file attachment
;
; Returns LRX = string with "begin..."_file name
;
N LRX
S LRX="begin 644 "_LRFILENM
Q LRX
;
ENCODE(LRSTR,LRDTANOD,LRHLOTLK) ;Encode a string, keep remainder for next line
;INPUT:
; LRSTR - String to send in message; call by reference, Remainder returned in LRSTR
; LRDTANOD - Number of next Node to store message line in array
; LRHLOTLK - Array containing message text for network addresses
;
N LRQUIT,LRLEN,LRX
S LRQUIT=0,LRLEN=$L(LRSTR)
F D Q:LRQUIT
. I $L(LRSTR)<45 S LRQUIT=1 Q
. S LRX=$E(LRSTR,1,45)
. S LRDTANOD=LRDTANOD+1,@LRHLOTLK@(LRDTANOD)=$$UUEN(LRX)
. S LRSTR=$E(LRSTR,46,LRLEN)
Q
;
UUEN(STR) ; Uuencode string passed in.
N J,K,LEN,LRI,LRX,S,TMP,X,Y
S TMP="",LEN=$L(STR)
F LRI=1:3:LEN D
. S LRX=$E(STR,LRI,LRI+2)
. I $L(LRX)<3 S LRX=LRX_$E(" ",1,3-$L(LRX))
. S S=$A(LRX,1)*256+$A(LRX,2)*256+$A(LRX,3),Y=""
. F K=0:1:23 S Y=(S\(2**K)#2)_Y
. F K=1:6:24 D
. . S J=$$DEC^XLFUTL($E(Y,K,K+5),2)
. . S TMP=TMP_$C(J+32)
S TMP=$C(LEN+32)_TMP
Q TMP
;
;
PARAMED(AUTYP,AUDES) ;Edit the Dates referenced by tasked Option "LRJ SYS MAP [autyp] TASKMAN RPT"
;where AUTYP=audit type (ex. AUF60 for File 60 audit
; This API invokes the Edit Instance and Value of a Parameter API to edit the following
; Parameters:
; LRJ LSRP [autyp] LAST START DATE
; LRJ LSRP [autyp] LAST END DATE
;
; These parameters control the period that the Audit file extract is performed via the
; TaskMan scheduled job for the "LRJ SYS MAP [autyp] TASKMAN RPT" option
;
W !!,"Lab "_AUDES_" Audit extract dates record the report dates"
W !," for the last extract created by the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option."
W !," The LRJ LSRP "_AUTYP_" LAST END DATE is the start date used by the next execution"
W !," of the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option.",!
W !!,"WARNING: Editing the LRJ LSRP "_AUTYP_" LAST END DATE will affect the information"
W !," reported by the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option. This option makes"
W !," assumptions about data previously reported based upon this date."
W !!,"A USER CHANGING THE 'LRJ LSRP "_AUTYP_" LAST END DATE' MUST UNDERSTAND THE RESULT"
W !," OF THE CHANGE MADE AND RECONCILE THE REPORTS CREATED AGAINST THE PREVIOUS"
W !," REPORT CREATED!",!!
;
D EDITPAR^XPAREDIT("LRJ LSRP "_AUTYP_" LAST START "_$S(AUTYP["XT":"DT",1:"DATE"))
W !!,"-------------------------------------------------------------------------------"
D EDITPAR^XPAREDIT("LRJ LSRP "_AUTYP_" LAST END DATE")
;;D EN^XPAREDIT ;;IA #2336
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRJSAU2 13966 printed Sep 23, 2025@19:51:14 Page 2
LRJSAU2 ;ALB/GTS/DK/TMK - Lab Vista Audit Utilities;08/16/2010 15:53:28
+1 ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
+2 ;
+3 ;
KILL ;Kill off build data
+1 KILL ^TMP("LRJ SYS MAP AUD MSG",$JOB)
+2 KILL ^TMP("LRJ SYS MAP AUD MANAGER",$JOB)
+3 QUIT
+4 ;
LISTHLMM(LRHLARY) ; Store audit information in the display array
+1 ; INPUT -
+2 ; LRHLARY - Array of raw extract data
+3 ;
+4 NEW LRREF,LRFROM,LRTO
+5 ;get top level with date information
+6 SET LRREF=$PIECE(LRHLARY,")")_",1)"
+7 SET LRFROM=$PIECE($GET(@LRREF),"^")
+8 SET LRTO=$PIECE($GET(@LRREF),"^",2)
+9 DO KILL
+10 DO KILL^VALM10()
+11 DO CRTRPTAR(LRHLARY,LRFROM,LRTO,"DISPLAY","")
+12 QUIT
+13 ;
CRTRPTAR(LRHLARY,LRFROM,LRTO,LROUTPT,LRMMARY) ; Store info in the display array
+1 ; INPUT -
+2 ; LRHLARY - Array of raw extract data
+3 ; LRFROM - Start date for report
+4 ; LRTO - End date for report
+5 ; LROUTPT - "DISPLAY" for Listman; "MAIL" for mail message
+6 ; LRMMARY - Mail message output array
+7 ;
+8 NEW X,XN,XP,NODE,X1,X2,X3
+9 NEW LRFSTLNE,LRPARAM,LRLNCTN,LRLNCNT,LRVALST
+10 SET VALM("TITLE")=AUDES_" Audit Message"
+11 if $GET(LRMMARY)=""
SET LRMMARY=""
+12 if $GET(LROUTPT)=""
SET LROUTPT="DISPLAY"
+13 SET LRFSTLNE=0
+14 SET X=AUDES_$SELECT($DATA(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$SELECT($DATA(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
+15 IF LROUTPT="MAIL"
Begin DoDot:1
+16 SET LRLNCNT=0
+17 DO LRADDNOD^LRJSAU3(.LRLNCNT,X,"",LROUTPT,LRMMARY)
End DoDot:1
+18 QUIT
+19 ;
+20 ;THE FOLLOWING API is to be called from a Taskman
+21 ;scheduled job LRJ SYS MAP [autyp] TASKMAN RPT where autyp=audit type
+22 ;;;TASKMAN should call D TSKMMARY^LRJSAU2(AUTYP,AUDES,"^TMP(""LRJ SYS F60 AUD MANAGER"",$J)","^TMP(""LRJ SYS F60 AUD MANAGER"",$J)")
TSKMMARY(AUTYP,AUDES,AUFMT) ;TASKMAN API for Mail Message array
+1 ;
+2 ;INPUT (Roots for arrays to be created)
+3 ;AUTYP=Audit Type (AUF60 = File 60, AUF60XT = File 60 extract delimited file
+4 ;AUDES=Description (File 60 Audit, New Person Audit)
+5 ; LRHLARY - Array of Raw Data
+6 ; LRMMARY - Mail Message array to send in message
+7 ;AUFMT=format (Readable Display=DISPLAY; Delimited file =FILE)
+8 ;
+9 ;
+10 NEW $ESTACK,$ETRAP
SET $ETRAP="D TSKERR^LRJSAU2"
+11 NEW LRFROM,LRTO,LRTOMM,LRMSUBJ,XQSND,ERR,LRTOVA,LRTASKVA,LRINSTVA,AUSUB,TSKCALL,ZTIO
+12 ;
+13 ;;TO DO: GIVE INSTRUCTIONS FOR SCHEDULING THE FREQUENCY OF TASK JOB VIA TASKMAN
+14 ;;
+15 DO NOW^%DTC
+16 ;NOW is end date/time
SET LRTO=$EXTRACT(%,1,12)
+17 KILL %,X,%H,%I(1),%I(2),%I(3)
+18 SET LRFROM=$$GET^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST END DATE",1,"Q")
+19 ;
+20 ;If report hasn't been run before, generate for previous 7 days
+21 IF LRFROM=""
Begin DoDot:1
+22 SET X1=LRTO
+23 SET X2=-7
+24 DO C^%DTC
+25 SET LRFROM=X
+26 KILL X,%H
End DoDot:1
+27 ;
+28 DO EN^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST END DATE",,LRTO,.ERR)
+29 DO EN^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST START DATE",,LRFROM,.ERR)
+30 ;
+31 SET TSKCALL=1
SET ZTIO=""
+32 IF AUTYP["AUF60"
DO AUDISP^LRJSAU60
+33 IF AUTYP'["AUF60"
QUIT
+34 SET AUSUB=$SELECT(AUTYP["AUF60":"F60",1:"")
+35 SET (LRHLARY,LRMMARY)="^TMP(""LRJ SYS ""_AUSUB_"" AUD MANAGER"",$J)"
+36 IF AUTYP["XT"
SET (LRHLARY,LRMMARY)="^TMP(""LRJ SYS ""_AUSUB_"" AUD MANAGER"",$J,""EXTRACT"")"
+37 ;
+38 IF $DATA(@LRHLARY)
Begin DoDot:1
+39 SET LRLPCNT=1
+40 SET @LRMMARY@(LRLPCNT)=AUDES_$SELECT($DATA(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$SELECT($DATA(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
+41 IF AUFMT="DISPLAY"
Begin DoDot:2
+42 FOR XCAT="NEW","OLD"
Begin DoDot:3
+43 SET (LRNODE,LRSUB)=0
+44 IF '$DATA(@LRHLARY@(XCAT))
Begin DoDot:4
+45 SET LRLPCNT=LRLPCNT+1
+46 SET @LRMMARY@(LRLPCNT)=" No "_$SELECT(XCAT="NEW":"new",1:"modified")_" entries"
End DoDot:4
QUIT
+47 SET LRLPCNT=LRLPCNT+1
+48 SET @LRMMARY@(LRLPCNT)=""
+49 SET LRLPCNT=LRLPCNT+1
+50 SET @LRMMARY@(LRLPCNT)=$SELECT(XCAT="NEW":"New",1:"Modified")_" entries"
+51 SET LRLPCNT=LRLPCNT+1
+52 SET @LRMMARY@(LRLPCNT)=""
+53 FOR
SET LRNODE=$ORDER(@LRHLARY@(XCAT,LRNODE))
if LRNODE=""
QUIT
Begin DoDot:4
+54 FOR
SET LRSUB=$ORDER(@LRHLARY@(XCAT,LRNODE,LRSUB))
if LRSUB=""
QUIT
Begin DoDot:5
+55 SET LRLPCNT=LRLPCNT+1
+56 SET @LRMMARY@(LRLPCNT)=$GET(@LRHLARY@(XCAT,LRNODE,LRSUB))
End DoDot:5
End DoDot:4
End DoDot:3
+57 SET LRMSUBJ=AUDES_$SELECT($DATA(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$SELECT($DATA(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
+58 SET LRTOMM("G.LRJ "_AUTYP_" AUDIT TASK REPORT")=""
+59 SET XQSND=DUZ
+60 ;"1" = created by Taskman; send to Mailgroup
DO SNDMSG(LRMSUBJ,XQSND,LRMMARY,.LRTOMM,1)
End DoDot:2
+61 ;Send Extract message with attachments
+62 if AUFMT="DISPLAY"
QUIT
+63 SET LRMSUBJ=AUDES_$SELECT($DATA(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$SELECT($DATA(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
+64 ;
+65 ;Check for Network addresses and mail attachment
+66 ;Do not Restrict Message addressing
SET LRINSTVA("ADDR FLAGS")="R"
+67 SET LRINSTVA("FROM")="LSRP_"_AUTYP_" USER_ACTION"
+68 SET XQSND=DUZ
+69 SET LRTOVA(XQSND)=""
+70 ;Array of raw extract, Array of message text for networkd address, Message subject
+71 ;
+72 SET LRTOMM("G.LRJ "_AUTYP_" AUDIT TASK REPORT")=""
+73 DO OUTLKARY(LRHLARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ)
+74 DO SNDMSG(LRMSUBJ,XQSND,"^TMP($J,""LRNETMSG"")",.LRTOMM,1)
+75 ;
End DoDot:1
+76 KILL @LRHLARY,@LRMMARY,^TMP($JOB,"LRNETMSG")
+77 QUIT
+78 ;
TSKERR ; Error trap to send bulletin if queued report encounters a system error
+1 NEW XMTEXT,XMY,XMSUB,XQSND
+2 SET XMY("G.LRJ "_AUTYP_" AUDIT TASK REPORT")=""
+3 SET XMSUB=AUDES_" AUTOMATED REPORT ERROR"
+4 SET XMTEXT(1)="This message is to inform you that the "_AUDES_" automated report"
+5 SET XMTEXT(2)="has encountered an error and did not complete. Please contact your"
+6 SET XMTEXT(3)="system manager for further details."
+7 SET XMTEXT(4)=" "
+8 SET XMTEXT(5)="ERROR OCCURRED: "_$$FMTE^XLFDT($$NOW^XLFDT,"2")
+9 SET XMTEXT(6)="ERROR MESSAGE : "_$$EC^%ZOSV
+10 SET XQSND=DUZ
+11 DO SNDMSG(XMSUB,XQSND,"XMTEXT",.XMY,1)
+12 ;
+13 ; log error in standard error trap
+14 DO ^%ZTER
+15 DO UNWIND^%ZTER
+16 QUIT
+17 ;
CRTMMARY(LRHLARY,AUTYP,AUDES,AURTN,LRMMARY) ;Load Mail Message array
+1 ;INPUT
+2 ; LRHLARY - Array of Raw Data
+3 ;AUTYP = audit type (ex: AUF60 for File 60 audit
+4 ;AUDES = audit description (ex. File 60, New Person)
+5 ;AURTN = audit specific utility routine (ex. LRJSAU60 for file 60)
+6 ; LRMMARY - Mail Message array to send in message
+7 ;
+8 NEW LRMSUBJ,XQSND,LRFROM,LRTO,XQSND,LRNODE,LRSAVE,LRLPCNT,XCAT,LRSUB,LRREF,LRTOMM
+9 ;
+10 DO LISTHLMM(LRHLARY)
+11 ;get top level with date information
+12 ;may seem like duplicate work since LISTHLMM has the same logic
+13 ;but LISTHLMM also called from other routine(s)
+14 ;may be safer to keep this logic here
+15 SET LRREF=$PIECE(LRHLARY,")")_",1)"
+16 SET LRFROM=$PIECE($GET(@LRREF),"^")
+17 SET LRTO=$PIECE($GET(@LRREF),"^",2)
+18 IF LRFROM=""
Begin DoDot:1
+19 WRITE !,?10,"First invoke ""DF"" option"
+20 DO PAUSE^VALM1
+21 IF AUTYP["F60"
DO F60^LRJSAU
End DoDot:1
QUIT
+22 ;
+23 SET LRMSUBJ=AUDES_$SELECT($DATA(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$SELECT($DATA(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
+24 SET XQSND=DUZ
SET LRLPCNT=1
+25 IF '$GET(LRMMARY)
SET LRMMARY="^TMP(""LRJ SYS "_$EXTRACT(AUTYP,3,99)_" AUD MANAGER"",$J)"
+26 SET @LRMMARY@(LRLPCNT)=LRMSUBJ
+27 FOR XCAT="NEW","OLD"
Begin DoDot:1
+28 SET (LRNODE,LRSUB)=0
+29 IF '$DATA(@VALMAR@(XCAT))
Begin DoDot:2
+30 SET LRLPCNT=LRLPCNT+1
+31 SET @LRMMARY@(LRLPCNT)=" No "_$SELECT(XCAT="NEW":"new",1:"modified")_" entries"
End DoDot:2
QUIT
+32 SET LRLPCNT=LRLPCNT+1
+33 SET @LRMMARY@(LRLPCNT)=$SELECT(XCAT="NEW":"New",1:"Modified")_" entries"
End DoDot:1
+34 DO SNDMSG(LRMSUBJ,XQSND,LRMMARY,.LRTOMM,0)
+35 SET @LRREF=LRFROM_"^"_LRTO
+36 ;I $O(@VALMAR@(0))="" K @LRMMARY@(1),@LRMMARY@(2),@LRMMARY@(3)
+37 QUIT
+38 ;
SNDMSG(LRMSUBJ,XQSND,LRMSGARY,LRTOMM,LRTASK) ;Send message to requestor
+1 ;INPUT:
+2 ; LRMSUBJ - Subject of message being generated
+3 ; XQSND - User's DUZ, Group Name, or S.server name
+4 ; LRMSGARY - Array containing message text
+5 ; LRTOMM - Array containing users, groups, etc who should receive the message
+6 ; LRTASK - If defined, indicates this is called from TASKMAN job
+7 ;
+8 NEW LRINSTMM,LRTASKMM,XMERR,XMZ,LRLPCNT,LRTYPE
+9 ;
+10 if '$DATA(LRTASK)
SET LRTASK=0
+11 IF 'LRTASK
Begin DoDot:1
+12 KILL XMERR
+13 ;Do not Restrict Message addressing
SET LRINSTMM("ADDR FLAGS")="R"
+14 SET LRTYPE="S"
+15 DO TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
+16 SET LRLPCNT=""
+17 FOR
SET LRLPCNT=$ORDER(^TMP("XMY",$JOB,LRLPCNT))
if LRLPCNT=""
QUIT
SET LRTOMM(LRLPCNT)=""
End DoDot:1
+18 ;
+19 IF +$GET(XMERR)'>0
Begin DoDot:1
+20 ;no need to set additional VistA recipients - added LRTOMM as parameter
+21 SET LRINSTMM("FROM")="LSRP_"_AUTYP_"_USER_ACTION"
+22 SET LRMSUBJ=$EXTRACT(LRMSUBJ,1,65)
+23 DO SENDMSG^XMXAPI(XQSND,LRMSUBJ,LRMSGARY,.LRTOMM,.LRINSTMM,.LRTASKMM)
End DoDot:1
+24 ;
+25 ;K @LRMSGARY,^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG")
+26 QUIT
+27 ;
+28 ;Following Protocol invokes this API: LRJ SYS MAP AUF60 SEND EXT
CRTXTMM(LRHLARY,AUTYP,AUDES,AURTN) ;Load Mail Message array
+1 ;INPUT
+2 ; LRHLARY - Array of Raw Data [^TMP($J,"LRJ SYS") when called by LRJ SYS MAP HL SEND MSG]
+3 ;
+4 NEW LRMSUBJ,XQSND
+5 SET LRREF=$PIECE(LRHLARY,"""EXTRACT""")_"1,0)"
+6 SET LRMSUBJ=$GET(@LRREF)
+7 IF LRMSUBJ=""
Begin DoDot:1
+8 WRITE !,?10,"First invoke ""DF"" option"
+9 DO PAUSE^VALM1
+10 IF AUTYP["F60"
DO F60^LRJSAU
End DoDot:1
QUIT
+11 ;
+12 SET XQSND=DUZ
+13 DO SNDEXT(LRMSUBJ,XQSND,LRHLARY)
+14 QUIT
+15 ;
SNDEXT(LRMSUBJ,XQSND,LREXTARY) ;Send extract to requestor
+1 ;INPUT:
+2 ; LRMSUBJ - Subject of message being generated
+3 ; XQSND - User's DUZ, Group Name, or S.server name
+4 ; LREXTARY - Array containing message text.
+5 ;
+6 NEW LRINSTMM,LRINSTVA,LRTASKMM,LRTASKVA,LRTOMM,LRTOVA,XMERR,XMZ,LRLPCNT,LRTYPE
+7 ;
+8 ;Do not Restrict Message addressing
SET LRINSTMM("ADDR FLAGS")="R"
+9 SET LRTYPE="S"
+10 KILL XMERR
+11 DO TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
+12 ;
+13 ;Check for Network addresses and mail attachment
+14 ;Do not Restrict Message addressing
SET LRINSTVA("ADDR FLAGS")="R"
+15 SET LRINSTVA("FROM")="LSRP_"_AUTYP_"_USER_ACTION"
+16 SET LRMSUBJ=$EXTRACT(LRMSUBJ,1,65)
+17 SET LRLPCNT=""
+18 FOR
SET LRLPCNT=$ORDER(^TMP("XMY",$JOB,LRLPCNT))
if LRLPCNT=""
QUIT
SET LRTOVA(LRLPCNT)=""
+19 IF +$GET(XMERR)'>0
Begin DoDot:1
+20 DO OUTLKARY(LREXTARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ)
+21 DO SENDMSG^XMXAPI(XQSND,LRMSUBJ,"^TMP($J,""LRNETMSG"")",.LRTOVA,.LRINSTVA,.LRTASKVA)
End DoDot:1
+22 ;
+23 KILL ^TMP("XMY",$JOB),^TMP("XMY0",$JOB),^TMP($JOB,"LRNETMSG")
+24 QUIT
+25 ;
OUTLKARY(LRHLARY,LRHLOTLK,LRMSUBJ) ;Create array of attachments
+1 ;INPUT:
+2 ; LRHLARY - Array containing message text
+3 ; LRHLOTLK - Array containing message text for network addresses
+4 ; LRMSUBJ - Subject of message
+5 ;
+6 NEW LRFILNM,LRFILNM1,LRFILNM2,LRDTTM,LRCRLF,LRSTR,LRNODE,LROUTNOD,LRNODATA,XSUB
+7 SET LRSTR=""
+8 SET LRNODATA=0
+9 SET LRCRLF=$CHAR(13,10)
+10 KILL @LRHLOTLK
+11 SET @LRHLOTLK@(1)="Extract Generated......: "_$$FMTE^XLFDT($$NOW^XLFDT)_LRCRLF
+12 SET @LRHLOTLK@(2)=" "
+13 SET @LRHLOTLK@(3)="Extract Requested......: "_LRMSUBJ_LRCRLF
+14 SET @LRHLOTLK@(4)=" "
+15 ;
+16 SET LRDTTM=$$NOW^XLFDT
+17 SET LRFILNM1=AUTYP_"_EXT_NEW_"_$PIECE(LRDTTM,".",1)_"_"_$PIECE(LRDTTM,".",2)_".csv"
+18 SET LRFILNM2=AUTYP_"_EXT_MOD_"_$PIECE(LRDTTM,".",1)_"_"_$PIECE(LRDTTM,".",2)_".csv"
+19 SET @LRHLOTLK@(5)=$SELECT($DATA(@LRHLARY@("NEW")):"Attached LMOF",1:"No")_" NEW "_AUDES_" Entries"_$SELECT($DATA(@LRHLARY@("NEW")):": "_LRFILNM1,1:"")_LRCRLF
+20 SET @LRHLOTLK@(6)=" "
+21 SET @LRHLOTLK@(7)=$SELECT($DATA(@LRHLARY@("OLD")):"Attached LMOF",1:"No")_" MODIFIED "_AUDES_" Entries"_$SELECT($DATA(@LRHLARY@("OLD")):": "_LRFILNM2,1:"")_LRCRLF
+22 if ($ORDER(@LRHLARY@(0))="")
SET LRNODATA=1
+23 SET @LRHLOTLK@(8)=" "
+24 if (LRNODATA=0)
SET @LRHLOTLK@(9)=" "
+25 if (LRNODATA=1)
SET @LRHLOTLK@(9)="No data was extracted for date range!!"
+26 ;
+27 ;Begin output of "NEW" entries
+28 FOR XSUB="NEW","OLD"
Begin DoDot:1
+29 SET LRNODE=0
SET LRSTR=""
SET LROUTNOD=$SELECT(XSUB="NEW":10,XSUB="OLD"&($DATA(@LRHLARY@("NEW"))):LROUTNOD+4,1:10)
+30 IF $DATA(@LRHLARY@(XSUB))
Begin DoDot:2
+31 SET LRFILNM=$SELECT(XSUB="NEW":LRFILNM1,1:LRFILNM2)
+32 SET @LRHLOTLK@(LROUTNOD)=$$UUBEGFN(LRFILNM)
+33 FOR
SET LRNODE=$ORDER(@LRHLARY@(XSUB,LRNODE))
if (LRNODE)=""
QUIT
Begin DoDot:3
+34 SET LRSTR=LRSTR_@LRHLARY@(XSUB,LRNODE)_LRCRLF
+35 DO ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
End DoDot:3
+36 if (LRSTR'="")
SET @LRHLOTLK@(LROUTNOD+1)=$$UUEN(LRSTR)
+37 SET @LRHLOTLK@(LROUTNOD+2)=" "
+38 SET @LRHLOTLK@(LROUTNOD+3)="end"
End DoDot:2
End DoDot:1
+39 QUIT
+40 ;
UUBEGFN(LRFILENM) ; Construct uuencode "begin" coding
+1 ; Call with LRFILENM = name of uuencoded file attachment
+2 ;
+3 ; Returns LRX = string with "begin..."_file name
+4 ;
+5 NEW LRX
+6 SET LRX="begin 644 "_LRFILENM
+7 QUIT LRX
+8 ;
ENCODE(LRSTR,LRDTANOD,LRHLOTLK) ;Encode a string, keep remainder for next line
+1 ;INPUT:
+2 ; LRSTR - String to send in message; call by reference, Remainder returned in LRSTR
+3 ; LRDTANOD - Number of next Node to store message line in array
+4 ; LRHLOTLK - Array containing message text for network addresses
+5 ;
+6 NEW LRQUIT,LRLEN,LRX
+7 SET LRQUIT=0
SET LRLEN=$LENGTH(LRSTR)
+8 FOR
Begin DoDot:1
+9 IF $LENGTH(LRSTR)<45
SET LRQUIT=1
QUIT
+10 SET LRX=$EXTRACT(LRSTR,1,45)
+11 SET LRDTANOD=LRDTANOD+1
SET @LRHLOTLK@(LRDTANOD)=$$UUEN(LRX)
+12 SET LRSTR=$EXTRACT(LRSTR,46,LRLEN)
End DoDot:1
if LRQUIT
QUIT
+13 QUIT
+14 ;
UUEN(STR) ; Uuencode string passed in.
+1 NEW J,K,LEN,LRI,LRX,S,TMP,X,Y
+2 SET TMP=""
SET LEN=$LENGTH(STR)
+3 FOR LRI=1:3:LEN
Begin DoDot:1
+4 SET LRX=$EXTRACT(STR,LRI,LRI+2)
+5 IF $LENGTH(LRX)<3
SET LRX=LRX_$EXTRACT(" ",1,3-$LENGTH(LRX))
+6 SET S=$ASCII(LRX,1)*256+$ASCII(LRX,2)*256+$ASCII(LRX,3)
SET Y=""
+7 FOR K=0:1:23
SET Y=(S\(2**K)#2)_Y
+8 FOR K=1:6:24
Begin DoDot:2
+9 SET J=$$DEC^XLFUTL($EXTRACT(Y,K,K+5),2)
+10 SET TMP=TMP_$CHAR(J+32)
End DoDot:2
End DoDot:1
+11 SET TMP=$CHAR(LEN+32)_TMP
+12 QUIT TMP
+13 ;
+14 ;
PARAMED(AUTYP,AUDES) ;Edit the Dates referenced by tasked Option "LRJ SYS MAP [autyp] TASKMAN RPT"
+1 ;where AUTYP=audit type (ex. AUF60 for File 60 audit
+2 ; This API invokes the Edit Instance and Value of a Parameter API to edit the following
+3 ; Parameters:
+4 ; LRJ LSRP [autyp] LAST START DATE
+5 ; LRJ LSRP [autyp] LAST END DATE
+6 ;
+7 ; These parameters control the period that the Audit file extract is performed via the
+8 ; TaskMan scheduled job for the "LRJ SYS MAP [autyp] TASKMAN RPT" option
+9 ;
+10 WRITE !!,"Lab "_AUDES_" Audit extract dates record the report dates"
+11 WRITE !," for the last extract created by the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option."
+12 WRITE !," The LRJ LSRP "_AUTYP_" LAST END DATE is the start date used by the next execution"
+13 WRITE !," of the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option.",!
+14 WRITE !!,"WARNING: Editing the LRJ LSRP "_AUTYP_" LAST END DATE will affect the information"
+15 WRITE !," reported by the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option. This option makes"
+16 WRITE !," assumptions about data previously reported based upon this date."
+17 WRITE !!,"A USER CHANGING THE 'LRJ LSRP "_AUTYP_" LAST END DATE' MUST UNDERSTAND THE RESULT"
+18 WRITE !," OF THE CHANGE MADE AND RECONCILE THE REPORTS CREATED AGAINST THE PREVIOUS"
+19 WRITE !," REPORT CREATED!",!!
+20 ;
+21 DO EDITPAR^XPAREDIT("LRJ LSRP "_AUTYP_" LAST START "_$SELECT(AUTYP["XT":"DT",1:"DATE"))
+22 WRITE !!,"-------------------------------------------------------------------------------"
+23 DO EDITPAR^XPAREDIT("LRJ LSRP "_AUTYP_" LAST END DATE")
+24 ;;D EN^XPAREDIT ;;IA #2336
+25 QUIT
