Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRJSML

LRJSML.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. HDR ; -- header code
  1.  SET VALMHDR(1)="                    Lab Hospital Location Change Extract"
  1.  SET VALMHDR(2)="                         Version: "_$$VERNUM^LRJSMLU()_"     Build: "_$$BLDNUM^LRJSMLU()
  1.  Q
  1.  ;
  1. INIT ;* init variables and list array
  1.  N LRFROM,LRTO
  1.  D CREATRPT(.LRFROM,.LRTO,"^TMP($J,""LRJ SYS"")")
  1.  I (+$G(LRFROM)'>0)!(+$G(LRTO)'>0) DO
  1.  . S VALMBCK="Q"
  1.  . S VALMQUIT=1
  1.  I (+$G(LRFROM)>0),(+$G(LRTO)>0) DO
  1.  . D CLEAR(LRFROM,LRTO,"^TMP($J,""LRJ SYS"")")
  1.  . D MSG
  1.  QUIT
  1.  ;
  1. CLEAR(LRFROM,LRTO,LRHLARY) ;* clean up entries
  1.  DO REFRESH(LRFROM,LRTO,LRHLARY)
  1.  QUIT
  1.  ;
  1. MSG ; -- set default message
  1.  N LREND,LRBEGIN,LRAUTMSG
  1.  S LRBEGIN=$$GET^XPAR("SYS","LRJ HL LAST START DATE",1,"Q")
  1.  S LREND=$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q")
  1.  I (LRBEGIN'="")!(LREND'="") D 
  1.  .S LRAUTMSG="Task Rpt "_$S(LRBEGIN'="":$$FMTE^XLFDT(LRBEGIN),1:"undefined")_" - "_$S(LREND'="":$$FMTE^XLFDT(LREND),1:"undefined")
  1.  ;
  1.  I LRBEGIN="",LREND="" D 
  1.  .S LRAUTMSG="Tasked Report has not run!"
  1.  S VALMSG=LRAUTMSG
  1.  QUIT
  1.  ;
  1. REFRESH(LRFROM,LRTO,LRHLARY) ;* refresh display
  1.  DO BUILD(LRFROM,LRTO,LRHLARY)
  1.  D MSG
  1.  SET VALMBCK="R"
  1.  SET VALMBG=1
  1.  QUIT
  1.  ;
  1. BUILD(LRFROM,LRTO,LRHLARY) ; -- build display array
  1.  ;
  1.  ;INPUT
  1.  ; LRFROM  - Start report date (Optional)
  1.  ; LRTO    - End report date (Optional)
  1.  ; LRHLARY - Array of raw data extract (Required)
  1.  ;
  1.  QUIT:'$D(LRHLARY)  ;QUIT if LRHLARY is not defined)
  1.  ;
  1.  NEW LRSTATUS,LRJERRCT,LRX
  1.  DO KILL^VALM10()
  1.  SET VALMCNT=0
  1.  S LRX=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_LRFROM,1:"")_$S($D(LRTO):" to "_LRTO,1:"")
  1.  D ADD^LRJSMLU(.VALMCNT,LRX)
  1.  DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX)-1,IOUON,IOUOFF_IOINORM)
  1.  ;
  1.  D LISTHL(LRFROM,LRTO,LRHLARY)
  1.  ;
  1.  ;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK())  ;;If enhance send message HL MFN, see if can check link here.
  1.  Q
  1.  ;
  1. LISTHL(LRFROM,LRTO,LRHLARY) ; -- place Hospital Locations in the display array
  1.  NEW X,NODE
  1.  DO KILL^VALM10()
  1.  SET VALMCNT=0
  1.  SET X=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
  1.  DO ADD^LRJSMLU(.VALMCNT,X)
  1.  DO CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM)
  1.  D ADD^LRJSMLU(.VALMCNT," ")
  1.  SET NODE=0
  1.  FOR  SET NODE=$ORDER(@LRHLARY@(NODE)) QUIT:NODE=""  DO
  1.  . SET X=@LRHLARY@(NODE)
  1.  . DO BREAK(.VALMCNT,X,NODE)
  1.  QUIT
  1.  ;
  1. BREAK(VALMCNT,X,NODE) ; -- break into 79/80 char chunks for display
  1.  NEW LAOUT,LAX,SUBNODE,C
  1.  SET C="" ; -- continuation character
  1.  SET LAX=NODE_" : "_X
  1.  DO ADD^LRJSMLU(.VALMCNT,C_$EXTRACT(LAX,1,80))
  1.  SET C="+"
  1.  SET LAOUT=$EXTRACT(LAX,81,159)
  1.  IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
  1.  SET LAOUT=$EXTRACT(LAX,160,239)
  1.  IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
  1.  SET LAOUT=$EXTRACT(LAX,240,255)
  1.  IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT)
  1.  QUIT
  1.  ;
  1.  ;
  1. CREATRPT(LRFROM,LRTO,LRHLARY) ;Create array of HL changes between selected dates
  1.  N DIR
  1.  ;
  1.  W !!,"  Enter Hospital Location Extract Date Range...",!
  1.  ;
  1.  S LRFROM=$$DATEENT("Select Start date: ",,"-NOW")
  1.  Q:+LRFROM<1
  1.  S LRTO=$$DATEENT("  Select End date: ",LRFROM,"-NOW")
  1.  Q:+LRTO<1
  1.  D MSG
  1.  ;
  1.  ;Call Report API
  1.  D BLDREC^LRJSMLA(LRFROM,LRTO,LRHLARY)
  1.  ;
  1.  Q
  1.  ;
  1. DATEENT(LRPRMPT,LRBD,LRED) ;Prompt for extract date
  1.  ;INPUT
  1.  ; LRPRMPT - Prompt displayed to user
  1.  ; LRBD    - Begin date of range
  1.  ; LRED    - End date of range
  1.  ;
  1.  ;RETURN
  1.  ; LRDT
  1.  ;  SUCCESS: FILEMAN INTERNALLY FORMATED DATE
  1.  ;  FAILURE: -1
  1.  ;
  1.  N LRDT,LRGOOD
  1.  S LRGOOD=0
  1.  S:+$G(LRED)>0 %DT(0)=LRED
  1.  S:$G(LRED)["NOW" %DT(0)=LRED
  1.  S %DT("A")=LRPRMPT
  1.  S %DT("B")="TODAY" ;Default for [Start] date entry
  1.  S %DT="AEPST"
  1.  D:LRPRMPT["Start" ^%DT ;Prompt for Start date
  1.  ;
  1.  ;Prompt for End date with conditions
  1.  I LRPRMPT["End" DO
  1.  . F  Q:LRGOOD  DO
  1.  . . S %DT("B")="NOW" ;Change default for End Date entry
  1.  . . D ^%DT
  1.  . . W:((Y<LRBD)&(X'="^")&('$D(DTOUT))) " ??",!,"   End date must follow Begin date!",!
  1.  . . S:((Y>LRBD)!(Y=LRBD)!($D(DTOUT))!(X="^")) LRGOOD=1
  1.  S LRDT=Y
  1.  K Y,%DT
  1.  Q LRDT
  1.  ;
  1. DISPEXT(LRHLARY) ;Display Raw HL changes extracted
  1.  ;
  1.  ; This API will change the ListMan display array to a raw extract format
  1.  ;INPUT
  1.  ; LRHLARY - Array of raw extract data.
  1.  ; 
  1.  NEW LRFROM,LRTO
  1.  D HDR
  1.  ;
  1.  ;Pull date range of extract from ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
  1.  D GETDATE^LRJSML8(.LRFROM,.LRTO)
  1.  IF (+LRFROM=0)!(+LRTO=0) DO
  1.  .SET LRFROM=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^")
  1.  .SET LRTO=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^",2)
  1.  SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO
  1.  KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB)
  1.  D REFRESH(LRFROM,LRTO,LRHLARY)
  1.  D MSG
  1.  S VALMBCK="R"
  1.  S VALMBG=1
  1.  Q
  1.  ;
  1. MMHDR ; -- header code for Mail Message display
  1.  SET VALMHDR(1)="                    Lab Hospital Location Change Message"
  1.  SET VALMHDR(2)="                         Version: "_$$VERNUM^LRJSMLU()_"     Build: "_$$BLDNUM^LRJSMLU()
  1.  Q