LRJSML8 ;ALB/GTS - Lab Vista Hospital Location Utilities;04/23/2012 09:05
;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
;
;
LISTHLMM(LRHLARY) ; Store Hospital Locations in display array
; INPUT -
; LRHLARY - Array of raw extract data
;
NEW LRFROM,LRTO,LRINIT
SET LRINIT=$$INITCK^LRJSML1()
IF LRINIT SET (LRFROM,LRTO)=""
IF 'LRINIT DO SETRNG^LRJSML1(.LRFROM,.LRTO)
DO KILL^VALM10()
DO CRTRPTAR(LRHLARY,LRFROM,LRTO,"DISPLAY","")
QUIT
;
CRTRPTAR(LRHLARY,LRFROM,LRTO,LROUTPT,LRMMARY) ; Store Hospital Locations in display array
; INPUT -
; LRHLARY - Raw extract data Array
; LRFROM - Report Start date
; LRTO - Report End date
; LROUTPT - "DISPLAY" - Listman; "MAIL" - mail message
; LRMMARY - Mail msg output array
;
NEW X,LRXN,LRXP,NODE,LRLOC,LRRM,LROBED,LRHD,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED
NEW LRFSTLNE,LRPARAM,LRLNCTN,LRLNCNT,LRVALST,LRNEWLOC,LRINIT,LRNOTCHG
SET:$G(LRMMARY)="" LRMMARY=""
SET:$G(LROUTPT)="" LROUTPT="DISPLAY"
SET LRINIT=$$INITCK^LRJSML1()
SET LRNOTCHG=(LRINIT)
SET LRFSTLNE=0
SET LRNEWLOC=1
SET (LRLOC,LRRM,LROBED,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED)=""
SET:('LRNOTCHG) LRHD="NEW LOCATION"
SET:(LRNOTCHG) LRHD="CURRENT LOCATION"
SET X=$$XSET(LRINIT,LRFROM,LRTO)
;
I LROUTPT="MAIL" DO
.S LRLNCNT=0
.D LRADDNOD^LRJSML3(.LRLNCNT,X,"",LROUTPT,LRMMARY)
I LROUTPT="DISPLAY" DO
.S VALMCNT=0
.D LRADDNOD^LRJSML3(.VALMCNT,X,"",LROUTPT,LRMMARY)
.D CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM)
;
;Loop extract array
S NODE=0
F S NODE=$ORDER(@LRHLARY@(NODE)) Q:NODE="" DO
.S LRXN=@LRHLARY@(NODE)
.;
.;New Location
.I $P(LRXN,"^",1)'["CURRENT",$P(LRXN,"^",1)'["PREVIOUS" DO
..;
..;Set Paramater array (New)
..S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
..D SETNPARM^LRJSML3(LRVALST,.LRPARAM)
..S LRPARAM("XN")=LRXN
..S LRPARAM("LRLOC")=LRLOC
..;;
..D:LROUTPT="DISPLAY" MMDISPN^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
..D:LROUTPT="MAIL" MMDISPN^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY)
..;
..;Reset array params
..S LRLOC=LRPARAM("LRLOC")
..S LRRM=LRPARAM("LRRM")
..S LROBED=LRPARAM("LROBED")
..S LRHD=LRPARAM("LRHD")
..S LRFSTLNE=LRPARAM("LRFSTLNE")
.;
.;Edited location
.I $P(LRXN,"^",1)["CURRENT" DO
..;
..;Output last New rec
..I LRLOC'="" DO
...;
...;Set Param array (New)
...S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
...D SETNPARM^LRJSML3(LRVALST,.LRPARAM)
...S LRPARAM("LRLOC")=LRLOC
...;;
...D:LROUTPT="DISPLAY" LRNEWOUT^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC
...D:LROUTPT="MAIL" LRNEWOUT^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC
...;
...;Reset array param
...S LRLOC=LRPARAM("LRLOC")
...S LRRM=LRPARAM("LRRM")
...S LROBED=LRPARAM("LROBED")
...S LRHD=LRPARAM("LRHD")
...S LRFSTLNE=LRPARAM("LRFSTLNE")
..S LRLOC=""
..S NODE=NODE+1
..S LRXP=@LRHLARY@(NODE)
..;
..;Set Param array (Edited)
..S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRNOTCHG
..D SETEPARM^LRJSML3(LRVALST,.LRPARAM)
..;
..I $P(LRXN,"^",2)="LOCATION" DO
...S LRCLOC="^^"_$P(LRXN,"^",3,11)
...S LRPLOC="^^"_$P(LRXP,"^",3,11)
..S LRPARAM("XN")=LRXN
..S LRPARAM("XP")=LRXP
..S LRPARAM("LRCLOC")=LRCLOC
..S LRPARAM("LRPLOC")=LRPLOC
..S LRPARAM("LRNEWLOC")=LRNEWLOC
..;;
..D:LROUTPT="DISPLAY" MMDISPC^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
..D:LROUTPT="MAIL" MMDISPC^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY)
..;
..;Reset array param
..S LRCLOC=LRPARAM("LRCLOC")
..S LRCRM=LRPARAM("LRCRM")
..S LRCBED=LRPARAM("LRCBED")
..S LRPLOC=LRPARAM("LRPLOC")
..S LRPRM=LRPARAM("LRPRM")
..S LRPBED=LRPARAM("LRPBED")
..S LRFSTLNE=LRPARAM("LRFSTLNE")
..S LRNEWLOC=LRPARAM("LRNEWLOC")
I LRLOC'="" DO
.;
.;Set Param array (New)
.S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
.D SETNPARM^LRJSML3(LRVALST,.LRPARAM)
.S LRPARAM("LRLOC")=LRLOC
.;;
.D:LROUTPT="DISPLAY" LRNEWOUT^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC
.D:LROUTPT="MAIL" LRNEWOUT^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC
.;
.;Reset array params
.S LRLOC=LRPARAM("LRLOC")
.S LRRM=LRPARAM("LRRM")
.S LROBED=LRPARAM("LROBED")
.S LRHD=LRPARAM("LRHD")
.S LRFSTLNE=LRPARAM("LRFSTLNE")
;
QUIT
;
XSET(LRINIT,LRFROM,LRTO) ;Set report description (first line listed)
;INPUT:
; LRINIT -
; 1 : Init extract
; 0 : Not Init extract [Default]
; LRFROM - Report Beginning date (Passed by Ref)
; LRTO - Report Ending date (Passed by Ref)
;
NEW LRX
SET:('LRINIT) LRX=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
IF +$G(LRINIT)>0 DO
.SET LRX=" VistA Hospital Location Configurations on "_$$FMTE^XLFDT($P($G(^TMP($J,"LRJ SYS",1)),"^",11))
QUIT LRX
;
GETDATE(LRFROM,LRTO) ;Return Report dates from ^TMP("LRJ SYS MAP HL MANAGER",$JOB)
;INPUT:
; LRFROM - Report Beginning date (Passed by Ref)
; LRTO - Report Ending date (Passed by Ref)
;
;OUTPUT (Passed by Ref):
; LRFROM - Report Beginning date
; LRTO - Report Ending date
;
S LRFROM=$P(^TMP("LRJ SYS MAP HL INIT MGR",$JOB,1,0),"Hospital Location changes",2)
S LRFROM=$P(LRFROM," from ",2)
S LRFROM=$P(LRFROM," to ",1)
S LRTO=$P(^TMP("LRJ SYS MAP HL INIT MGR",$JOB,1,0)," to ",2)
Q
;
SNDMSG(LRMSUBJ,XQSND,LRMSGARY,LRTASK) ;Send HL changes to requestor
;INPUT:
; LRMSUBJ - Subject of msg generated
; XQSND - User's DUZ, Group Name, or S.server name
; LRMSGARY - Array containing msg text
; LRTASK - If defined, indicates called from TASKMAN job
;
N LRINSTMM,LRTASKMM,LRTOMM,XMERR,XMZ,LRLPCNT,LRTYPE
;
S:'$D(LRTASK) LRTASK=0
I 'LRTASK DO
. K XMERR
. S LRINSTMM("ADDR FLAGS")="R" ;Do not Restrict 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
. S LRTOMM(XQSND)=""
. S LRTOMM("G.LRJ SYS MAP HL TASK REPORT")=""
. S LRINSTMM("FROM")="LAB_HLCSM_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
;
SNDEXT(LRMSUBJ,XQSND,LREXTARY) ;Send HL changes Extract to requester
;INPUT:
; LRMSUBJ - Subject of message generated
; XQSND - User's DUZ, Group Name, or S.server name
; LREXTARY - Array containing msg text
;
N LRINSTMM,LRINSTVA,LRTASKMM,LRTASKVA,LRTOMM,LRTOVA,XMERR,XMZ,LRLPCNT,LRTYPE
;
S LRINSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing
S LRTYPE="S"
K XMERR
D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
;
;Check Network addresses and mail attachmt
S LRINSTVA("ADDR FLAGS")="R" ;Do not Restrict addressing
S LRINSTVA("FROM")="LAB_HLCSM_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
.W !," [Creating attachments..."
.D OUTLKARY(LREXTARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ,1)
.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,LRRT) ;Create attachmts array
;INPUT:
; LRHLARY - Array containing raw message text
; LRHLOTLK - Array containing message text for network addresses
; LRMSUBJ - Message subject
; LRRT - Real Time processing from UI
;
N LRFILNM1,LRFILNM2,LRDTTM,LRCRLF,LRSTR,LRNODE,LROUTNOD,LRNODATA,LRCHAR
S:+$G(LRRT)=0 LRRT=0
S:+$G(LRRT) LRCHAR=0
S LRSTR=""
S LRNODATA=0
S LRCRLF=$C(13,10)
K @LRHLOTLK
S @LRHLOTLK@(1)="Extract Message 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="HLCSM_EXT_NEW_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".TXT"
S LRFILNM2="HLCSM_EXT_MOD_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".TXT"
S @LRHLOTLK@(5)="Attached LMOF NEW Hospital Locations file.....: "_LRFILNM1_LRCRLF
S @LRHLOTLK@(6)=" "
S @LRHLOTLK@(7)="Attached LMOF MODIFIED Hospital Locations file.....: "_LRFILNM2_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 NEW Hospital Locations file output
S @LRHLOTLK@(10)=$$UUBEGFN(LRFILNM1)
S LRNODE=0
S LROUTNOD=10
F S LRNODE=$O(@LRHLARY@(LRNODE)) Q:(LRNODE="") Q:($P($G(@LRHLARY@(LRNODE)),"^",1)="CURRENT") DO
. I +$G(LRRT) D:LRNODE#100=0 HANGCHAR^LRJSMLU(.LRCHAR)
. S LRSTR=LRSTR_@LRHLARY@(LRNODE)_LRCRLF
. D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
;
F Q:$L(LRSTR<45) D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
S:(LRSTR'="") @LRHLOTLK@(LROUTNOD+1)=$$UUEN^LRJSMLU(LRSTR)
S @LRHLOTLK@(LROUTNOD+2)=" "
S @LRHLOTLK@(LROUTNOD+3)="end"
;
;Begin MODIFIED Hospital Locations file output
S LRSTR=""
S LROUTNOD=LROUTNOD+4
S @LRHLOTLK@(LROUTNOD)=$$UUBEGFN(LRFILNM2)
I +LRNODE>0 DO
.S LRNODE=LRNODE-1
.F S LRNODE=$O(@LRHLARY@(LRNODE)) Q:(LRNODE="") DO
..I +$G(LRRT) D:LRNODE#100=0 HANGCHAR^LRJSMLU(.LRCHAR)
..S LRSTR=LRSTR_@LRHLARY@(LRNODE)_LRCRLF
..D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
.;
.F Q:$L(LRSTR<45) D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
S:(LRSTR'="") @LRHLOTLK@(LROUTNOD+1)=$$UUEN^LRJSMLU(LRSTR)
S @LRHLOTLK@(LROUTNOD+2)=" "
S @LRHLOTLK@(LROUTNOD+3)="end"
Q
;
UUBEGFN(LRFILENM) ; Construct uuencode "begin" coding
; Call with LRFILENM = name of uuencoded file attachmt
;
; 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 msg; call by reference, Remainder returned in LRSTR
; LRDTANOD - Number of next Node to store msg line in array
; LRHLOTLK - Array containing msg 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^LRJSMLU(LRX)
. S LRSTR=$E(LRSTR,46,LRLEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRJSML8 10532 printed Sep 23, 2025@19:51:25 Page 2
LRJSML8 ;ALB/GTS - Lab Vista Hospital Location Utilities;04/23/2012 09:05
+1 ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
+2 ;
+3 ;
LISTHLMM(LRHLARY) ; Store Hospital Locations in display array
+1 ; INPUT -
+2 ; LRHLARY - Array of raw extract data
+3 ;
+4 NEW LRFROM,LRTO,LRINIT
+5 SET LRINIT=$$INITCK^LRJSML1()
+6 IF LRINIT
SET (LRFROM,LRTO)=""
+7 IF 'LRINIT
DO SETRNG^LRJSML1(.LRFROM,.LRTO)
+8 DO KILL^VALM10()
+9 DO CRTRPTAR(LRHLARY,LRFROM,LRTO,"DISPLAY","")
+10 QUIT
+11 ;
CRTRPTAR(LRHLARY,LRFROM,LRTO,LROUTPT,LRMMARY) ; Store Hospital Locations in display array
+1 ; INPUT -
+2 ; LRHLARY - Raw extract data Array
+3 ; LRFROM - Report Start date
+4 ; LRTO - Report End date
+5 ; LROUTPT - "DISPLAY" - Listman; "MAIL" - mail message
+6 ; LRMMARY - Mail msg output array
+7 ;
+8 NEW X,LRXN,LRXP,NODE,LRLOC,LRRM,LROBED,LRHD,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED
+9 NEW LRFSTLNE,LRPARAM,LRLNCTN,LRLNCNT,LRVALST,LRNEWLOC,LRINIT,LRNOTCHG
+10 if $GET(LRMMARY)=""
SET LRMMARY=""
+11 if $GET(LROUTPT)=""
SET LROUTPT="DISPLAY"
+12 SET LRINIT=$$INITCK^LRJSML1()
+13 SET LRNOTCHG=(LRINIT)
+14 SET LRFSTLNE=0
+15 SET LRNEWLOC=1
+16 SET (LRLOC,LRRM,LROBED,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED)=""
+17 if ('LRNOTCHG)
SET LRHD="NEW LOCATION"
+18 if (LRNOTCHG)
SET LRHD="CURRENT LOCATION"
+19 SET X=$$XSET(LRINIT,LRFROM,LRTO)
+20 ;
+21 IF LROUTPT="MAIL"
Begin DoDot:1
+22 SET LRLNCNT=0
+23 DO LRADDNOD^LRJSML3(.LRLNCNT,X,"",LROUTPT,LRMMARY)
End DoDot:1
+24 IF LROUTPT="DISPLAY"
Begin DoDot:1
+25 SET VALMCNT=0
+26 DO LRADDNOD^LRJSML3(.VALMCNT,X,"",LROUTPT,LRMMARY)
+27 DO CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM)
End DoDot:1
+28 ;
+29 ;Loop extract array
+30 SET NODE=0
+31 FOR
SET NODE=$ORDER(@LRHLARY@(NODE))
if NODE=""
QUIT
Begin DoDot:1
+32 SET LRXN=@LRHLARY@(NODE)
+33 ;
+34 ;New Location
+35 IF $PIECE(LRXN,"^",1)'["CURRENT"
IF $PIECE(LRXN,"^",1)'["PREVIOUS"
Begin DoDot:2
+36 ;
+37 ;Set Paramater array (New)
+38 SET LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
+39 DO SETNPARM^LRJSML3(LRVALST,.LRPARAM)
+40 SET LRPARAM("XN")=LRXN
+41 SET LRPARAM("LRLOC")=LRLOC
+42 ;;
+43 if LROUTPT="DISPLAY"
DO MMDISPN^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
+44 if LROUTPT="MAIL"
DO MMDISPN^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY)
+45 ;
+46 ;Reset array params
+47 SET LRLOC=LRPARAM("LRLOC")
+48 SET LRRM=LRPARAM("LRRM")
+49 SET LROBED=LRPARAM("LROBED")
+50 SET LRHD=LRPARAM("LRHD")
+51 SET LRFSTLNE=LRPARAM("LRFSTLNE")
End DoDot:2
+52 ;
+53 ;Edited location
+54 IF $PIECE(LRXN,"^",1)["CURRENT"
Begin DoDot:2
+55 ;
+56 ;Output last New rec
+57 IF LRLOC'=""
Begin DoDot:3
+58 ;
+59 ;Set Param array (New)
+60 SET LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
+61 DO SETNPARM^LRJSML3(LRVALST,.LRPARAM)
+62 SET LRPARAM("LRLOC")=LRLOC
+63 ;;
+64 ;OUTPUT LAST NEW LOC
if LROUTPT="DISPLAY"
DO LRNEWOUT^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
+65 ;OUTPUT LAST NEW LOC
if LROUTPT="MAIL"
DO LRNEWOUT^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY)
+66 ;
+67 ;Reset array param
+68 SET LRLOC=LRPARAM("LRLOC")
+69 SET LRRM=LRPARAM("LRRM")
+70 SET LROBED=LRPARAM("LROBED")
+71 SET LRHD=LRPARAM("LRHD")
+72 SET LRFSTLNE=LRPARAM("LRFSTLNE")
End DoDot:3
+73 SET LRLOC=""
+74 SET NODE=NODE+1
+75 SET LRXP=@LRHLARY@(NODE)
+76 ;
+77 ;Set Param array (Edited)
+78 SET LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRNOTCHG
+79 DO SETEPARM^LRJSML3(LRVALST,.LRPARAM)
+80 ;
+81 IF $PIECE(LRXN,"^",2)="LOCATION"
Begin DoDot:3
+82 SET LRCLOC="^^"_$PIECE(LRXN,"^",3,11)
+83 SET LRPLOC="^^"_$PIECE(LRXP,"^",3,11)
End DoDot:3
+84 SET LRPARAM("XN")=LRXN
+85 SET LRPARAM("XP")=LRXP
+86 SET LRPARAM("LRCLOC")=LRCLOC
+87 SET LRPARAM("LRPLOC")=LRPLOC
+88 SET LRPARAM("LRNEWLOC")=LRNEWLOC
+89 ;;
+90 if LROUTPT="DISPLAY"
DO MMDISPC^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
+91 if LROUTPT="MAIL"
DO MMDISPC^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY)
+92 ;
+93 ;Reset array param
+94 SET LRCLOC=LRPARAM("LRCLOC")
+95 SET LRCRM=LRPARAM("LRCRM")
+96 SET LRCBED=LRPARAM("LRCBED")
+97 SET LRPLOC=LRPARAM("LRPLOC")
+98 SET LRPRM=LRPARAM("LRPRM")
+99 SET LRPBED=LRPARAM("LRPBED")
+100 SET LRFSTLNE=LRPARAM("LRFSTLNE")
+101 SET LRNEWLOC=LRPARAM("LRNEWLOC")
End DoDot:2
End DoDot:1
+102 IF LRLOC'=""
Begin DoDot:1
+103 ;
+104 ;Set Param array (New)
+105 SET LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
+106 DO SETNPARM^LRJSML3(LRVALST,.LRPARAM)
+107 SET LRPARAM("LRLOC")=LRLOC
+108 ;;
+109 ;OUTPUT LAST NEW LOC
if LROUTPT="DISPLAY"
DO LRNEWOUT^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
+110 ;OUTPUT LAST NEW LOC
if LROUTPT="MAIL"
DO LRNEWOUT^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY)
+111 ;
+112 ;Reset array params
+113 SET LRLOC=LRPARAM("LRLOC")
+114 SET LRRM=LRPARAM("LRRM")
+115 SET LROBED=LRPARAM("LROBED")
+116 SET LRHD=LRPARAM("LRHD")
+117 SET LRFSTLNE=LRPARAM("LRFSTLNE")
End DoDot:1
+118 ;
+119 QUIT
+120 ;
XSET(LRINIT,LRFROM,LRTO) ;Set report description (first line listed)
+1 ;INPUT:
+2 ; LRINIT -
+3 ; 1 : Init extract
+4 ; 0 : Not Init extract [Default]
+5 ; LRFROM - Report Beginning date (Passed by Ref)
+6 ; LRTO - Report Ending date (Passed by Ref)
+7 ;
+8 NEW LRX
+9 if ('LRINIT)
SET LRX=" VistA Hospital Location changes"_$SELECT($DATA(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$SELECT($DATA(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
+10 IF +$GET(LRINIT)>0
Begin DoDot:1
+11 SET LRX=" VistA Hospital Location Configurations on "_$$FMTE^XLFDT($PIECE($GET(^TMP($JOB,"LRJ SYS",1)),"^",11))
End DoDot:1
+12 QUIT LRX
+13 ;
GETDATE(LRFROM,LRTO) ;Return Report dates from ^TMP("LRJ SYS MAP HL MANAGER",$JOB)
+1 ;INPUT:
+2 ; LRFROM - Report Beginning date (Passed by Ref)
+3 ; LRTO - Report Ending date (Passed by Ref)
+4 ;
+5 ;OUTPUT (Passed by Ref):
+6 ; LRFROM - Report Beginning date
+7 ; LRTO - Report Ending date
+8 ;
+9 SET LRFROM=$PIECE(^TMP("LRJ SYS MAP HL INIT MGR",$JOB,1,0),"Hospital Location changes",2)
+10 SET LRFROM=$PIECE(LRFROM," from ",2)
+11 SET LRFROM=$PIECE(LRFROM," to ",1)
+12 SET LRTO=$PIECE(^TMP("LRJ SYS MAP HL INIT MGR",$JOB,1,0)," to ",2)
+13 QUIT
+14 ;
SNDMSG(LRMSUBJ,XQSND,LRMSGARY,LRTASK) ;Send HL changes to requestor
+1 ;INPUT:
+2 ; LRMSUBJ - Subject of msg generated
+3 ; XQSND - User's DUZ, Group Name, or S.server name
+4 ; LRMSGARY - Array containing msg text
+5 ; LRTASK - If defined, indicates called from TASKMAN job
+6 ;
+7 NEW LRINSTMM,LRTASKMM,LRTOMM,XMERR,XMZ,LRLPCNT,LRTYPE
+8 ;
+9 if '$DATA(LRTASK)
SET LRTASK=0
+10 IF 'LRTASK
Begin DoDot:1
+11 KILL XMERR
+12 ;Do not Restrict addressing
SET LRINSTMM("ADDR FLAGS")="R"
+13 SET LRTYPE="S"
+14 DO TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
+15 SET LRLPCNT=""
+16 FOR
SET LRLPCNT=$ORDER(^TMP("XMY",$JOB,LRLPCNT))
if LRLPCNT=""
QUIT
SET LRTOMM(LRLPCNT)=""
End DoDot:1
+17 ;
+18 IF +$GET(XMERR)'>0
Begin DoDot:1
+19 SET LRTOMM(XQSND)=""
+20 SET LRTOMM("G.LRJ SYS MAP HL TASK REPORT")=""
+21 SET LRINSTMM("FROM")="LAB_HLCSM_USER_ACTION"
+22 SET LRMSUBJ=$EXTRACT(LRMSUBJ,1,65)
+23 DO SENDMSG^XMXAPI(XQSND,LRMSUBJ,LRMSGARY,.LRTOMM,.LRINSTMM,.LRTASKMM)
End DoDot:1
+24 ;
+25 KILL @LRMSGARY,^TMP("XMY",$JOB),^TMP("XMY0",$JOB),^TMP($JOB,"LRNETMSG")
+26 QUIT
+27 ;
SNDEXT(LRMSUBJ,XQSND,LREXTARY) ;Send HL changes Extract to requester
+1 ;INPUT:
+2 ; LRMSUBJ - Subject of message generated
+3 ; XQSND - User's DUZ, Group Name, or S.server name
+4 ; LREXTARY - Array containing msg text
+5 ;
+6 NEW LRINSTMM,LRINSTVA,LRTASKMM,LRTASKVA,LRTOMM,LRTOVA,XMERR,XMZ,LRLPCNT,LRTYPE
+7 ;
+8 ;Do not Restrict addressing
SET LRINSTMM("ADDR FLAGS")="R"
+9 SET LRTYPE="S"
+10 KILL XMERR
+11 DO TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
+12 ;
+13 ;Check Network addresses and mail attachmt
+14 ;Do not Restrict addressing
SET LRINSTVA("ADDR FLAGS")="R"
+15 SET LRINSTVA("FROM")="LAB_HLCSM_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 ;
+20 IF +$GET(XMERR)'>0
Begin DoDot:1
+21 WRITE !," [Creating attachments..."
+22 DO OUTLKARY(LREXTARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ,1)
+23 DO SENDMSG^XMXAPI(XQSND,LRMSUBJ,"^TMP($J,""LRNETMSG"")",.LRTOVA,.LRINSTVA,.LRTASKVA)
End DoDot:1
+24 ;
+25 KILL ^TMP("XMY",$JOB),^TMP("XMY0",$JOB),^TMP($JOB,"LRNETMSG")
+26 QUIT
+27 ;
OUTLKARY(LRHLARY,LRHLOTLK,LRMSUBJ,LRRT) ;Create attachmts array
+1 ;INPUT:
+2 ; LRHLARY - Array containing raw message text
+3 ; LRHLOTLK - Array containing message text for network addresses
+4 ; LRMSUBJ - Message subject
+5 ; LRRT - Real Time processing from UI
+6 ;
+7 NEW LRFILNM1,LRFILNM2,LRDTTM,LRCRLF,LRSTR,LRNODE,LROUTNOD,LRNODATA,LRCHAR
+8 if +$GET(LRRT)=0
SET LRRT=0
+9 if +$GET(LRRT)
SET LRCHAR=0
+10 SET LRSTR=""
+11 SET LRNODATA=0
+12 SET LRCRLF=$CHAR(13,10)
+13 KILL @LRHLOTLK
+14 SET @LRHLOTLK@(1)="Extract Message Generated......: "_$$FMTE^XLFDT($$NOW^XLFDT)_LRCRLF
+15 SET @LRHLOTLK@(2)=" "
+16 SET @LRHLOTLK@(3)="Extract Requested......: "_LRMSUBJ_LRCRLF
+17 SET @LRHLOTLK@(4)=" "
+18 ;
+19 SET LRDTTM=$$NOW^XLFDT
+20 SET LRFILNM1="HLCSM_EXT_NEW_"_$PIECE(LRDTTM,".",1)_"_"_$PIECE(LRDTTM,".",2)_".TXT"
+21 SET LRFILNM2="HLCSM_EXT_MOD_"_$PIECE(LRDTTM,".",1)_"_"_$PIECE(LRDTTM,".",2)_".TXT"
+22 SET @LRHLOTLK@(5)="Attached LMOF NEW Hospital Locations file.....: "_LRFILNM1_LRCRLF
+23 SET @LRHLOTLK@(6)=" "
+24 SET @LRHLOTLK@(7)="Attached LMOF MODIFIED Hospital Locations file.....: "_LRFILNM2_LRCRLF
+25 if ($ORDER(@LRHLARY@(0))="")
SET LRNODATA=1
+26 SET @LRHLOTLK@(8)=" "
+27 if (LRNODATA=0)
SET @LRHLOTLK@(9)=" "
+28 if (LRNODATA=1)
SET @LRHLOTLK@(9)="No data was extracted for date range!!"
+29 ;
+30 ;Begin NEW Hospital Locations file output
+31 SET @LRHLOTLK@(10)=$$UUBEGFN(LRFILNM1)
+32 SET LRNODE=0
+33 SET LROUTNOD=10
+34 FOR
SET LRNODE=$ORDER(@LRHLARY@(LRNODE))
if (LRNODE="")
QUIT
if ($PIECE($GET(@LRHLARY@(LRNODE)),"^",1)="CURRENT")
QUIT
Begin DoDot:1
+35 IF +$GET(LRRT)
if LRNODE#100=0
DO HANGCHAR^LRJSMLU(.LRCHAR)
+36 SET LRSTR=LRSTR_@LRHLARY@(LRNODE)_LRCRLF
+37 DO ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
End DoDot:1
+38 ;
+39 FOR
if $LENGTH(LRSTR<45)
QUIT
DO ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
+40 if (LRSTR'="")
SET @LRHLOTLK@(LROUTNOD+1)=$$UUEN^LRJSMLU(LRSTR)
+41 SET @LRHLOTLK@(LROUTNOD+2)=" "
+42 SET @LRHLOTLK@(LROUTNOD+3)="end"
+43 ;
+44 ;Begin MODIFIED Hospital Locations file output
+45 SET LRSTR=""
+46 SET LROUTNOD=LROUTNOD+4
+47 SET @LRHLOTLK@(LROUTNOD)=$$UUBEGFN(LRFILNM2)
+48 IF +LRNODE>0
Begin DoDot:1
+49 SET LRNODE=LRNODE-1
+50 FOR
SET LRNODE=$ORDER(@LRHLARY@(LRNODE))
if (LRNODE="")
QUIT
Begin DoDot:2
+51 IF +$GET(LRRT)
if LRNODE#100=0
DO HANGCHAR^LRJSMLU(.LRCHAR)
+52 SET LRSTR=LRSTR_@LRHLARY@(LRNODE)_LRCRLF
+53 DO ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
End DoDot:2
+54 ;
+55 FOR
if $LENGTH(LRSTR<45)
QUIT
DO ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
End DoDot:1
+56 if (LRSTR'="")
SET @LRHLOTLK@(LROUTNOD+1)=$$UUEN^LRJSMLU(LRSTR)
+57 SET @LRHLOTLK@(LROUTNOD+2)=" "
+58 SET @LRHLOTLK@(LROUTNOD+3)="end"
+59 QUIT
+60 ;
UUBEGFN(LRFILENM) ; Construct uuencode "begin" coding
+1 ; Call with LRFILENM = name of uuencoded file attachmt
+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 msg; call by reference, Remainder returned in LRSTR
+3 ; LRDTANOD - Number of next Node to store msg line in array
+4 ; LRHLOTLK - Array containing msg 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^LRJSMLU(LRX)
+12 SET LRSTR=$EXTRACT(LRSTR,46,LRLEN)
End DoDot:1
if LRQUIT
QUIT
+13 QUIT
