LRJSML ;ALB/GTS - Lab Vista Hospital Location Utilities;02/24/2010 11:00:25
;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
;
;
HDR ; -- header code
SET VALMHDR(1)=" Lab Hospital Location Change Extract"
SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU()
Q
;
INIT ;* init variables and list array
N LRFROM,LRTO
D CREATRPT(.LRFROM,.LRTO,"^TMP($J,""LRJ SYS"")")
I (+$G(LRFROM)'>0)!(+$G(LRTO)'>0) DO
. S VALMBCK="Q"
. S VALMQUIT=1
I (+$G(LRFROM)>0),(+$G(LRTO)>0) DO
. D CLEAR(LRFROM,LRTO,"^TMP($J,""LRJ SYS"")")
. D MSG
QUIT
;
CLEAR(LRFROM,LRTO,LRHLARY) ;* clean up entries
DO REFRESH(LRFROM,LRTO,LRHLARY)
QUIT
;
MSG ; -- set default message
N LREND,LRBEGIN,LRAUTMSG
S LRBEGIN=$$GET^XPAR("SYS","LRJ HL LAST START DATE",1,"Q")
S LREND=$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q")
I (LRBEGIN'="")!(LREND'="") D
.S LRAUTMSG="Task Rpt "_$S(LRBEGIN'="":$$FMTE^XLFDT(LRBEGIN),1:"undefined")_" - "_$S(LREND'="":$$FMTE^XLFDT(LREND),1:"undefined")
;
I LRBEGIN="",LREND="" D
.S LRAUTMSG="Tasked Report has not run!"
S VALMSG=LRAUTMSG
QUIT
;
REFRESH(LRFROM,LRTO,LRHLARY) ;* refresh display
DO BUILD(LRFROM,LRTO,LRHLARY)
D MSG
SET VALMBCK="R"
SET VALMBG=1
QUIT
;
BUILD(LRFROM,LRTO,LRHLARY) ; -- build display array
;
;INPUT
; LRFROM - Start report date (Optional)
; LRTO - End report date (Optional)
; LRHLARY - Array of raw data extract (Required)
;
QUIT:'$D(LRHLARY) ;QUIT if LRHLARY is not defined)
;
NEW LRSTATUS,LRJERRCT,LRX
DO KILL^VALM10()
SET VALMCNT=0
S LRX=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_LRFROM,1:"")_$S($D(LRTO):" to "_LRTO,1:"")
D ADD^LRJSMLU(.VALMCNT,LRX)
DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX)-1,IOUON,IOUOFF_IOINORM)
;
D LISTHL(LRFROM,LRTO,LRHLARY)
;
;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If enhance send message HL MFN, see if can check link here.
Q
;
LISTHL(LRFROM,LRTO,LRHLARY) ; -- place Hospital Locations in the display array
NEW X,NODE
DO KILL^VALM10()
SET VALMCNT=0
SET X=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
DO ADD^LRJSMLU(.VALMCNT,X)
DO CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM)
D ADD^LRJSMLU(.VALMCNT," ")
SET NODE=0
FOR SET NODE=$ORDER(@LRHLARY@(NODE)) QUIT:NODE="" DO
. SET X=@LRHLARY@(NODE)
. DO BREAK(.VALMCNT,X,NODE)
QUIT
;
BREAK(VALMCNT,X,NODE) ; -- break into 79/80 char chunks for display
NEW LAOUT,LAX,SUBNODE,C
SET C="" ; -- continuation character
SET LAX=NODE_" : "_X
DO ADD^LRJSMLU(.VALMCNT,C_$EXTRACT(LAX,1,80))
SET C="+"
SET LAOUT=$EXTRACT(LAX,81,159)
IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
SET LAOUT=$EXTRACT(LAX,160,239)
IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
SET LAOUT=$EXTRACT(LAX,240,255)
IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
QUIT
;
;
CREATRPT(LRFROM,LRTO,LRHLARY) ;Create array of HL changes between selected dates
N DIR
;
W !!," Enter Hospital Location Extract Date Range...",!
;
S LRFROM=$$DATEENT("Select Start date: ",,"-NOW")
Q:+LRFROM<1
S LRTO=$$DATEENT(" Select End date: ",LRFROM,"-NOW")
Q:+LRTO<1
D MSG
;
;Call Report API
D BLDREC^LRJSMLA(LRFROM,LRTO,LRHLARY)
;
Q
;
DATEENT(LRPRMPT,LRBD,LRED) ;Prompt for extract date
;INPUT
; LRPRMPT - Prompt displayed to user
; LRBD - Begin date of range
; LRED - End date of range
;
;RETURN
; LRDT
; SUCCESS: FILEMAN INTERNALLY FORMATED DATE
; FAILURE: -1
;
N LRDT,LRGOOD
S LRGOOD=0
S:+$G(LRED)>0 %DT(0)=LRED
S:$G(LRED)["NOW" %DT(0)=LRED
S %DT("A")=LRPRMPT
S %DT("B")="TODAY" ;Default for [Start] date entry
S %DT="AEPST"
D:LRPRMPT["Start" ^%DT ;Prompt for Start date
;
;Prompt for End date with conditions
I LRPRMPT["End" DO
. F Q:LRGOOD DO
. . S %DT("B")="NOW" ;Change default for End Date entry
. . D ^%DT
. . W:((Y<LRBD)&(X'="^")&('$D(DTOUT))) " ??",!," End date must follow Begin date!",!
. . S:((Y>LRBD)!(Y=LRBD)!($D(DTOUT))!(X="^")) LRGOOD=1
S LRDT=Y
K Y,%DT
Q LRDT
;
DISPEXT(LRHLARY) ;Display Raw HL changes extracted
;
; This API will change the ListMan display array to a raw extract format
;INPUT
; LRHLARY - Array of raw extract data.
;
NEW LRFROM,LRTO
D HDR
;
;Pull date range of extract from ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
D GETDATE^LRJSML8(.LRFROM,.LRTO)
IF (+LRFROM=0)!(+LRTO=0) DO
.SET LRFROM=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^")
.SET LRTO=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^",2)
SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO
KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
D REFRESH(LRFROM,LRTO,LRHLARY)
D MSG
S VALMBCK="R"
S VALMBG=1
Q
;
MMHDR ; -- header code for Mail Message display
SET VALMHDR(1)=" Lab Hospital Location Change Message"
SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRJSML 5116 printed Sep 23, 2025@19:51:18 Page 2
LRJSML ;ALB/GTS - Lab Vista Hospital Location Utilities;02/24/2010 11:00:25
+1 ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
+2 ;
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)=" Lab Hospital Location Change Extract"
+2 SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU()
+3 QUIT
+4 ;
INIT ;* init variables and list array
+1 NEW LRFROM,LRTO
+2 DO CREATRPT(.LRFROM,.LRTO,"^TMP($J,""LRJ SYS"")")
+3 IF (+$GET(LRFROM)'>0)!(+$GET(LRTO)'>0)
Begin DoDot:1
+4 SET VALMBCK="Q"
+5 SET VALMQUIT=1
End DoDot:1
+6 IF (+$GET(LRFROM)>0)
IF (+$GET(LRTO)>0)
Begin DoDot:1
+7 DO CLEAR(LRFROM,LRTO,"^TMP($J,""LRJ SYS"")")
+8 DO MSG
End DoDot:1
+9 QUIT
+10 ;
CLEAR(LRFROM,LRTO,LRHLARY) ;* clean up entries
+1 DO REFRESH(LRFROM,LRTO,LRHLARY)
+2 QUIT
+3 ;
MSG ; -- set default message
+1 NEW LREND,LRBEGIN,LRAUTMSG
+2 SET LRBEGIN=$$GET^XPAR("SYS","LRJ HL LAST START DATE",1,"Q")
+3 SET LREND=$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q")
+4 IF (LRBEGIN'="")!(LREND'="")
Begin DoDot:1
+5 SET LRAUTMSG="Task Rpt "_$SELECT(LRBEGIN'="":$$FMTE^XLFDT(LRBEGIN),1:"undefined")_" - "_$SELECT(LREND'="":$$FMTE^XLFDT(LREND),1:"undefined")
End DoDot:1
+6 ;
+7 IF LRBEGIN=""
IF LREND=""
Begin DoDot:1
+8 SET LRAUTMSG="Tasked Report has not run!"
End DoDot:1
+9 SET VALMSG=LRAUTMSG
+10 QUIT
+11 ;
REFRESH(LRFROM,LRTO,LRHLARY) ;* refresh display
+1 DO BUILD(LRFROM,LRTO,LRHLARY)
+2 DO MSG
+3 SET VALMBCK="R"
+4 SET VALMBG=1
+5 QUIT
+6 ;
BUILD(LRFROM,LRTO,LRHLARY) ; -- build display array
+1 ;
+2 ;INPUT
+3 ; LRFROM - Start report date (Optional)
+4 ; LRTO - End report date (Optional)
+5 ; LRHLARY - Array of raw data extract (Required)
+6 ;
+7 ;QUIT if LRHLARY is not defined)
if '$DATA(LRHLARY)
QUIT
+8 ;
+9 NEW LRSTATUS,LRJERRCT,LRX
+10 DO KILL^VALM10()
+11 SET VALMCNT=0
+12 SET LRX=" VistA Hospital Location changes"_$SELECT($DATA(LRFROM):" from "_LRFROM,1:"")_$SELECT($DATA(LRTO):" to "_LRTO,1:"")
+13 DO ADD^LRJSMLU(.VALMCNT,LRX)
+14 DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX)-1,IOUON,IOUOFF_IOINORM)
+15 ;
+16 DO LISTHL(LRFROM,LRTO,LRHLARY)
+17 ;
+18 ;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If enhance send message HL MFN, see if can check link here.
+19 QUIT
+20 ;
LISTHL(LRFROM,LRTO,LRHLARY) ; -- place Hospital Locations in the display array
+1 NEW X,NODE
+2 DO KILL^VALM10()
+3 SET VALMCNT=0
+4 SET X=" VistA Hospital Location changes"_$SELECT($DATA(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$SELECT($DATA(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
+5 DO ADD^LRJSMLU(.VALMCNT,X)
+6 DO CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM)
+7 DO ADD^LRJSMLU(.VALMCNT," ")
+8 SET NODE=0
+9 FOR
SET NODE=$ORDER(@LRHLARY@(NODE))
if NODE=""
QUIT
Begin DoDot:1
+10 SET X=@LRHLARY@(NODE)
+11 DO BREAK(.VALMCNT,X,NODE)
End DoDot:1
+12 QUIT
+13 ;
BREAK(VALMCNT,X,NODE) ; -- break into 79/80 char chunks for display
+1 NEW LAOUT,LAX,SUBNODE,C
+2 ; -- continuation character
SET C=""
+3 SET LAX=NODE_" : "_X
+4 DO ADD^LRJSMLU(.VALMCNT,C_$EXTRACT(LAX,1,80))
+5 SET C="+"
+6 SET LAOUT=$EXTRACT(LAX,81,159)
+7 IF $LENGTH(LAOUT)>0
DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
+8 SET LAOUT=$EXTRACT(LAX,160,239)
+9 IF $LENGTH(LAOUT)>0
DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
+10 SET LAOUT=$EXTRACT(LAX,240,255)
+11 IF $LENGTH(LAOUT)>0
DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
+12 QUIT
+13 ;
+14 ;
CREATRPT(LRFROM,LRTO,LRHLARY) ;Create array of HL changes between selected dates
+1 NEW DIR
+2 ;
+3 WRITE !!," Enter Hospital Location Extract Date Range...",!
+4 ;
+5 SET LRFROM=$$DATEENT("Select Start date: ",,"-NOW")
+6 if +LRFROM<1
QUIT
+7 SET LRTO=$$DATEENT(" Select End date: ",LRFROM,"-NOW")
+8 if +LRTO<1
QUIT
+9 DO MSG
+10 ;
+11 ;Call Report API
+12 DO BLDREC^LRJSMLA(LRFROM,LRTO,LRHLARY)
+13 ;
+14 QUIT
+15 ;
DATEENT(LRPRMPT,LRBD,LRED) ;Prompt for extract date
+1 ;INPUT
+2 ; LRPRMPT - Prompt displayed to user
+3 ; LRBD - Begin date of range
+4 ; LRED - End date of range
+5 ;
+6 ;RETURN
+7 ; LRDT
+8 ; SUCCESS: FILEMAN INTERNALLY FORMATED DATE
+9 ; FAILURE: -1
+10 ;
+11 NEW LRDT,LRGOOD
+12 SET LRGOOD=0
+13 if +$GET(LRED)>0
SET %DT(0)=LRED
+14 if $GET(LRED)["NOW"
SET %DT(0)=LRED
+15 SET %DT("A")=LRPRMPT
+16 ;Default for [Start] date entry
SET %DT("B")="TODAY"
+17 SET %DT="AEPST"
+18 ;Prompt for Start date
if LRPRMPT["Start"
DO ^%DT
+19 ;
+20 ;Prompt for End date with conditions
+21 IF LRPRMPT["End"
Begin DoDot:1
+22 FOR
if LRGOOD
QUIT
Begin DoDot:2
+23 ;Change default for End Date entry
SET %DT("B")="NOW"
+24 DO ^%DT
+25 if ((Y<LRBD)&(X'="^")&('$DATA(DTOUT)))
WRITE " ??",!," End date must follow Begin date!",!
+26 if ((Y>LRBD)!(Y=LRBD)!($DATA(DTOUT))!(X="^"))
SET LRGOOD=1
End DoDot:2
End DoDot:1
+27 SET LRDT=Y
+28 KILL Y,%DT
+29 QUIT LRDT
+30 ;
DISPEXT(LRHLARY) ;Display Raw HL changes extracted
+1 ;
+2 ; This API will change the ListMan display array to a raw extract format
+3 ;INPUT
+4 ; LRHLARY - Array of raw extract data.
+5 ;
+6 NEW LRFROM,LRTO
+7 DO HDR
+8 ;
+9 ;Pull date range of extract from ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
+10 DO GETDATE^LRJSML8(.LRFROM,.LRTO)
+11 IF (+LRFROM=0)!(+LRTO=0)
Begin DoDot:1
+12 SET LRFROM=$PIECE($GET(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^")
+13 SET LRTO=$PIECE($GET(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^",2)
End DoDot:1
+14 SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO
+15 KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
+16 DO REFRESH(LRFROM,LRTO,LRHLARY)
+17 DO MSG
+18 SET VALMBCK="R"
+19 SET VALMBG=1
+20 QUIT
+21 ;
MMHDR ; -- header code for Mail Message display
+1 SET VALMHDR(1)=" Lab Hospital Location Change Message"
+2 SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU()
+3 QUIT
