Routine: LRJSML4

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)

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.

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  Feb 18, 2025@23:41:35                                                                                                                                                                                                     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

LRJSML4.m