LRJSML1 ;ALB/GTS - Lab Vista Hospital Location Initialization;02/24/2010 14:44:01
;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
;
;
EN ; -- main entry point for LRJ SYS MAP HL List Template
;
; -- required interface routine variable
NEW LRJSROU
SET LRJSROU="LRJSML1"
DO EN^VALM("LRJ SYS MAP HL")
QUIT
;
HDR ; -- header code
SET VALMHDR(1)=" Lab Hospital Location Definition Extract"
SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU()
QUIT
;
INIT ;* init variables and list array
KILL ^TMP("LRJ SYS USER MANAGER - DATES",$JOB),^TMP("LRJ SYS USER MANAGER - INIT",$JOB)
KILL ^TMP($J,"LRJ SYS","OUT")
DO CREATRPT("^TMP($J,""LRJ SYS"")")
DO CLEAR("^TMP($J,""LRJ SYS"")")
SET ^TMP("LRJ SYS USER MANAGER - INIT",$JOB)=1
QUIT
;
GETLINK() ; -- get logical link name
;;If enhance to send extracted data via via HL MFN, change LA7JMFN to correct link
QUIT "LA7JMFN"
;
CLEAR(LRHLARY) ;* clean up entries
DO REFRESH(LRHLARY)
QUIT
;
REFRESH(LRHLARY) ;* refresh display
DO BUILD(LRHLARY)
D MSG^LRJSML
SET VALMBCK="R"
SET VALMBG=1
QUIT
;
HELP ;* help code
SET X="?" D DISP^XQORM1 W !!
DO MSG^LRJSML
DO HDR
QUIT
;
EXIT ; -- exit code
KILL ^TMP($J,"LRJ SYS"),^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
KILL ^TMP("LRJ SYS USER MANAGER - DATES",$JOB),^TMP("LRJ SYS USER MANAGER - INIT",$JOB)
DO CLEAR^VALM1
Q
;
EXPND ; -- expand code
QUIT
;
BUILD(LRHLARY) ; -- build display array
;
;INPUT
; LRHLARY - Array of raw data extract (Required)
;
QUIT:'$D(LRHLARY) ;QUIT if LRHLARY is not defined)
;
NEW LRSTATUS,LRJERRCT,LRX
DO KILL
DO KILL^VALM10()
SET VALMCNT=0
SET LRX=" Hospital Locations currently defined in legacy VistA:"
DO ADD^LRJSMLU(.VALMCNT,LRX)
DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX),IOUON,IOUOFF_IOINORM)
;
DO LISTHL(LRHLARY)
;
;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If enhance to send HL MFN message, see if can check link here.
QUIT
;
KILL ; -- kill off display data array
KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
QUIT
;
LISTHL(LRHLARY,X) ; -- place Hospital Locations in the display array
;Input:
; LRHLARY - Array root for raw data of Extracted Locations
; X - First line heading for display array (Defaults to Current Location heading)
;
NEW NODE
DO KILL
DO KILL^VALM10()
SET VALMCNT=0
SET:$G(X)="" X=" Hospital Locations currently defined in legacy VistA:"
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
. S X=@LRHLARY@(NODE)
. DO BREAK^LRJSML(.VALMCNT,X,NODE)
QUIT
;
CREATRPT(LRHLARY) ;Create initial array of Hospital Location definition
; INPUT:
; LRHLARY - Array root for initial HL extract
N DIR
;
D MSG^LRJSML ;Display last report dates
D HDR
;
;Call Report API
W !
D EXTHL^LRJSML4(LRHLARY)
;
Q
;
;;Action code for Hospital Location Mapping Manager actions
;
DISPEXT(LRHLARY) ;Display Raw HL changes extracted
;
;Called from Protocol: LRJ SYS MAP HL DISP EXT
;
; This API will change the ListMan display array to a raw extract format
;INPUT
; LRHLARY - Array of raw extract data.
;
NEW LRINIT,LRFROM,LRTO
SET (LRFROM,LRTO)=""
SET LRINIT=$$INITCK()
;
IF LRINIT DO
.DO HDR
.KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
.DO REFRESH(LRHLARY)
;
IF 'LRINIT DO
.DO HDR^LRJSML
.DO SETRNG(.LRFROM,.LRTO)
.KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
.SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO
.DO REFRESH^LRJSML(LRFROM,LRTO,LRHLARY) ;* refresh display
QUIT
;
CREATMM(LRHLARY) ;Create a mail message array
;
;Called from Protocol: LRJ SYS MAP HL DISPLAY MESSAGE
;
; This API will change the ListMan display array to a Mail Message format
;INPUT
; LRHLARY - Array of raw extract data.
;
IF '$D(LRHLARY) DO
.W !!,"Extract not completed...",!
.DO PAUSE^VALM1
.DO HDR
.DO REFRESH(LRHLARY)
;
IF $D(LRHLARY) DO
.NEW LRINIT
.SET LRINIT=$$INITCK()
.D MMHDR
.IF $P($G(@LRHLARY@(1)),"^",1)'=" NO CHANGES FOUND!!" DO
..DO LISTHLMM^LRJSML8(LRHLARY)
..D MSG^LRJSML
..S VALMBCK="R"
..S VALMBG=1
.D:$P($G(@LRHLARY@(1)),"^",1)=" NO CHANGES FOUND!!" DISPEXT(LRHLARY)
;
QUIT
;
MMHDR ; -- header code for Mail Message display
NEW LRINIT
SET LRINIT=$$INITCK()
SET:LRINIT VALMHDR(1)=" Lab Hospital Location Definition Extract Message"
SET:'LRINIT VALMHDR(1)=" Lab Hospital Location Change Extract Message"
SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU()
QUIT
;
SETRNG(LRFROM,LRTO) ; Get current change Extract Date range
DO 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)
QUIT
;
INITCK() ;Return Initialization report indicator
; 1 : Init extract
; 0 : Not Init extract [Default]
;
QUIT +$G(^TMP("LRJ SYS USER MANAGER - INIT",$JOB))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRJSML1 5242 printed Jun 11, 2024@21:55:37 Page 2
LRJSML1 ;ALB/GTS - Lab Vista Hospital Location Initialization;02/24/2010 14:44:01
+1 ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
+2 ;
+3 ;
EN ; -- main entry point for LRJ SYS MAP HL List Template
+1 ;
+2 ; -- required interface routine variable
+3 NEW LRJSROU
+4 SET LRJSROU="LRJSML1"
+5 DO EN^VALM("LRJ SYS MAP HL")
+6 QUIT
+7 ;
HDR ; -- header code
+1 SET VALMHDR(1)=" Lab Hospital Location Definition Extract"
+2 SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU()
+3 QUIT
+4 ;
INIT ;* init variables and list array
+1 KILL ^TMP("LRJ SYS USER MANAGER - DATES",$JOB),^TMP("LRJ SYS USER MANAGER - INIT",$JOB)
+2 KILL ^TMP($JOB,"LRJ SYS","OUT")
+3 DO CREATRPT("^TMP($J,""LRJ SYS"")")
+4 DO CLEAR("^TMP($J,""LRJ SYS"")")
+5 SET ^TMP("LRJ SYS USER MANAGER - INIT",$JOB)=1
+6 QUIT
+7 ;
GETLINK() ; -- get logical link name
+1 ;;If enhance to send extracted data via via HL MFN, change LA7JMFN to correct link
+2 QUIT "LA7JMFN"
+3 ;
CLEAR(LRHLARY) ;* clean up entries
+1 DO REFRESH(LRHLARY)
+2 QUIT
+3 ;
REFRESH(LRHLARY) ;* refresh display
+1 DO BUILD(LRHLARY)
+2 DO MSG^LRJSML
+3 SET VALMBCK="R"
+4 SET VALMBG=1
+5 QUIT
+6 ;
HELP ;* help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 DO MSG^LRJSML
+3 DO HDR
+4 QUIT
+5 ;
EXIT ; -- exit code
+1 KILL ^TMP($JOB,"LRJ SYS"),^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
+2 KILL ^TMP("LRJ SYS USER MANAGER - DATES",$JOB),^TMP("LRJ SYS USER MANAGER - INIT",$JOB)
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
BUILD(LRHLARY) ; -- build display array
+1 ;
+2 ;INPUT
+3 ; LRHLARY - Array of raw data extract (Required)
+4 ;
+5 ;QUIT if LRHLARY is not defined)
if '$DATA(LRHLARY)
QUIT
+6 ;
+7 NEW LRSTATUS,LRJERRCT,LRX
+8 DO KILL
+9 DO KILL^VALM10()
+10 SET VALMCNT=0
+11 SET LRX=" Hospital Locations currently defined in legacy VistA:"
+12 DO ADD^LRJSMLU(.VALMCNT,LRX)
+13 DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX),IOUON,IOUOFF_IOINORM)
+14 ;
+15 DO LISTHL(LRHLARY)
+16 ;
+17 ;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If enhance to send HL MFN message, see if can check link here.
+18 QUIT
+19 ;
KILL ; -- kill off display data array
+1 KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
+2 QUIT
+3 ;
LISTHL(LRHLARY,X) ; -- place Hospital Locations in the display array
+1 ;Input:
+2 ; LRHLARY - Array root for raw data of Extracted Locations
+3 ; X - First line heading for display array (Defaults to Current Location heading)
+4 ;
+5 NEW NODE
+6 DO KILL
+7 DO KILL^VALM10()
+8 SET VALMCNT=0
+9 if $GET(X)=""
SET X=" Hospital Locations currently defined in legacy VistA:"
+10 DO ADD^LRJSMLU(.VALMCNT,X)
+11 DO CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM)
+12 DO ADD^LRJSMLU(.VALMCNT," ")
+13 SET NODE=0
+14 FOR
SET NODE=$ORDER(@LRHLARY@(NODE))
if NODE=""
QUIT
Begin DoDot:1
+15 SET X=@LRHLARY@(NODE)
+16 DO BREAK^LRJSML(.VALMCNT,X,NODE)
End DoDot:1
+17 QUIT
+18 ;
CREATRPT(LRHLARY) ;Create initial array of Hospital Location definition
+1 ; INPUT:
+2 ; LRHLARY - Array root for initial HL extract
+3 NEW DIR
+4 ;
+5 ;Display last report dates
DO MSG^LRJSML
+6 DO HDR
+7 ;
+8 ;Call Report API
+9 WRITE !
+10 DO EXTHL^LRJSML4(LRHLARY)
+11 ;
+12 QUIT
+13 ;
+14 ;;Action code for Hospital Location Mapping Manager actions
+15 ;
DISPEXT(LRHLARY) ;Display Raw HL changes extracted
+1 ;
+2 ;Called from Protocol: LRJ SYS MAP HL DISP EXT
+3 ;
+4 ; This API will change the ListMan display array to a raw extract format
+5 ;INPUT
+6 ; LRHLARY - Array of raw extract data.
+7 ;
+8 NEW LRINIT,LRFROM,LRTO
+9 SET (LRFROM,LRTO)=""
+10 SET LRINIT=$$INITCK()
+11 ;
+12 IF LRINIT
Begin DoDot:1
+13 DO HDR
+14 KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
+15 DO REFRESH(LRHLARY)
End DoDot:1
+16 ;
+17 IF 'LRINIT
Begin DoDot:1
+18 DO HDR^LRJSML
+19 DO SETRNG(.LRFROM,.LRTO)
+20 KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
+21 SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO
+22 ;* refresh display
DO REFRESH^LRJSML(LRFROM,LRTO,LRHLARY)
End DoDot:1
+23 QUIT
+24 ;
CREATMM(LRHLARY) ;Create a mail message array
+1 ;
+2 ;Called from Protocol: LRJ SYS MAP HL DISPLAY MESSAGE
+3 ;
+4 ; This API will change the ListMan display array to a Mail Message format
+5 ;INPUT
+6 ; LRHLARY - Array of raw extract data.
+7 ;
+8 IF '$DATA(LRHLARY)
Begin DoDot:1
+9 WRITE !!,"Extract not completed...",!
+10 DO PAUSE^VALM1
+11 DO HDR
+12 DO REFRESH(LRHLARY)
End DoDot:1
+13 ;
+14 IF $DATA(LRHLARY)
Begin DoDot:1
+15 NEW LRINIT
+16 SET LRINIT=$$INITCK()
+17 DO MMHDR
+18 IF $PIECE($GET(@LRHLARY@(1)),"^",1)'=" NO CHANGES FOUND!!"
Begin DoDot:2
+19 DO LISTHLMM^LRJSML8(LRHLARY)
+20 DO MSG^LRJSML
+21 SET VALMBCK="R"
+22 SET VALMBG=1
End DoDot:2
+23 if $PIECE($GET(@LRHLARY@(1)),"^",1)=" NO CHANGES FOUND!!"
DO DISPEXT(LRHLARY)
End DoDot:1
+24 ;
+25 QUIT
+26 ;
MMHDR ; -- header code for Mail Message display
+1 NEW LRINIT
+2 SET LRINIT=$$INITCK()
+3 if LRINIT
SET VALMHDR(1)=" Lab Hospital Location Definition Extract Message"
+4 if 'LRINIT
SET VALMHDR(1)=" Lab Hospital Location Change Extract Message"
+5 SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU()
+6 QUIT
+7 ;
SETRNG(LRFROM,LRTO) ; Get current change Extract Date range
+1 DO GETDATE^LRJSML8(.LRFROM,.LRTO)
+2 IF (+LRFROM=0)!(+LRTO=0)
Begin DoDot:1
+3 SET LRFROM=$PIECE($GET(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^")
+4 SET LRTO=$PIECE($GET(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^",2)
End DoDot:1
+5 QUIT
+6 ;
INITCK() ;Return Initialization report indicator
+1 ; 1 : Init extract
+2 ; 0 : Not Init extract [Default]
+3 ;
+4 QUIT +$GET(^TMP("LRJ SYS USER MANAGER - INIT",$JOB))
