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

LRJSML8.m

Go to the documentation of this file. 
  1. LRJSML8 ;ALB/GTS - Lab Vista Hospital Location Utilities;04/23/2012 09:05
  1.  ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
  1.  ;
  1.  ;
  1. LISTHLMM(LRHLARY) ; Store Hospital Locations in display array
  1.  ; INPUT -
  1.  ;   LRHLARY - Array of raw extract data
  1.  ;
  1.  NEW LRFROM,LRTO,LRINIT
  1.  SET LRINIT=$$INITCK^LRJSML1()
  1.  IF LRINIT SET (LRFROM,LRTO)=""
  1.  IF 'LRINIT DO SETRNG^LRJSML1(.LRFROM,.LRTO)
  1.  DO KILL^VALM10()
  1.  DO CRTRPTAR(LRHLARY,LRFROM,LRTO,"DISPLAY","")
  1.  QUIT
  1.  ;
  1. CRTRPTAR(LRHLARY,LRFROM,LRTO,LROUTPT,LRMMARY) ; Store Hospital Locations in display array
  1.  ; INPUT -
  1.  ;   LRHLARY - Raw extract data Array
  1.  ;   LRFROM  - Report Start date
  1.  ;   LRTO    - Report End date
  1.  ;   LROUTPT - "DISPLAY" - Listman; "MAIL" - mail message
  1.  ;   LRMMARY - Mail msg output array
  1.  ;
  1.  NEW X,LRXN,LRXP,NODE,LRLOC,LRRM,LROBED,LRHD,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED
  1.  NEW LRFSTLNE,LRPARAM,LRLNCTN,LRLNCNT,LRVALST,LRNEWLOC,LRINIT,LRNOTCHG
  1.  SET:$G(LRMMARY)="" LRMMARY=""
  1.  SET:$G(LROUTPT)="" LROUTPT="DISPLAY"
  1.  SET LRINIT=$$INITCK^LRJSML1()
  1.  SET LRNOTCHG=(LRINIT)
  1.  SET LRFSTLNE=0
  1.  SET LRNEWLOC=1
  1.  SET (LRLOC,LRRM,LROBED,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED)=""
  1.  SET:('LRNOTCHG) LRHD="NEW LOCATION"
  1.  SET:(LRNOTCHG) LRHD="CURRENT LOCATION"
  1.  SET X=$$XSET(LRINIT,LRFROM,LRTO)
  1.  ;
  1.  I LROUTPT="MAIL" DO
  1.  .S LRLNCNT=0
  1.  .D LRADDNOD^LRJSML3(.LRLNCNT,X,"",LROUTPT,LRMMARY)
  1.  I LROUTPT="DISPLAY" DO
  1.  .S VALMCNT=0
  1.  .D LRADDNOD^LRJSML3(.VALMCNT,X,"",LROUTPT,LRMMARY)
  1.  .D CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM)
  1.  ;
  1.  ;Loop extract array
  1.  S NODE=0
  1.  F  S NODE=$ORDER(@LRHLARY@(NODE)) Q:NODE=""  DO
  1.  .S LRXN=@LRHLARY@(NODE)
  1.  .;
  1.  .;New Location
  1.  .I $P(LRXN,"^",1)'["CURRENT",$P(LRXN,"^",1)'["PREVIOUS" DO 
  1.  ..;
  1.  ..;Set Paramater array (New)
  1.  ..S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
  1.  ..D SETNPARM^LRJSML3(LRVALST,.LRPARAM)
  1.  ..S LRPARAM("XN")=LRXN
  1.  ..S LRPARAM("LRLOC")=LRLOC
  1.  ..;;
  1.  ..D:LROUTPT="DISPLAY" MMDISPN^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
  1.  ..D:LROUTPT="MAIL" MMDISPN^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY)
  1.  ..;
  1.  ..;Reset array params
  1.  ..S LRLOC=LRPARAM("LRLOC")
  1.  ..S LRRM=LRPARAM("LRRM")
  1.  ..S LROBED=LRPARAM("LROBED")
  1.  ..S LRHD=LRPARAM("LRHD")
  1.  ..S LRFSTLNE=LRPARAM("LRFSTLNE")
  1.  .;
  1.  .;Edited location
  1.  .I $P(LRXN,"^",1)["CURRENT" DO
  1.  ..;
  1.  ..;Output last New rec
  1.  ..I LRLOC'="" DO
  1.  ...;
  1.  ...;Set Param array (New)
  1.  ...S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
  1.  ...D SETNPARM^LRJSML3(LRVALST,.LRPARAM)
  1.  ...S LRPARAM("LRLOC")=LRLOC
  1.  ...;;
  1.  ...D:LROUTPT="DISPLAY" LRNEWOUT^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC
  1.  ...D:LROUTPT="MAIL" LRNEWOUT^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC
  1.  ...;
  1.  ...;Reset array param
  1.  ...S LRLOC=LRPARAM("LRLOC")
  1.  ...S LRRM=LRPARAM("LRRM")
  1.  ...S LROBED=LRPARAM("LROBED")
  1.  ...S LRHD=LRPARAM("LRHD")
  1.  ...S LRFSTLNE=LRPARAM("LRFSTLNE")
  1.  ..S LRLOC=""
  1.  ..S NODE=NODE+1
  1.  ..S LRXP=@LRHLARY@(NODE)
  1.  ..;
  1.  ..;Set Param array (Edited)
  1.  ..S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRNOTCHG
  1.  ..D SETEPARM^LRJSML3(LRVALST,.LRPARAM)
  1.  ..;
  1.  ..I $P(LRXN,"^",2)="LOCATION" DO
  1.  ...S LRCLOC="^^"_$P(LRXN,"^",3,11)
  1.  ...S LRPLOC="^^"_$P(LRXP,"^",3,11)
  1.  ..S LRPARAM("XN")=LRXN
  1.  ..S LRPARAM("XP")=LRXP
  1.  ..S LRPARAM("LRCLOC")=LRCLOC
  1.  ..S LRPARAM("LRPLOC")=LRPLOC
  1.  ..S LRPARAM("LRNEWLOC")=LRNEWLOC
  1.  ..;;
  1.  ..D:LROUTPT="DISPLAY" MMDISPC^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
  1.  ..D:LROUTPT="MAIL" MMDISPC^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY)
  1.  ..;
  1.  ..;Reset array param
  1.  ..S LRCLOC=LRPARAM("LRCLOC")
  1.  ..S LRCRM=LRPARAM("LRCRM")
  1.  ..S LRCBED=LRPARAM("LRCBED")
  1.  ..S LRPLOC=LRPARAM("LRPLOC")
  1.  ..S LRPRM=LRPARAM("LRPRM")
  1.  ..S LRPBED=LRPARAM("LRPBED")
  1.  ..S LRFSTLNE=LRPARAM("LRFSTLNE")
  1.  ..S LRNEWLOC=LRPARAM("LRNEWLOC")
  1.  I LRLOC'="" DO
  1.  .;
  1.  .;Set Param array (New)
  1.  .S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG
  1.  .D SETNPARM^LRJSML3(LRVALST,.LRPARAM)
  1.  .S LRPARAM("LRLOC")=LRLOC
  1.  .;;
  1.  .D:LROUTPT="DISPLAY" LRNEWOUT^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC
  1.  .D:LROUTPT="MAIL" LRNEWOUT^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC
  1.  .;
  1.  .;Reset array params
  1.  .S LRLOC=LRPARAM("LRLOC")
  1.  .S LRRM=LRPARAM("LRRM")
  1.  .S LROBED=LRPARAM("LROBED")
  1.  .S LRHD=LRPARAM("LRHD")
  1.  .S LRFSTLNE=LRPARAM("LRFSTLNE")
  1.  ;
  1.  QUIT
  1.  ;
  1. XSET(LRINIT,LRFROM,LRTO) ;Set report description (first line listed)
  1.  ;INPUT:
  1.  ; LRINIT  -
  1.  ;           1 : Init extract
  1.  ;           0 : Not Init extract [Default]
  1.  ; LRFROM  - Report Beginning date (Passed by Ref)
  1.  ; LRTO    - Report Ending date (Passed by Ref)
  1.  ;
  1.  NEW LRX
  1.  SET:('LRINIT) LRX=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"")
  1.  IF +$G(LRINIT)>0 DO
  1.  .SET LRX=" VistA Hospital Location Configurations on "_$$FMTE^XLFDT($P($G(^TMP($J,"LRJ SYS",1)),"^",11))
  1.  QUIT LRX
  1.  ;
  1. GETDATE(LRFROM,LRTO) ;Return Report dates from ^TMP("LRJ SYS MAP HL MANAGER",$JOB)
  1.  ;INPUT:
  1.  ; LRFROM - Report Beginning date (Passed by Ref)
  1.  ; LRTO   - Report Ending date (Passed by Ref)
  1.  ; 
  1.  ;OUTPUT (Passed by Ref):
  1.  ; LRFROM - Report Beginning date
  1.  ; LRTO   - Report Ending date
  1.  ; 
  1.  S LRFROM=$P(^TMP("LRJ SYS MAP HL INIT MGR",$JOB,1,0),"Hospital Location changes",2)
  1.  S LRFROM=$P(LRFROM," from ",2)
  1.  S LRFROM=$P(LRFROM," to ",1)
  1.  S LRTO=$P(^TMP("LRJ SYS MAP HL INIT MGR",$JOB,1,0)," to ",2)
  1.  Q
  1.  ;
  1. SNDMSG(LRMSUBJ,XQSND,LRMSGARY,LRTASK) ;Send HL changes to requestor
  1.  ;INPUT:
  1.  ;  LRMSUBJ  - Subject of msg generated 
  1.  ;  XQSND    - User's DUZ, Group Name, or S.server name
  1.  ;  LRMSGARY - Array containing msg text
  1.  ;  LRTASK   - If defined, indicates called from TASKMAN job
  1.  ;  
  1.  N LRINSTMM,LRTASKMM,LRTOMM,XMERR,XMZ,LRLPCNT,LRTYPE
  1.  ;
  1.  S:'$D(LRTASK) LRTASK=0
  1.  I 'LRTASK DO
  1.  . K XMERR
  1.  . S LRINSTMM("ADDR FLAGS")="R"  ;Do not Restrict addressing
  1.  . S LRTYPE="S"
  1.  . D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
  1.  . S LRLPCNT=""
  1.  . F  S LRLPCNT=$O(^TMP("XMY",$J,LRLPCNT)) Q:LRLPCNT=""  S LRTOMM(LRLPCNT)=""
  1.  ;
  1.  I +$G(XMERR)'>0 DO
  1.  . S LRTOMM(XQSND)=""
  1.  . S LRTOMM("G.LRJ SYS MAP HL TASK REPORT")=""
  1.  . S LRINSTMM("FROM")="LAB_HLCSM_USER_ACTION"
  1.  . S LRMSUBJ=$E(LRMSUBJ,1,65)
  1.  . D SENDMSG^XMXAPI(XQSND,LRMSUBJ,LRMSGARY,.LRTOMM,.LRINSTMM,.LRTASKMM)
  1.  ;
  1.  K @LRMSGARY,^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG")
  1.  Q
  1.  ;
  1. SNDEXT(LRMSUBJ,XQSND,LREXTARY) ;Send HL changes Extract to requester
  1.  ;INPUT:
  1.  ;  LRMSUBJ  - Subject of message generated 
  1.  ;  XQSND    - User's DUZ, Group Name, or S.server name
  1.  ;  LREXTARY - Array containing msg text
  1.  ;  
  1.  N LRINSTMM,LRINSTVA,LRTASKMM,LRTASKVA,LRTOMM,LRTOVA,XMERR,XMZ,LRLPCNT,LRTYPE
  1.  ;
  1.  S LRINSTMM("ADDR FLAGS")="R"  ;Do not Restrict addressing
  1.  S LRTYPE="S"
  1.  K XMERR
  1.  D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM)
  1.  ;
  1.  ;Check Network addresses and mail attachmt
  1.  S LRINSTVA("ADDR FLAGS")="R"  ;Do not Restrict addressing
  1.  S LRINSTVA("FROM")="LAB_HLCSM_USER_ACTION"
  1.  S LRMSUBJ=$E(LRMSUBJ,1,65)
  1.  S LRLPCNT=""
  1.  F  S LRLPCNT=$O(^TMP("XMY",$J,LRLPCNT)) Q:LRLPCNT=""  S LRTOVA(LRLPCNT)=""
  1.  ;
  1.  I +$G(XMERR)'>0 DO
  1.  .W !,"                                        [Creating attachments..."
  1.  .D OUTLKARY(LREXTARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ,1)
  1.  .D SENDMSG^XMXAPI(XQSND,LRMSUBJ,"^TMP($J,""LRNETMSG"")",.LRTOVA,.LRINSTVA,.LRTASKVA)
  1.  ;
  1.  K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG")
  1.  Q
  1.  ;
  1. OUTLKARY(LRHLARY,LRHLOTLK,LRMSUBJ,LRRT) ;Create attachmts array
  1.  ;INPUT:
  1.  ;  LRHLARY  - Array containing raw message text
  1.  ;  LRHLOTLK - Array containing message text for network addresses
  1.  ;  LRMSUBJ  - Message subject
  1.  ;  LRRT     - Real Time processing from UI
  1.  ;
  1.  N LRFILNM1,LRFILNM2,LRDTTM,LRCRLF,LRSTR,LRNODE,LROUTNOD,LRNODATA,LRCHAR
  1.  S:+$G(LRRT)=0 LRRT=0
  1.  S:+$G(LRRT) LRCHAR=0
  1.  S LRSTR=""
  1.  S LRNODATA=0
  1.  S LRCRLF=$C(13,10)
  1.  K @LRHLOTLK
  1.  S @LRHLOTLK@(1)="Extract Message Generated......: "_$$FMTE^XLFDT($$NOW^XLFDT)_LRCRLF
  1.  S @LRHLOTLK@(2)=" "
  1.  S @LRHLOTLK@(3)="Extract Requested......: "_LRMSUBJ_LRCRLF
  1.  S @LRHLOTLK@(4)=" "
  1.  ;
  1.  S LRDTTM=$$NOW^XLFDT
  1.  S LRFILNM1="HLCSM_EXT_NEW_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".TXT"
  1.  S LRFILNM2="HLCSM_EXT_MOD_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".TXT"
  1.  S @LRHLOTLK@(5)="Attached LMOF NEW Hospital Locations file.....: "_LRFILNM1_LRCRLF
  1.  S @LRHLOTLK@(6)=" "
  1.  S @LRHLOTLK@(7)="Attached LMOF MODIFIED Hospital Locations file.....: "_LRFILNM2_LRCRLF
  1.  S:($O(@LRHLARY@(0))="") LRNODATA=1
  1.  S @LRHLOTLK@(8)=" "
  1.  S:(LRNODATA=0) @LRHLOTLK@(9)=" "
  1.  S:(LRNODATA=1) @LRHLOTLK@(9)="No data was extracted for date range!!"
  1.  ;
  1.  ;Begin NEW Hospital Locations file output
  1.  S @LRHLOTLK@(10)=$$UUBEGFN(LRFILNM1)
  1.  S LRNODE=0
  1.  S LROUTNOD=10
  1.  F  S LRNODE=$O(@LRHLARY@(LRNODE)) Q:(LRNODE="")  Q:($P($G(@LRHLARY@(LRNODE)),"^",1)="CURRENT")  DO
  1.  . I +$G(LRRT) D:LRNODE#100=0 HANGCHAR^LRJSMLU(.LRCHAR)
  1.  . S LRSTR=LRSTR_@LRHLARY@(LRNODE)_LRCRLF
  1.  . D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
  1.  ;
  1.  F  Q:$L(LRSTR<45)  D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
  1.  S:(LRSTR'="") @LRHLOTLK@(LROUTNOD+1)=$$UUEN^LRJSMLU(LRSTR)
  1.  S @LRHLOTLK@(LROUTNOD+2)=" "
  1.  S @LRHLOTLK@(LROUTNOD+3)="end"
  1.  ;
  1.  ;Begin MODIFIED Hospital Locations file output
  1.  S LRSTR=""
  1.  S LROUTNOD=LROUTNOD+4
  1.  S @LRHLOTLK@(LROUTNOD)=$$UUBEGFN(LRFILNM2)
  1.  I +LRNODE>0 DO
  1.  .S LRNODE=LRNODE-1
  1.  .F  S LRNODE=$O(@LRHLARY@(LRNODE)) Q:(LRNODE="")  DO
  1.  ..I +$G(LRRT) D:LRNODE#100=0 HANGCHAR^LRJSMLU(.LRCHAR)
  1.  ..S LRSTR=LRSTR_@LRHLARY@(LRNODE)_LRCRLF
  1.  ..D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
  1.  .;
  1.  .F  Q:$L(LRSTR<45)  D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK)
  1.  S:(LRSTR'="") @LRHLOTLK@(LROUTNOD+1)=$$UUEN^LRJSMLU(LRSTR)
  1.  S @LRHLOTLK@(LROUTNOD+2)=" "
  1.  S @LRHLOTLK@(LROUTNOD+3)="end"
  1.  Q
  1.  ;
  1. UUBEGFN(LRFILENM) ; Construct uuencode "begin" coding
  1.  ; Call with LRFILENM = name of uuencoded file attachmt
  1.  ; 
  1.  ; Returns LRX = string with "begin..."_file name
  1.  ;
  1.  N LRX
  1.  S LRX="begin 644 "_LRFILENM
  1.  Q LRX
  1.  ;
  1. ENCODE(LRSTR,LRDTANOD,LRHLOTLK) ;Encode a string, keep remainder for next line
  1.  ;INPUT:
  1.  ;  LRSTR     - String to send in msg; call by reference, Remainder returned in LRSTR
  1.  ;  LRDTANOD  - Number of next Node to store msg line in array
  1.  ;  LRHLOTLK  - Array containing msg text for network addresses
  1.  ;
  1.  N LRQUIT,LRLEN,LRX
  1.  S LRQUIT=0,LRLEN=$L(LRSTR)
  1.  F  D  Q:LRQUIT
  1.  . I $L(LRSTR)<45 S LRQUIT=1 Q
  1.  . S LRX=$E(LRSTR,1,45)
  1.  . S LRDTANOD=LRDTANOD+1,@LRHLOTLK@(LRDTANOD)=$$UUEN^LRJSMLU(LRX)
  1.  . S LRSTR=$E(LRSTR,46,LRLEN)
  1.  Q