LRJSML4 ;ALB/GTS - Lab Vista Hospital Location Pre-Patch Utilities;02/24/2010 14:01:37
;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
;
;
EXTHL(LRES) ;** Create HL output array
;Create array of active Hospital Locations of type Clinic, Ward, Operating Room
;Add associated Ward Location to the array
;Find Room-Beds assocated with the Ward Location
;
;INPUT:
; LRES - Node for array of active locations and room-beds
;
;OUTPUT:
; LRES - List Array of active hospital locations (Clinic, Ward, OR)
;
;Set LRES array in the following format:
;^TMP(545954627,"LRJ SYS",#)=NEW^LOCATION^HL IEN^HL Name^HL Type^Institution^Division^InActive Dt (NULL)^Active Dt(NULL)^Person making change^Chnge Dt/Tm
;^TMP(545954627,"LRJ SYS",#+1)=NEW^ROOM^HL IEN^HL Name^HL Type^Institution^Division^Room^
;^TMP(545954627,"LRJ SYS",#+2)=NEW^BED^HL IEN^HL Name^HL Type^Institution^Division^Room^Bed
;^TMP(545954627,"LRJ SYS",#+3)=NEW^BED^HL IEN^HL Name^HL Type^Institution^Division^Room^Bed
;
;IA #10040 allows reference the following fields:
; Hospital Location #44, Field #.01 [NAME] (LRHLNAME) [FILEMAN]
; Hospital Location #44, Field #2 [TYPE] (LRHLTYPE) [FILEMAN]
; Hospital Location #44, Field #3 [INSTITUTION] (LRHLINST) [FILEMAN]
; Hospital Location #44, Field #3.5 [DIVISION] (LRHLDIV) [FILEMAN]
; Hospital Location #44, Field #42 [WARD LOCATION FILE POINTER] (LRWPTR) [DIRECT GLOBAL ACCESS]
; Hospital Location #44, Field #2505 [INACTIVE DATE] (LRINACT) [FILEMAN]
; Hospital Location #44, Field #2506 [REACTIVATION DATE] (LRREACT) [FILEMAN]
;
;IA #1380 allows reference to Room-Bed file:
; Room-Bed #405.4, Field #.01 [NAME] (LRRMBD) [DIRECT GLOBAL ACCESS]
; X-Ref on Wards Which Can Assign multiple in Room-Bed file (405.4^W)
; [^DG(405.4,"W",$E(X,1,30),DA(1),DA)] [DIRECT GLOBAL ACCESS]
;
NEW LRHLIEN,LRTYPEIN,LRINACTI,LRREACTI,LRNODE,LRNOW
NEW LRLP,LRCHAR
;Loop HL file screening TYPE and INACTIVE/REACTIVATION dates
;QUESTION: Does the HLCMS system report items that are not inactive but have future dates?
;ANSWER: HLCMS reports changes to inactive/active dates.
; Want to report locations that are now active or will become active in the future.
; If INACT=NULL then report
; If INACT'=NULL then...
; IF ACT>NOW then report [If (INACT<NOW,ACT>NOW)!(INACT>NOW,ACT>NOW)]
; If INACT>NOW,ACT<NOW then report
; If INACT<NOW,ACT<NOW,ACT>INACT then report
;
;Pull Name, Type, Institution, Division, WL PTR, Inactivation Date, ReActivation Date from file 44
;Find Room-Beds that have the same WL PTR, check for OOS dates and report if in-service.
DO IOXY^XGF(IOSL-1,53)
WRITE "[Extract Locations..."
SET LRHLIEN=""
SET (LRHLIEN,LRNODE,LRCHAR)=0
D NOW^%DTC
SET LRNOW=%
KILL %,%H,%I,X
FOR SET LRHLIEN=$O(^SC(LRHLIEN)) QUIT:+LRHLIEN'>0 DO
.D HANGCHAR^LRJSMLU(.LRCHAR)
.SET (LRTYPEIN,LRINACTI,LRREACTI)=""
.SET LRTYPEIN=$$GET1^DIQ(44,LRHLIEN_",",2,"I") ;HL Type (INT)
.;
.;IF TYPE IS 'CLINIC', 'WARD', 'OPERATING ROOM'
.IF (LRTYPEIN="C")!(LRTYPEIN="W")!(LRTYPEIN="OR") DO
..SET LRINACTI=$$GET1^DIQ(44,LRHLIEN_",",2505,"I") ;HL Inact Dte (INT)
..SET LRREACTI=$$GET1^DIQ(44,LRHLIEN_",",2506,"I") ;HL React Dte (INT)
..IF LRINACTI="" DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW)
..IF LRINACTI'="" DO
...IF LRREACTI>LRNOW DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW)
...IF LRINACTI>LRNOW,LRREACTI<LRNOW DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW)
...IF LRINACTI<LRNOW,LRREACTI<LRNOW,LRREACTI>LRINACTI DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW)
QUIT
;
SETARRY(LRES,LRNODE,LRHLIEN,LRNOW) ;Set Location Array
;INPUT:
; LRES - Array to create and return
; LRNODE - Last node # added to array
; LRHLIEN - Hospital Location (#44) IEN
; LRNOW - Date/Time creating array
;
;OUTPUT:
; LRES - Array with Location/Room/Bed nodes added
;
NEW LRHLNAME,LRHLTYPE,LRINST,LRDIV,LRRMBD,LRINACT,LRREACT,LRWPTR,LRRMBDPT,LRRMOLD,LRBED,LRROOM
SET (LRHLNAME,LRHLTYPE,LRINST,LRDIV,LRRMBD,LRINACT,LRREACT,LRWPTR,LRRMBDPT,LRRMOLD)=""
SET LRNODE=LRNODE+1
SET LRINACT=$$GET1^DIQ(44,LRHLIEN_",",2505) ;HL Inact Dte (EXT)
SET LRREACT=$$GET1^DIQ(44,LRHLIEN_",",2506) ;HL React Dte (EXT)
SET LRHLTYPE=$$GET1^DIQ(44,LRHLIEN_",",2) ;HL Type (EXT)
SET LRHLNAME=$$GET1^DIQ(44,LRHLIEN_",",.01) ;HL Name (EXT)
SET LRINST=$$GET1^DIQ(44,LRHLIEN_",",3) ;HL Inst (EXT)
SET LRDIV=$$GET1^DIQ(44,LRHLIEN_",",3.5) ;HL Div (EXT)
SET LRWPTR=+$P($G(^SC(LRHLIEN,42)),"^") ;Ward Loc PTR (EXT)
SET @LRES@(LRNODE)="NEW^LOCATION^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRINACT_"^"_LRREACT_"^"_"ADT ADMINISTRATOR <UNKNOWN>"_"^"_LRNOW
FOR SET LRRMBDPT=$O(^DG(405.4,"W",LRWPTR,LRRMBDPT)) QUIT:+LRRMBDPT=0 DO
.SET LRNODE=LRNODE+1
.SET LRRMBD=$P(^DG(405.4,LRRMBDPT,0),"^")
.SET LRROOM=$P(LRRMBD,"-")
.IF LRROOM'=LRRMOLD DO
..SET @LRES@(LRNODE)="NEW^ROOM^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRROOM_"^"
..SET LRRMOLD=LRROOM
..SET LRNODE=LRNODE+1
.SET LRBED=$P(LRRMBD,"-",2,10)
.SET @LRES@(LRNODE)="NEW^BED^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRROOM_"^"_LRBED
QUIT
;
CDRNG ;Protocol: LRJ SYS MAP HL AUDIT QUERY to select the report type
D FULL^VALM1
NEW LRTYPE
SET LRTYPE=$$TYPESEL()
;
;Reset screen display
IF LRTYPE'=-1 DO
.DO:LRTYPE="C" INIT
.DO:LRTYPE="I" INIT^LRJSML1
IF LRTYPE=-1 D MSG^LRJSML SET VALMBCK="R"
QUIT
;
INIT ;* init variables and list array
N LRFROM,LRTO
K ^TMP($J,"LRJ SYS"),^TMP("LRJ SYS USER MANAGER - DATES",$JOB)
K ^TMP("LRJ SYS USER MANAGER - INIT",$JOB)
DO IOXY^XGF(IOSL-1,53)
WRITE "[Extract Locations..."
D CREATRPT(.LRFROM,.LRTO,"^TMP($J,""LRJ SYS"")")
I (+$G(LRFROM)'>0)!(+$G(LRTO)'>0) DO
. S VALMBCK="R"
. S VALMBG=1
I (+$G(LRFROM)>0),(+$G(LRTO)>0) DO
. D CLEAR(LRFROM,LRTO,"^TMP($J,""LRJ SYS"")")
. D HDR^LRJSML
. D MSG^LRJSML
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
SET ^TMP("LRJ SYS USER MANAGER - INIT",$JOB)=0
D HDR^LRJSML
D MSG^LRJSML
;
;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
;
CLEAR(LRFROM,LRTO,LRHLARY) ;* clean up entries
DO REFRESH(LRFROM,LRTO,LRHLARY)
QUIT
;
REFRESH(LRFROM,LRTO,LRHLARY) ;* refresh display
DO BUILD(LRFROM,LRTO,LRHLARY)
D MSG^LRJSML
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
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 KILL
SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO
D LISTHL^LRJSML(LRFROM,LRTO,LRHLARY)
;
;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If add function to send HL MFN message, see if can check link here.
Q
;
KILL ; -- kill off display data array
KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
QUIT
;
TYPESEL() ;Select type of report
;OUTPUT
; LRJRSLT : "I" - Initialization Extract
; : "C" - Change Audit Extract
; : "P" - Inactive Location Extract
; : -1 - Abort
NEW LRJRSLT
SET LRJRSLT=-1
NEW DIR
SET DIR("A")=" Enter Extract Report Type"
SET DIR(0)="SO^I:Initialization Rpt;C:Location Change Rpt"
SET DIR("?")="^D PROHELP^LRJSML4"
SET DIR("L",1)=" Select one of the following:"
SET DIR("L",2)=" I : Initialization/Current Location Report"
SET DIR("L")=" C : Location Change Report"
DO ^DIR
SET:"ICP"[Y LRJRSLT=Y
SET:($D(DTOUT)!$D(DUOUT)!(Y="")) LRJRSLT=-1
SET:"ICP"'[Y LRJRSLT=-1
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT LRJRSLT
;
PROHELP ;Help with type of report prompt
WRITE !,"Enter 'I' to extract all currently active locations."
WRITE !,"Enter 'C' to extract the location changes for a selected date range."
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRJSML4 9433 printed Oct 16, 2024@18:16:27 Page 2
LRJSML4 ;ALB/GTS - Lab Vista Hospital Location Pre-Patch Utilities;02/24/2010 14:01:37
+1 ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
+2 ;
+3 ;
EXTHL(LRES) ;** Create HL output array
+1 ;Create array of active Hospital Locations of type Clinic, Ward, Operating Room
+2 ;Add associated Ward Location to the array
+3 ;Find Room-Beds assocated with the Ward Location
+4 ;
+5 ;INPUT:
+6 ; LRES - Node for array of active locations and room-beds
+7 ;
+8 ;OUTPUT:
+9 ; LRES - List Array of active hospital locations (Clinic, Ward, OR)
+10 ;
+11 ;Set LRES array in the following format:
+12 ;^TMP(545954627,"LRJ SYS",#)=NEW^LOCATION^HL IEN^HL Name^HL Type^Institution^Division^InActive Dt (NULL)^Active Dt(NULL)^Person making change^Chnge Dt/Tm
+13 ;^TMP(545954627,"LRJ SYS",#+1)=NEW^ROOM^HL IEN^HL Name^HL Type^Institution^Division^Room^
+14 ;^TMP(545954627,"LRJ SYS",#+2)=NEW^BED^HL IEN^HL Name^HL Type^Institution^Division^Room^Bed
+15 ;^TMP(545954627,"LRJ SYS",#+3)=NEW^BED^HL IEN^HL Name^HL Type^Institution^Division^Room^Bed
+16 ;
+17 ;IA #10040 allows reference the following fields:
+18 ; Hospital Location #44, Field #.01 [NAME] (LRHLNAME) [FILEMAN]
+19 ; Hospital Location #44, Field #2 [TYPE] (LRHLTYPE) [FILEMAN]
+20 ; Hospital Location #44, Field #3 [INSTITUTION] (LRHLINST) [FILEMAN]
+21 ; Hospital Location #44, Field #3.5 [DIVISION] (LRHLDIV) [FILEMAN]
+22 ; Hospital Location #44, Field #42 [WARD LOCATION FILE POINTER] (LRWPTR) [DIRECT GLOBAL ACCESS]
+23 ; Hospital Location #44, Field #2505 [INACTIVE DATE] (LRINACT) [FILEMAN]
+24 ; Hospital Location #44, Field #2506 [REACTIVATION DATE] (LRREACT) [FILEMAN]
+25 ;
+26 ;IA #1380 allows reference to Room-Bed file:
+27 ; Room-Bed #405.4, Field #.01 [NAME] (LRRMBD) [DIRECT GLOBAL ACCESS]
+28 ; X-Ref on Wards Which Can Assign multiple in Room-Bed file (405.4^W)
+29 ; [^DG(405.4,"W",$E(X,1,30),DA(1),DA)] [DIRECT GLOBAL ACCESS]
+30 ;
+31 NEW LRHLIEN,LRTYPEIN,LRINACTI,LRREACTI,LRNODE,LRNOW
+32 NEW LRLP,LRCHAR
+33 ;Loop HL file screening TYPE and INACTIVE/REACTIVATION dates
+34 ;QUESTION: Does the HLCMS system report items that are not inactive but have future dates?
+35 ;ANSWER: HLCMS reports changes to inactive/active dates.
+36 ; Want to report locations that are now active or will become active in the future.
+37 ; If INACT=NULL then report
+38 ; If INACT'=NULL then...
+39 ; IF ACT>NOW then report [If (INACT<NOW,ACT>NOW)!(INACT>NOW,ACT>NOW)]
+40 ; If INACT>NOW,ACT<NOW then report
+41 ; If INACT<NOW,ACT<NOW,ACT>INACT then report
+42 ;
+43 ;Pull Name, Type, Institution, Division, WL PTR, Inactivation Date, ReActivation Date from file 44
+44 ;Find Room-Beds that have the same WL PTR, check for OOS dates and report if in-service.
+45 DO IOXY^XGF(IOSL-1,53)
+46 WRITE "[Extract Locations..."
+47 SET LRHLIEN=""
+48 SET (LRHLIEN,LRNODE,LRCHAR)=0
+49 DO NOW^%DTC
+50 SET LRNOW=%
+51 KILL %,%H,%I,X
+52 FOR
SET LRHLIEN=$ORDER(^SC(LRHLIEN))
if +LRHLIEN'>0
QUIT
Begin DoDot:1
+53 DO HANGCHAR^LRJSMLU(.LRCHAR)
+54 SET (LRTYPEIN,LRINACTI,LRREACTI)=""
+55 ;HL Type (INT)
SET LRTYPEIN=$$GET1^DIQ(44,LRHLIEN_",",2,"I")
+56 ;
+57 ;IF TYPE IS 'CLINIC', 'WARD', 'OPERATING ROOM'
+58 IF (LRTYPEIN="C")!(LRTYPEIN="W")!(LRTYPEIN="OR")
Begin DoDot:2
+59 ;HL Inact Dte (INT)
SET LRINACTI=$$GET1^DIQ(44,LRHLIEN_",",2505,"I")
+60 ;HL React Dte (INT)
SET LRREACTI=$$GET1^DIQ(44,LRHLIEN_",",2506,"I")
+61 IF LRINACTI=""
DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW)
+62 IF LRINACTI'=""
Begin DoDot:3
+63 IF LRREACTI>LRNOW
DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW)
+64 IF LRINACTI>LRNOW
IF LRREACTI<LRNOW
DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW)
+65 IF LRINACTI<LRNOW
IF LRREACTI<LRNOW
IF LRREACTI>LRINACTI
DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW)
End DoDot:3
End DoDot:2
End DoDot:1
+66 QUIT
+67 ;
SETARRY(LRES,LRNODE,LRHLIEN,LRNOW) ;Set Location Array
+1 ;INPUT:
+2 ; LRES - Array to create and return
+3 ; LRNODE - Last node # added to array
+4 ; LRHLIEN - Hospital Location (#44) IEN
+5 ; LRNOW - Date/Time creating array
+6 ;
+7 ;OUTPUT:
+8 ; LRES - Array with Location/Room/Bed nodes added
+9 ;
+10 NEW LRHLNAME,LRHLTYPE,LRINST,LRDIV,LRRMBD,LRINACT,LRREACT,LRWPTR,LRRMBDPT,LRRMOLD,LRBED,LRROOM
+11 SET (LRHLNAME,LRHLTYPE,LRINST,LRDIV,LRRMBD,LRINACT,LRREACT,LRWPTR,LRRMBDPT,LRRMOLD)=""
+12 SET LRNODE=LRNODE+1
+13 ;HL Inact Dte (EXT)
SET LRINACT=$$GET1^DIQ(44,LRHLIEN_",",2505)
+14 ;HL React Dte (EXT)
SET LRREACT=$$GET1^DIQ(44,LRHLIEN_",",2506)
+15 ;HL Type (EXT)
SET LRHLTYPE=$$GET1^DIQ(44,LRHLIEN_",",2)
+16 ;HL Name (EXT)
SET LRHLNAME=$$GET1^DIQ(44,LRHLIEN_",",.01)
+17 ;HL Inst (EXT)
SET LRINST=$$GET1^DIQ(44,LRHLIEN_",",3)
+18 ;HL Div (EXT)
SET LRDIV=$$GET1^DIQ(44,LRHLIEN_",",3.5)
+19 ;Ward Loc PTR (EXT)
SET LRWPTR=+$PIECE($GET(^SC(LRHLIEN,42)),"^")
+20 SET @LRES@(LRNODE)="NEW^LOCATION^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRINACT_"^"_LRREACT_"^"_"ADT ADMINISTRATOR <UNKNOWN>"_"^"_LRNOW
+21 FOR
SET LRRMBDPT=$ORDER(^DG(405.4,"W",LRWPTR,LRRMBDPT))
if +LRRMBDPT=0
QUIT
Begin DoDot:1
+22 SET LRNODE=LRNODE+1
+23 SET LRRMBD=$PIECE(^DG(405.4,LRRMBDPT,0),"^")
+24 SET LRROOM=$PIECE(LRRMBD,"-")
+25 IF LRROOM'=LRRMOLD
Begin DoDot:2
+26 SET @LRES@(LRNODE)="NEW^ROOM^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRROOM_"^"
+27 SET LRRMOLD=LRROOM
+28 SET LRNODE=LRNODE+1
End DoDot:2
+29 SET LRBED=$PIECE(LRRMBD,"-",2,10)
+30 SET @LRES@(LRNODE)="NEW^BED^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRROOM_"^"_LRBED
End DoDot:1
+31 QUIT
+32 ;
CDRNG ;Protocol: LRJ SYS MAP HL AUDIT QUERY to select the report type
+1 DO FULL^VALM1
+2 NEW LRTYPE
+3 SET LRTYPE=$$TYPESEL()
+4 ;
+5 ;Reset screen display
+6 IF LRTYPE'=-1
Begin DoDot:1
+7 if LRTYPE="C"
DO INIT
+8 if LRTYPE="I"
DO INIT^LRJSML1
End DoDot:1
+9 IF LRTYPE=-1
DO MSG^LRJSML
SET VALMBCK="R"
+10 QUIT
+11 ;
INIT ;* init variables and list array
+1 NEW LRFROM,LRTO
+2 KILL ^TMP($JOB,"LRJ SYS"),^TMP("LRJ SYS USER MANAGER - DATES",$JOB)
+3 KILL ^TMP("LRJ SYS USER MANAGER - INIT",$JOB)
+4 DO IOXY^XGF(IOSL-1,53)
+5 WRITE "[Extract Locations..."
+6 DO CREATRPT(.LRFROM,.LRTO,"^TMP($J,""LRJ SYS"")")
+7 IF (+$GET(LRFROM)'>0)!(+$GET(LRTO)'>0)
Begin DoDot:1
+8 SET VALMBCK="R"
+9 SET VALMBG=1
End DoDot:1
+10 IF (+$GET(LRFROM)>0)
IF (+$GET(LRTO)>0)
Begin DoDot:1
+11 DO CLEAR(LRFROM,LRTO,"^TMP($J,""LRJ SYS"")")
+12 DO HDR^LRJSML
+13 DO MSG^LRJSML
End DoDot:1
+14 QUIT
+15 ;
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 SET ^TMP("LRJ SYS USER MANAGER - INIT",$JOB)=0
+10 DO HDR^LRJSML
+11 DO MSG^LRJSML
+12 ;
+13 ;Call Report API
+14 DO BLDREC^LRJSMLA(LRFROM,LRTO,LRHLARY)
+15 ;
+16 QUIT
+17 ;
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 ;
CLEAR(LRFROM,LRTO,LRHLARY) ;* clean up entries
+1 DO REFRESH(LRFROM,LRTO,LRHLARY)
+2 QUIT
+3 ;
REFRESH(LRFROM,LRTO,LRHLARY) ;* refresh display
+1 DO BUILD(LRFROM,LRTO,LRHLARY)
+2 DO MSG^LRJSML
+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
+11 DO KILL^VALM10()
+12 SET VALMCNT=0
+13 SET LRX=" VistA Hospital Location changes"_$SELECT($DATA(LRFROM):" from "_LRFROM,1:"")_$SELECT($DATA(LRTO):" to "_LRTO,1:"")
+14 DO ADD^LRJSMLU(.VALMCNT,LRX)
+15 DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX)-1,IOUON,IOUOFF_IOINORM)
+16 ;
+17 DO KILL
+18 SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO
+19 DO LISTHL^LRJSML(LRFROM,LRTO,LRHLARY)
+20 ;
+21 ;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If add function to send HL MFN message, see if can check link here.
+22 QUIT
+23 ;
KILL ; -- kill off display data array
+1 KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
+2 QUIT
+3 ;
TYPESEL() ;Select type of report
+1 ;OUTPUT
+2 ; LRJRSLT : "I" - Initialization Extract
+3 ; : "C" - Change Audit Extract
+4 ; : "P" - Inactive Location Extract
+5 ; : -1 - Abort
+6 NEW LRJRSLT
+7 SET LRJRSLT=-1
+8 NEW DIR
+9 SET DIR("A")=" Enter Extract Report Type"
+10 SET DIR(0)="SO^I:Initialization Rpt;C:Location Change Rpt"
+11 SET DIR("?")="^D PROHELP^LRJSML4"
+12 SET DIR("L",1)=" Select one of the following:"
+13 SET DIR("L",2)=" I : Initialization/Current Location Report"
+14 SET DIR("L")=" C : Location Change Report"
+15 DO ^DIR
+16 if "ICP"[Y
SET LRJRSLT=Y
+17 if ($DATA(DTOUT)!$DATA(DUOUT)!(Y=""))
SET LRJRSLT=-1
+18 if "ICP"'[Y
SET LRJRSLT=-1
+19 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+20 QUIT LRJRSLT
+21 ;
PROHELP ;Help with type of report prompt
+1 WRITE !,"Enter 'I' to extract all currently active locations."
+2 WRITE !,"Enter 'C' to extract the location changes for a selected date range."
+3 QUIT
