LRJSML3 ;ALB/GTS - Lab Vista Hospital Location Utilities - 2;02/17/2010 09:42:19
;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
;
;
SETNPARM(LRVALST,LRPARAM) ;Set New Params
S LRPARAM("LRRM")=$P(LRVALST,"^",2)
S LRPARAM("LROBED")=$P(LRVALST,"^",3)
S LRPARAM("LRHD")=$P(LRVALST,"^",4)
S LRPARAM("LRFSTLNE")=$P(LRVALST,"^",5)
S LRPARAM("LRINIT")=$P(LRVALST,"^",6)
QUIT
;
SETEPARM(LRVALST,LRPARAM) ;Set Edited Params
S LRPARAM("LRCRM")=$P(LRVALST,"^",2)
S LRPARAM("LRCBED")=$P(LRVALST,"^",3)
S LRPARAM("LRPRM")=$P(LRVALST,"^",5)
S LRPARAM("LRPBED")=$P(LRVALST,"^",6)
S LRPARAM("LRFSTLNE")=$P(LRVALST,"^",7)
S LRPARAM("LRINIT")=$P(LRVALST,"^",8)
QUIT
;
MMDISPN(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Break into 79/80 char chunks for Cur Val display
; VALMCNT - Cur output array line number
; LRPARAM - Array with parameters passed
; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message
; LRMMARY - Mail message output array (Optional)
;
;Array params sent & received (LRPARAM)
; XN - NEW HL extract data
; LEGEND:
; NEW^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
; ^Reactivation Date^Accessed by^Chng Date/Time
;
; NEW^ROOM^Hosp Loc Name^Type^Inst^Div^Room
; NEW^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed
; LRLOC - Cur Hosp Loc header Info
; LRRM - Cur Hosp Loc Room Info
; LROBED - Cur Hosp Loc Bed Info
; LRHD - Header (Location or Room) to display
; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed
; LRINIT - Init extract or Change extract (1: Initialization; 0: Change)
;
N LRIEN,LRDTTYP,LRVALST,LRINIT
N LRXN,LRLOC,LRRM,LROBED,LRHD,LRFSTLNE
N LRLOCVAR,LRSUB,LPCNT,LRROOT
;
S:$G(LRMMARY)="" LRMMARY=""
S:$G(LROUTPT)="" LROUTPT="DISPLAY"
;
;Put Array params in local vars
S LRXN=LRPARAM("XN")
;
S LRLOCVAR="LRLOC^LRRM^LROBED^LRHD^LRFSTLNE^LRINIT"
S LRROOT="LRPARAM"
F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB)
;
S LRDTTYP=$P(LRXN,"^",2) ;Type of data node (LOCATION, ROOM or BED)
I LRDTTYP="LOCATION" DO
.I LRLOC'="" DO
..D LRNEWOUT(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
..;
..;Set Array params
..S LRRM=LRPARAM("LRRM")
..S LROBED=LRPARAM("LROBED")
..S LRHD=LRPARAM("LRHD")
..S LRPARAM("LRFSTLNE")=LRFSTLNE
.S:'LRINIT LRHD="CHANGE DETAIL (NEW)"
.S:LRINIT LRHD="CURRENT DEFINITION"
.S LRLOC="^^"_$P(LRXN,"^",3,11)
;
I LRDTTYP="ROOM" DO
.I LRRM'="" DO
..;
..;Reset Array params
..S LRPARAM("LRFSTLNE")=LRFSTLNE
..D LRNEWOUT(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
..;
..;Set Array params
..S LRRM=LRPARAM("LRRM")
..S LROBED=LRPARAM("LROBED")
..S LRHD=LRPARAM("LRHD")
..S LRFSTLNE=LRPARAM("LRFSTLNE")
.S:'LRINIT LRHD="CHANGE DETAIL (NEW)"
.S:LRINIT LRHD="CURRENT DEFINITION"
.S LRRM=$P(LRXN,"^",8)
;
I LRDTTYP="BED" S:LROBED'="" LROBED=LROBED_" ; "_$P(LRXN,"^",9) S:LROBED="" LROBED=$P(LRXN,"^",9)
;
;Reset Array params
S LRPARAM("LRLOC")=LRLOC
S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRINIT
D SETNPARM(LRVALST,.LRPARAM)
Q
;
LRNEWOUT(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Output New location
;INPUT PARAMS:
; VALMCNT - Cur Line number of output array
; LRPARAM - Array with params passed
; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail message
; LRMMARY - Mail message output array (Optional)
;
;Array params sent & received (LRPARAM)
; LRLOC - Cur Hosp Loc Info
; LRRM - Cur Hosp Loc Room Info
; LROBED - Cur Hosp Loc Bed Info
; LRHD - Header Info
; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed
; LRINIT - Init extract or Change extract (1: Initialization; 0: Change)
;
N LRLOCVAR,LRROOT,LPCNT,LRSUB
N LAX,LRIEN,LRNNAME,LRTYPE,LRINST,LRDIV,LRINACT,LRREACT,LRUSR,LRDTCG
N LRLOC,LRRM,LROBED,LRHD,LRFSTLNE,LRVALST,LRINIT
;
;Put Array params in local vars
S LRLOCVAR="LRLOC^LRRM^LROBED^LRHD^LRFSTLNE^LRINIT"
S LRROOT="LRPARAM"
F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB)
;
;Set variables passed in LRPARAM("LRLOC")
S LRIEN=$P(LRLOC,"^",3)
S LRNNAME=$P(LRLOC,"^",4)
S LRTYPE=$P(LRLOC,"^",5)
S LRINST=$P(LRLOC,"^",6)
S LRDIV=$P(LRLOC,"^",7)
S LRINACT=$P(LRLOC,"^",8)
S LRREACT=$P(LRLOC,"^",9)
S LRUSR=$P(LRLOC,"^",10)
S LRDTCG=$P(LRLOC,"^",11)
;
D:+LRFSTLNE>0 LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
D:LROUTPT="MAIL" LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
D LRADDNOD(.VALMCNT," "_LRHD,"",LROUTPT,LRMMARY)
IF LROUTPT="DISPLAY" DO
.DO CNTRL^VALM10(VALMCNT,8,$LENGTH(LRHD),IOUON,IOUOFF_IOINORM)
;
;Output Location info
S LAX=" IEN: "_LRIEN
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM)
S LAX=" NAME: "_LRNNAME
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
S LAX=" TYPE: "_LRTYPE
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
S LAX=" INST: "_LRINST
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
S LAX=" DIV: "_LRDIV
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM)
S LAX="INACT: "_$$FMTE^XLFDT(LRINACT)
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM)
S LAX=" ACT: "_$$FMTE^XLFDT(LRREACT)
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM)
;
;Output edit info
S:LRINIT LAX=" "
S:'LRINIT LAX=" CHANGED BY: "_LRUSR
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
IF LROUTPT="DISPLAY",'LRINIT D CNTRL^VALM10(VALMCNT,10,11,IOINHI,IOINORM)
IF 'LRINIT DO
.S LAX=" DATE/TIME OF CHANGE: "_$$FMTE^XLFDT(LRDTCG)
.D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
.D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,20,IOINHI,IOINORM)
;
;Output Room/Bed info
D LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
S LAX=" ROOM: "_LRRM
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
S LAX=" BEDS: "_LROBED
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
D:LROUTPT="MAIL" LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
;
IF LRINIT DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
;
S (LRRM,LROBED,LRHD)=""
S LRFSTLNE=1
;
;Reset Param array
S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRINIT
D SETNPARM(LRVALST,.LRPARAM)
S LRPARAM("LRLOC")=LRLOC
Q
;
MMDISPC(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Break into 79/80 char chunks for Cur Val display
;
;Input params
; VALMCNT - Cur Line number of output array
; LRPARAM - Array with parameters passed
; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message
; LRMMARY - Mail message output array (Optional)
;
;Array params sent & received (LRPARAM)
; XN - CURRENT HL extract data
; LEGEND:
; CURRENT^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
; ^Reactivation Date^Accessed by^Chng Date/Time
;
; CURRENT^ROOM^Hosp Loc Name^Type^Inst^Div^Room
; CURRENT^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed
;
; XP - PREVIOUS HL extract data
; LEGEND:
; PREVIOUS^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
; ^Reactivation Date^Accessed by^Chng Date/Time
;
; PREVIOUS^ROOM^Hosp Loc Name^Type^Inst^Div^Room
; PREVIOUS^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed
;
; LRCLOC - Cur Hosp Loc info
; LRCRM - Cur Hosp Loc Room info
; LRCBED - Cur Hosp Loc Bed info
; LRPLOC - Prev Hosp Loc info
; LRPRM - Prev Hosp Loc Room info
; LRPBED - Prev Hosp Loc Bed info
; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed
; LRNEWLOC- Value 1 = the location not printed
; LRINIT - Init extract or Change extract (1: Initialization; 0: Change)
;
;
N LRDTTYP,LRVALST,LRNEWLOC,LRINIT
N LRXC,LRXP,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE,LRCHGARY
N LRLOCVAR,LRSUB,LPCNT,LRROOT
;
S:$G(LRMMARY)="" LRMMARY=""
S:$G(LROUTPT)="" LROUTPT="DISPLAY"
;
;Put Array params in local vars
S LRXC=LRPARAM("XN")
S LRXP=LRPARAM("XP")
;
S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT"
S LRROOT="LRPARAM"
F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB)
;
S LRDTTYP=$P(LRXC,"^",2) ;Data node type (LOCATION, ROOM or BED)
;
I LRDTTYP="LOCATION" DO
.I LRCLOC'="" DO
..;
..;Set array & Print
..S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
..D SETEPARM(LRVALST,.LRCHGARY)
..S LRCHGARY("LRNEWLOC")=LRNEWLOC
..S LRCHGARY("LRCLOC")=LRCLOC
..S LRCHGARY("LRPLOC")=LRPLOC
..;
..D LRLOUT(.VALMCNT,.LRCHGARY,LROUTPT,.LRPARAM,.LRVALST,LRMMARY)
..;
..;Put Array params (LRCHGARY) in local vars
..S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE"
..S LRROOT="LRCHGARY"
..F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB)
.;
.S LRNEWLOC=1
.S (LRCRM,LRCBED,LRPRM,LRPBED)=""
;
;If Room node exists, next node is Bed
I LRDTTYP="ROOM" DO
.I LRCBED="" DO
..S LRCRM=$P(LRXC,"^",8)
..S LRPRM=$P(LRXP,"^",8)
;
;ROOM/BED info output on BED node
I LRDTTYP="BED" DO
.S LRCRM=$P(LRXC,"^",8)
.S LRPRM=$P(LRXP,"^",8)
.S LRCBED=$P(LRXC,"^",9)
.S LRPBED=$P(LRXP,"^",9)
.;
.;Set array & Print
.S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
.D SETEPARM(LRVALST,.LRCHGARY)
.S LRCHGARY("LRNEWLOC")=LRNEWLOC
.S LRCHGARY("LRCLOC")=LRCLOC
.S LRCHGARY("LRPLOC")=LRPLOC
.;
.D LRRBOUT(.VALMCNT,.LRCHGARY,LROUTPT,.LRPARAM,.LRVALST,LRMMARY)
.;
.;Put Array params (LRCHGARY) in local vars
.S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE"
.S LRROOT="LRCHGARY"
.F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB)
;
;Reset Array param
S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
D SETEPARM(LRVALST,.LRPARAM)
S LRPARAM("LRCLOC")=LRCLOC
S LRPARAM("LRPLOC")=LRPLOC
S LRPARAM("LRNEWLOC")=LRNEWLOC
Q
;
LRLOUT(VALMCNT,LRCHGARY,LROUTPT,LRPARAM,LRVALST,LRMMARY) ; Output Loc
;INPUT:
; VALMCNT - Cur Line number of output array
; LRCHGARY- Array of param passed by ref
; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail message
; LRPARAM - Array with parameters passed
; LRVALST - Carat delimited list of location data
; LRMMARY - Mail message output array (Optional)
;
;Array Parameters sent and received (LRCHGARY)
; LRCLOC - CURRENT HL extract data
; LRPLOC - PREVIOUS Hosp Loc Data
; LEGEND (LRCLOC & LRPLOC):
; ^^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
; ^Reactivation Date^Accessed by^Chng Date/Time
;
; LRCRM - Cur Hosp Loc Room Info
; LRCBED - Cur Hosp Loc Bed Info
; LRPRM - Prev Hosp Loc Room Info
; LRPBED - Prev Hosp Loc Bed Info
; LRFSTLNE- Value 1 - 1st line printed, 0 - 1st line hasn't printed
; LRNEWLOC- Value 1 = the location has not been printed
; LRINIT - Init extract ; Change extract (1: Init; 0: Change)
;
N LAX,C,LRIEN,LRNNAME,LRTYPE,LRINST,LRDIV,LRINACT
N LRONAME,LROTYPE,LROINST,LRODIV,LROINACT,LROREACT,LRODTOUT,LRNEWLOC
N LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE,LRDTCG,LRUSR,LRINIT,LRREACT
N LRLOCVAR,LRSUB,LPCNT,LRROOT
;
;Put Array params (LRCHGARY) in local vars
S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT"
S LRROOT="LRCHGARY"
F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB)
;
S C="" ;-- Continue char
D:+LRFSTLNE>0 LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
D:LROUTPT="MAIL" LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
D LRADDNOD(.VALMCNT," CHANGE DETAIL (CURRENT) CHANGE DETAIL (PREVIOUS)","",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,8,$LENGTH("CHANGE DETAIL (CURRENT)"),IOUON,IOUOFF_IOINORM)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,46,$LENGTH("CHANGE DETAIL (PREVIOUS)"),IOUON,IOUOFF_IOINORM)
;
;Set new Current values passed in LRCHGARY("LRCLOC")
S LRIEN=$P(LRCLOC,"^",3)
S LRNNAME=$P(LRCLOC,"^",4)
S LRTYPE=$P(LRCLOC,"^",5)
S LRINST=$P(LRCLOC,"^",6)
S LRDIV=$P(LRCLOC,"^",7)
S LRINACT=$P(LRCLOC,"^",8)
S LRREACT=$P(LRCLOC,"^",9)
S LRUSR=$P(LRCLOC,"^",10)
S LRDTCG=$P(LRCLOC,"^",11)
;
;Set Previous values passed in LRCHGARY("LRPLOC")
S LRONAME=$P(LRPLOC,"^",4)
S LROTYPE=$P(LRPLOC,"^",5)
S LROINST=$P(LRPLOC,"^",6)
S LRODIV=$P(LRPLOC,"^",7)
S LROINACT=$P(LRPLOC,"^",8)
S LROREACT=$P(LRPLOC,"^",9)
;
S LAX=" IEN: "_LRIEN
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM)
;
S LAX=" NAME: "_LRNNAME
D LRADDNOD(.VALMCNT,LAX,LRONAME,LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
;
S LAX=" TYPE: "_LRTYPE
D LRADDNOD(.VALMCNT,LAX,LROTYPE,LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
;
S LAX=" INST: "_LRINST
D LRADDNOD(.VALMCNT,LAX,LROINST,LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
;
S LAX=" DIV: "_LRDIV
D LRADDNOD(.VALMCNT,LAX,LRODIV,LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,5,IOINHI,IOINORM)
;
S LAX="INACT: "_$$FMTE^XLFDT(LRINACT)
S LRODTOUT=$$FMTE^XLFDT(LROINACT)
D LRADDNOD(.VALMCNT,LAX,LRODTOUT,LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM)
;
S LAX=" ACT: "_$$FMTE^XLFDT(LRREACT)
S LRODTOUT=$$FMTE^XLFDT(LROREACT)
D LRADDNOD(.VALMCNT,LAX,LRODTOUT,LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM)
;
;Output edit info
S:LRINIT LAX=" "
S:'LRINIT LAX=" CHANGED BY: "_LRUSR
D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,10,11,IOINHI,IOINORM)
;
IF 'LRINIT DO
.S LAX=" DATE/TIME OF CHANGE: "_$$FMTE^XLFDT(LRDTCG)
.D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
.D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,20,IOINHI,IOINORM)
;
D LRADDNOD(.VALMCNT,"","",LROUTPT,LRMMARY)
S LRNEWLOC=0
;
;Reset Parameter Array
S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
D SETEPARM(LRVALST,.LRPARAM)
S LRPARAM("LRCLOC")=LRCLOC
S LRPARAM("LRPLOC")=LRPLOC
Q
;
LRRBOUT(VALMCNT,LRCHGARY,LROUTPT,LRPARAM,LRVALST,LRMMARY) ;Output Room/Bed
;INPUT:
; VALMCNT - Cur Line number of output array
; LRCHGARY- Array of parameters passed by reference
; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message
; LRPARAM - Array with parameters passed
; LRVALST - Carat delimited list of location data
; LRMMARY - Mail message output array (Optional)
;
;Array Params (LRCHGARY) sent and received
; LRCLOC - CURRENT HL extract data
; LRPLOC - PREVIOUS Hosp Loc data
; LEGEND (LRCLOC & LRPLOC):
; ^^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
; ^Reactivation Date^Accessed by^Chng Date/Time
;
; LRCRM - Cur Hosp Loc Room Info
; LRCBED - Cur Hosp Loc Bed Info
; LRPRM - Prev Hosp Loc Room Info
; LRPBED - Prev Hosp Loc Bed Info
; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed
; LRNEWLOC- Value 1 = the location has not been printed
; LRINIT - Init extract or Change extract (1: Initialization; 0: Change)
;
N LAX,C,LRNEWLOC,LRINIT
N LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE
N LRLOCVAR,LRSUB,LPCNT,LRROOT
;
;Put Array params (LRCHGARY) in local vars
S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT"
S LRROOT="LRCHGARY"
F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB)
;
S C="" ;-- Continue char
;Output Room/Bed changes
S LAX=" ROOM: "_LRCRM
D LRADDNOD(.VALMCNT,LAX,LRPRM,LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
;
S LAX=" BEDS: "_LRCBED
D LRADDNOD(.VALMCNT,LAX,LRPBED,LROUTPT,LRMMARY)
D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
D:LROUTPT="MAIL" LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
;
I LRINIT D LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
;
;Reset Parameter Array
S (LRCBED,LRPBED)=""
S LRFSTLNE=1
;
S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
D SETEPARM(LRVALST,.LRPARAM)
S LRPARAM("LRCLOC")=LRCLOC
S LRPARAM("LRPLOC")=LRPLOC
Q
;
LRADDNOD(LRNODECT,LRCUR,LRPREV,LROUTPT,LRMMARY) ;Include Prev value in string, add to mail array
; INPUT:
; LRNODECT - Node number
; LRCUR - Cur entry display
; LRPREV - Prev entry display
; LROUTPT - Type of array to populate (Display or Mail)
; LRMMARY - Array of output for Mail messages
;
; OUTPUT:
; Display array
;
N LRLGTH
S:$G(LRPREV)="" LRPREV=""
S:$G(LROUTPT)="" LROUTPT="DISPLAY"
S:$G(LRMMARY)="" LRMMARY=""
S LRLGTH=$L(LRCUR)
S LRCUR=LRCUR_$J(LRPREV,3+$L(LRPREV)+(42-LRLGTH))
D:LROUTPT="DISPLAY" ADD^LRJSMLU(.LRNODECT,LRCUR)
D:LROUTPT="MAIL" LRADDLNE(.LRNODECT,LRCUR,LRMMARY)
Q
;
LRADDLNE(LRNODECT,MSG,LRMMARY) ; -- add line to build display
;INPUT:
; LRNODECT - Node number
; MSG - Text to mail
; LRMMARY - Array for MailMan call
;
;OUTPUT:
; Array for Mail message
;
S LRNODECT=LRNODECT+1
S @LRMMARY@(LRNODECT)=MSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRJSML3 17887 printed Oct 16, 2024@18:16:26 Page 2
LRJSML3 ;ALB/GTS - Lab Vista Hospital Location Utilities - 2;02/17/2010 09:42:19
+1 ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
+2 ;
+3 ;
SETNPARM(LRVALST,LRPARAM) ;Set New Params
+1 SET LRPARAM("LRRM")=$PIECE(LRVALST,"^",2)
+2 SET LRPARAM("LROBED")=$PIECE(LRVALST,"^",3)
+3 SET LRPARAM("LRHD")=$PIECE(LRVALST,"^",4)
+4 SET LRPARAM("LRFSTLNE")=$PIECE(LRVALST,"^",5)
+5 SET LRPARAM("LRINIT")=$PIECE(LRVALST,"^",6)
+6 QUIT
+7 ;
SETEPARM(LRVALST,LRPARAM) ;Set Edited Params
+1 SET LRPARAM("LRCRM")=$PIECE(LRVALST,"^",2)
+2 SET LRPARAM("LRCBED")=$PIECE(LRVALST,"^",3)
+3 SET LRPARAM("LRPRM")=$PIECE(LRVALST,"^",5)
+4 SET LRPARAM("LRPBED")=$PIECE(LRVALST,"^",6)
+5 SET LRPARAM("LRFSTLNE")=$PIECE(LRVALST,"^",7)
+6 SET LRPARAM("LRINIT")=$PIECE(LRVALST,"^",8)
+7 QUIT
+8 ;
MMDISPN(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Break into 79/80 char chunks for Cur Val display
+1 ; VALMCNT - Cur output array line number
+2 ; LRPARAM - Array with parameters passed
+3 ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message
+4 ; LRMMARY - Mail message output array (Optional)
+5 ;
+6 ;Array params sent & received (LRPARAM)
+7 ; XN - NEW HL extract data
+8 ; LEGEND:
+9 ; NEW^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
+10 ; ^Reactivation Date^Accessed by^Chng Date/Time
+11 ;
+12 ; NEW^ROOM^Hosp Loc Name^Type^Inst^Div^Room
+13 ; NEW^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed
+14 ; LRLOC - Cur Hosp Loc header Info
+15 ; LRRM - Cur Hosp Loc Room Info
+16 ; LROBED - Cur Hosp Loc Bed Info
+17 ; LRHD - Header (Location or Room) to display
+18 ; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed
+19 ; LRINIT - Init extract or Change extract (1: Initialization; 0: Change)
+20 ;
+21 NEW LRIEN,LRDTTYP,LRVALST,LRINIT
+22 NEW LRXN,LRLOC,LRRM,LROBED,LRHD,LRFSTLNE
+23 NEW LRLOCVAR,LRSUB,LPCNT,LRROOT
+24 ;
+25 if $GET(LRMMARY)=""
SET LRMMARY=""
+26 if $GET(LROUTPT)=""
SET LROUTPT="DISPLAY"
+27 ;
+28 ;Put Array params in local vars
+29 SET LRXN=LRPARAM("XN")
+30 ;
+31 SET LRLOCVAR="LRLOC^LRRM^LROBED^LRHD^LRFSTLNE^LRINIT"
+32 SET LRROOT="LRPARAM"
+33 FOR LPCNT=1:1
SET LRSUB=$PIECE(LRLOCVAR,"^",LPCNT)
if LRSUB=""
QUIT
SET @LRSUB=@LRROOT@(LRSUB)
+34 ;
+35 ;Type of data node (LOCATION, ROOM or BED)
SET LRDTTYP=$PIECE(LRXN,"^",2)
+36 IF LRDTTYP="LOCATION"
Begin DoDot:1
+37 IF LRLOC'=""
Begin DoDot:2
+38 DO LRNEWOUT(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
+39 ;
+40 ;Set Array params
+41 SET LRRM=LRPARAM("LRRM")
+42 SET LROBED=LRPARAM("LROBED")
+43 SET LRHD=LRPARAM("LRHD")
+44 SET LRPARAM("LRFSTLNE")=LRFSTLNE
End DoDot:2
+45 if 'LRINIT
SET LRHD="CHANGE DETAIL (NEW)"
+46 if LRINIT
SET LRHD="CURRENT DEFINITION"
+47 SET LRLOC="^^"_$PIECE(LRXN,"^",3,11)
End DoDot:1
+48 ;
+49 IF LRDTTYP="ROOM"
Begin DoDot:1
+50 IF LRRM'=""
Begin DoDot:2
+51 ;
+52 ;Reset Array params
+53 SET LRPARAM("LRFSTLNE")=LRFSTLNE
+54 DO LRNEWOUT(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY)
+55 ;
+56 ;Set Array params
+57 SET LRRM=LRPARAM("LRRM")
+58 SET LROBED=LRPARAM("LROBED")
+59 SET LRHD=LRPARAM("LRHD")
+60 SET LRFSTLNE=LRPARAM("LRFSTLNE")
End DoDot:2
+61 if 'LRINIT
SET LRHD="CHANGE DETAIL (NEW)"
+62 if LRINIT
SET LRHD="CURRENT DEFINITION"
+63 SET LRRM=$PIECE(LRXN,"^",8)
End DoDot:1
+64 ;
+65 IF LRDTTYP="BED"
if LROBED'=""
SET LROBED=LROBED_" ; "_$PIECE(LRXN,"^",9)
if LROBED=""
SET LROBED=$PIECE(LRXN,"^",9)
+66 ;
+67 ;Reset Array params
+68 SET LRPARAM("LRLOC")=LRLOC
+69 SET LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRINIT
+70 DO SETNPARM(LRVALST,.LRPARAM)
+71 QUIT
+72 ;
LRNEWOUT(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Output New location
+1 ;INPUT PARAMS:
+2 ; VALMCNT - Cur Line number of output array
+3 ; LRPARAM - Array with params passed
+4 ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail message
+5 ; LRMMARY - Mail message output array (Optional)
+6 ;
+7 ;Array params sent & received (LRPARAM)
+8 ; LRLOC - Cur Hosp Loc Info
+9 ; LRRM - Cur Hosp Loc Room Info
+10 ; LROBED - Cur Hosp Loc Bed Info
+11 ; LRHD - Header Info
+12 ; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed
+13 ; LRINIT - Init extract or Change extract (1: Initialization; 0: Change)
+14 ;
+15 NEW LRLOCVAR,LRROOT,LPCNT,LRSUB
+16 NEW LAX,LRIEN,LRNNAME,LRTYPE,LRINST,LRDIV,LRINACT,LRREACT,LRUSR,LRDTCG
+17 NEW LRLOC,LRRM,LROBED,LRHD,LRFSTLNE,LRVALST,LRINIT
+18 ;
+19 ;Put Array params in local vars
+20 SET LRLOCVAR="LRLOC^LRRM^LROBED^LRHD^LRFSTLNE^LRINIT"
+21 SET LRROOT="LRPARAM"
+22 FOR LPCNT=1:1
SET LRSUB=$PIECE(LRLOCVAR,"^",LPCNT)
if LRSUB=""
QUIT
SET @LRSUB=@LRROOT@(LRSUB)
+23 ;
+24 ;Set variables passed in LRPARAM("LRLOC")
+25 SET LRIEN=$PIECE(LRLOC,"^",3)
+26 SET LRNNAME=$PIECE(LRLOC,"^",4)
+27 SET LRTYPE=$PIECE(LRLOC,"^",5)
+28 SET LRINST=$PIECE(LRLOC,"^",6)
+29 SET LRDIV=$PIECE(LRLOC,"^",7)
+30 SET LRINACT=$PIECE(LRLOC,"^",8)
+31 SET LRREACT=$PIECE(LRLOC,"^",9)
+32 SET LRUSR=$PIECE(LRLOC,"^",10)
+33 SET LRDTCG=$PIECE(LRLOC,"^",11)
+34 ;
+35 if +LRFSTLNE>0
DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+36 if LROUTPT="MAIL"
DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+37 DO LRADDNOD(.VALMCNT," "_LRHD,"",LROUTPT,LRMMARY)
+38 IF LROUTPT="DISPLAY"
Begin DoDot:1
+39 DO CNTRL^VALM10(VALMCNT,8,$LENGTH(LRHD),IOUON,IOUOFF_IOINORM)
End DoDot:1
+40 ;
+41 ;Output Location info
+42 SET LAX=" IEN: "_LRIEN
+43 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+44 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM)
+45 SET LAX=" NAME: "_LRNNAME
+46 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+47 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+48 SET LAX=" TYPE: "_LRTYPE
+49 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+50 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+51 SET LAX=" INST: "_LRINST
+52 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+53 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+54 SET LAX=" DIV: "_LRDIV
+55 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+56 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM)
+57 SET LAX="INACT: "_$$FMTE^XLFDT(LRINACT)
+58 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+59 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM)
+60 SET LAX=" ACT: "_$$FMTE^XLFDT(LRREACT)
+61 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+62 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM)
+63 ;
+64 ;Output edit info
+65 if LRINIT
SET LAX=" "
+66 if 'LRINIT
SET LAX=" CHANGED BY: "_LRUSR
+67 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+68 IF LROUTPT="DISPLAY"
IF 'LRINIT
DO CNTRL^VALM10(VALMCNT,10,11,IOINHI,IOINORM)
+69 IF 'LRINIT
Begin DoDot:1
+70 SET LAX=" DATE/TIME OF CHANGE: "_$$FMTE^XLFDT(LRDTCG)
+71 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+72 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,20,IOINHI,IOINORM)
End DoDot:1
+73 ;
+74 ;Output Room/Bed info
+75 DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+76 SET LAX=" ROOM: "_LRRM
+77 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+78 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+79 SET LAX=" BEDS: "_LROBED
+80 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+81 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+82 if LROUTPT="MAIL"
DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+83 ;
+84 IF LRINIT
DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+85 ;
+86 SET (LRRM,LROBED,LRHD)=""
+87 SET LRFSTLNE=1
+88 ;
+89 ;Reset Param array
+90 SET LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRINIT
+91 DO SETNPARM(LRVALST,.LRPARAM)
+92 SET LRPARAM("LRLOC")=LRLOC
+93 QUIT
+94 ;
MMDISPC(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Break into 79/80 char chunks for Cur Val display
+1 ;
+2 ;Input params
+3 ; VALMCNT - Cur Line number of output array
+4 ; LRPARAM - Array with parameters passed
+5 ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message
+6 ; LRMMARY - Mail message output array (Optional)
+7 ;
+8 ;Array params sent & received (LRPARAM)
+9 ; XN - CURRENT HL extract data
+10 ; LEGEND:
+11 ; CURRENT^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
+12 ; ^Reactivation Date^Accessed by^Chng Date/Time
+13 ;
+14 ; CURRENT^ROOM^Hosp Loc Name^Type^Inst^Div^Room
+15 ; CURRENT^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed
+16 ;
+17 ; XP - PREVIOUS HL extract data
+18 ; LEGEND:
+19 ; PREVIOUS^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
+20 ; ^Reactivation Date^Accessed by^Chng Date/Time
+21 ;
+22 ; PREVIOUS^ROOM^Hosp Loc Name^Type^Inst^Div^Room
+23 ; PREVIOUS^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed
+24 ;
+25 ; LRCLOC - Cur Hosp Loc info
+26 ; LRCRM - Cur Hosp Loc Room info
+27 ; LRCBED - Cur Hosp Loc Bed info
+28 ; LRPLOC - Prev Hosp Loc info
+29 ; LRPRM - Prev Hosp Loc Room info
+30 ; LRPBED - Prev Hosp Loc Bed info
+31 ; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed
+32 ; LRNEWLOC- Value 1 = the location not printed
+33 ; LRINIT - Init extract or Change extract (1: Initialization; 0: Change)
+34 ;
+35 ;
+36 NEW LRDTTYP,LRVALST,LRNEWLOC,LRINIT
+37 NEW LRXC,LRXP,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE,LRCHGARY
+38 NEW LRLOCVAR,LRSUB,LPCNT,LRROOT
+39 ;
+40 if $GET(LRMMARY)=""
SET LRMMARY=""
+41 if $GET(LROUTPT)=""
SET LROUTPT="DISPLAY"
+42 ;
+43 ;Put Array params in local vars
+44 SET LRXC=LRPARAM("XN")
+45 SET LRXP=LRPARAM("XP")
+46 ;
+47 SET LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT"
+48 SET LRROOT="LRPARAM"
+49 FOR LPCNT=1:1
SET LRSUB=$PIECE(LRLOCVAR,"^",LPCNT)
if LRSUB=""
QUIT
SET @LRSUB=@LRROOT@(LRSUB)
+50 ;
+51 ;Data node type (LOCATION, ROOM or BED)
SET LRDTTYP=$PIECE(LRXC,"^",2)
+52 ;
+53 IF LRDTTYP="LOCATION"
Begin DoDot:1
+54 IF LRCLOC'=""
Begin DoDot:2
+55 ;
+56 ;Set array & Print
+57 SET LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
+58 DO SETEPARM(LRVALST,.LRCHGARY)
+59 SET LRCHGARY("LRNEWLOC")=LRNEWLOC
+60 SET LRCHGARY("LRCLOC")=LRCLOC
+61 SET LRCHGARY("LRPLOC")=LRPLOC
+62 ;
+63 DO LRLOUT(.VALMCNT,.LRCHGARY,LROUTPT,.LRPARAM,.LRVALST,LRMMARY)
+64 ;
+65 ;Put Array params (LRCHGARY) in local vars
+66 SET LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE"
+67 SET LRROOT="LRCHGARY"
+68 FOR LPCNT=1:1
SET LRSUB=$PIECE(LRLOCVAR,"^",LPCNT)
if LRSUB=""
QUIT
SET @LRSUB=@LRROOT@(LRSUB)
End DoDot:2
+69 ;
+70 SET LRNEWLOC=1
+71 SET (LRCRM,LRCBED,LRPRM,LRPBED)=""
End DoDot:1
+72 ;
+73 ;If Room node exists, next node is Bed
+74 IF LRDTTYP="ROOM"
Begin DoDot:1
+75 IF LRCBED=""
Begin DoDot:2
+76 SET LRCRM=$PIECE(LRXC,"^",8)
+77 SET LRPRM=$PIECE(LRXP,"^",8)
End DoDot:2
End DoDot:1
+78 ;
+79 ;ROOM/BED info output on BED node
+80 IF LRDTTYP="BED"
Begin DoDot:1
+81 SET LRCRM=$PIECE(LRXC,"^",8)
+82 SET LRPRM=$PIECE(LRXP,"^",8)
+83 SET LRCBED=$PIECE(LRXC,"^",9)
+84 SET LRPBED=$PIECE(LRXP,"^",9)
+85 ;
+86 ;Set array & Print
+87 SET LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
+88 DO SETEPARM(LRVALST,.LRCHGARY)
+89 SET LRCHGARY("LRNEWLOC")=LRNEWLOC
+90 SET LRCHGARY("LRCLOC")=LRCLOC
+91 SET LRCHGARY("LRPLOC")=LRPLOC
+92 ;
+93 DO LRRBOUT(.VALMCNT,.LRCHGARY,LROUTPT,.LRPARAM,.LRVALST,LRMMARY)
+94 ;
+95 ;Put Array params (LRCHGARY) in local vars
+96 SET LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE"
+97 SET LRROOT="LRCHGARY"
+98 FOR LPCNT=1:1
SET LRSUB=$PIECE(LRLOCVAR,"^",LPCNT)
if LRSUB=""
QUIT
SET @LRSUB=@LRROOT@(LRSUB)
End DoDot:1
+99 ;
+100 ;Reset Array param
+101 SET LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
+102 DO SETEPARM(LRVALST,.LRPARAM)
+103 SET LRPARAM("LRCLOC")=LRCLOC
+104 SET LRPARAM("LRPLOC")=LRPLOC
+105 SET LRPARAM("LRNEWLOC")=LRNEWLOC
+106 QUIT
+107 ;
LRLOUT(VALMCNT,LRCHGARY,LROUTPT,LRPARAM,LRVALST,LRMMARY) ; Output Loc
+1 ;INPUT:
+2 ; VALMCNT - Cur Line number of output array
+3 ; LRCHGARY- Array of param passed by ref
+4 ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail message
+5 ; LRPARAM - Array with parameters passed
+6 ; LRVALST - Carat delimited list of location data
+7 ; LRMMARY - Mail message output array (Optional)
+8 ;
+9 ;Array Parameters sent and received (LRCHGARY)
+10 ; LRCLOC - CURRENT HL extract data
+11 ; LRPLOC - PREVIOUS Hosp Loc Data
+12 ; LEGEND (LRCLOC & LRPLOC):
+13 ; ^^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
+14 ; ^Reactivation Date^Accessed by^Chng Date/Time
+15 ;
+16 ; LRCRM - Cur Hosp Loc Room Info
+17 ; LRCBED - Cur Hosp Loc Bed Info
+18 ; LRPRM - Prev Hosp Loc Room Info
+19 ; LRPBED - Prev Hosp Loc Bed Info
+20 ; LRFSTLNE- Value 1 - 1st line printed, 0 - 1st line hasn't printed
+21 ; LRNEWLOC- Value 1 = the location has not been printed
+22 ; LRINIT - Init extract ; Change extract (1: Init; 0: Change)
+23 ;
+24 NEW LAX,C,LRIEN,LRNNAME,LRTYPE,LRINST,LRDIV,LRINACT
+25 NEW LRONAME,LROTYPE,LROINST,LRODIV,LROINACT,LROREACT,LRODTOUT,LRNEWLOC
+26 NEW LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE,LRDTCG,LRUSR,LRINIT,LRREACT
+27 NEW LRLOCVAR,LRSUB,LPCNT,LRROOT
+28 ;
+29 ;Put Array params (LRCHGARY) in local vars
+30 SET LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT"
+31 SET LRROOT="LRCHGARY"
+32 FOR LPCNT=1:1
SET LRSUB=$PIECE(LRLOCVAR,"^",LPCNT)
if LRSUB=""
QUIT
SET @LRSUB=@LRROOT@(LRSUB)
+33 ;
+34 ;-- Continue char
SET C=""
+35 if +LRFSTLNE>0
DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+36 if LROUTPT="MAIL"
DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+37 DO LRADDNOD(.VALMCNT," CHANGE DETAIL (CURRENT) CHANGE DETAIL (PREVIOUS)","",LROUTPT,LRMMARY)
+38 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,8,$LENGTH("CHANGE DETAIL (CURRENT)"),IOUON,IOUOFF_IOINORM)
+39 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,46,$LENGTH("CHANGE DETAIL (PREVIOUS)"),IOUON,IOUOFF_IOINORM)
+40 ;
+41 ;Set new Current values passed in LRCHGARY("LRCLOC")
+42 SET LRIEN=$PIECE(LRCLOC,"^",3)
+43 SET LRNNAME=$PIECE(LRCLOC,"^",4)
+44 SET LRTYPE=$PIECE(LRCLOC,"^",5)
+45 SET LRINST=$PIECE(LRCLOC,"^",6)
+46 SET LRDIV=$PIECE(LRCLOC,"^",7)
+47 SET LRINACT=$PIECE(LRCLOC,"^",8)
+48 SET LRREACT=$PIECE(LRCLOC,"^",9)
+49 SET LRUSR=$PIECE(LRCLOC,"^",10)
+50 SET LRDTCG=$PIECE(LRCLOC,"^",11)
+51 ;
+52 ;Set Previous values passed in LRCHGARY("LRPLOC")
+53 SET LRONAME=$PIECE(LRPLOC,"^",4)
+54 SET LROTYPE=$PIECE(LRPLOC,"^",5)
+55 SET LROINST=$PIECE(LRPLOC,"^",6)
+56 SET LRODIV=$PIECE(LRPLOC,"^",7)
+57 SET LROINACT=$PIECE(LRPLOC,"^",8)
+58 SET LROREACT=$PIECE(LRPLOC,"^",9)
+59 ;
+60 SET LAX=" IEN: "_LRIEN
+61 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+62 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM)
+63 ;
+64 SET LAX=" NAME: "_LRNNAME
+65 DO LRADDNOD(.VALMCNT,LAX,LRONAME,LROUTPT,LRMMARY)
+66 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+67 ;
+68 SET LAX=" TYPE: "_LRTYPE
+69 DO LRADDNOD(.VALMCNT,LAX,LROTYPE,LROUTPT,LRMMARY)
+70 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+71 ;
+72 SET LAX=" INST: "_LRINST
+73 DO LRADDNOD(.VALMCNT,LAX,LROINST,LROUTPT,LRMMARY)
+74 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+75 ;
+76 SET LAX=" DIV: "_LRDIV
+77 DO LRADDNOD(.VALMCNT,LAX,LRODIV,LROUTPT,LRMMARY)
+78 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,3,5,IOINHI,IOINORM)
+79 ;
+80 SET LAX="INACT: "_$$FMTE^XLFDT(LRINACT)
+81 SET LRODTOUT=$$FMTE^XLFDT(LROINACT)
+82 DO LRADDNOD(.VALMCNT,LAX,LRODTOUT,LROUTPT,LRMMARY)
+83 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM)
+84 ;
+85 SET LAX=" ACT: "_$$FMTE^XLFDT(LRREACT)
+86 SET LRODTOUT=$$FMTE^XLFDT(LROREACT)
+87 DO LRADDNOD(.VALMCNT,LAX,LRODTOUT,LROUTPT,LRMMARY)
+88 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM)
+89 ;
+90 ;Output edit info
+91 if LRINIT
SET LAX=" "
+92 if 'LRINIT
SET LAX=" CHANGED BY: "_LRUSR
+93 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+94 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,10,11,IOINHI,IOINORM)
+95 ;
+96 IF 'LRINIT
Begin DoDot:1
+97 SET LAX=" DATE/TIME OF CHANGE: "_$$FMTE^XLFDT(LRDTCG)
+98 DO LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY)
+99 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,20,IOINHI,IOINORM)
End DoDot:1
+100 ;
+101 DO LRADDNOD(.VALMCNT,"","",LROUTPT,LRMMARY)
+102 SET LRNEWLOC=0
+103 ;
+104 ;Reset Parameter Array
+105 SET LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
+106 DO SETEPARM(LRVALST,.LRPARAM)
+107 SET LRPARAM("LRCLOC")=LRCLOC
+108 SET LRPARAM("LRPLOC")=LRPLOC
+109 QUIT
+110 ;
LRRBOUT(VALMCNT,LRCHGARY,LROUTPT,LRPARAM,LRVALST,LRMMARY) ;Output Room/Bed
+1 ;INPUT:
+2 ; VALMCNT - Cur Line number of output array
+3 ; LRCHGARY- Array of parameters passed by reference
+4 ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message
+5 ; LRPARAM - Array with parameters passed
+6 ; LRVALST - Carat delimited list of location data
+7 ; LRMMARY - Mail message output array (Optional)
+8 ;
+9 ;Array Params (LRCHGARY) sent and received
+10 ; LRCLOC - CURRENT HL extract data
+11 ; LRPLOC - PREVIOUS Hosp Loc data
+12 ; LEGEND (LRCLOC & LRPLOC):
+13 ; ^^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date
+14 ; ^Reactivation Date^Accessed by^Chng Date/Time
+15 ;
+16 ; LRCRM - Cur Hosp Loc Room Info
+17 ; LRCBED - Cur Hosp Loc Bed Info
+18 ; LRPRM - Prev Hosp Loc Room Info
+19 ; LRPBED - Prev Hosp Loc Bed Info
+20 ; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed
+21 ; LRNEWLOC- Value 1 = the location has not been printed
+22 ; LRINIT - Init extract or Change extract (1: Initialization; 0: Change)
+23 ;
+24 NEW LAX,C,LRNEWLOC,LRINIT
+25 NEW LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE
+26 NEW LRLOCVAR,LRSUB,LPCNT,LRROOT
+27 ;
+28 ;Put Array params (LRCHGARY) in local vars
+29 SET LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT"
+30 SET LRROOT="LRCHGARY"
+31 FOR LPCNT=1:1
SET LRSUB=$PIECE(LRLOCVAR,"^",LPCNT)
if LRSUB=""
QUIT
SET @LRSUB=@LRROOT@(LRSUB)
+32 ;
+33 ;-- Continue char
SET C=""
+34 ;Output Room/Bed changes
+35 SET LAX=" ROOM: "_LRCRM
+36 DO LRADDNOD(.VALMCNT,LAX,LRPRM,LROUTPT,LRMMARY)
+37 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+38 ;
+39 SET LAX=" BEDS: "_LRCBED
+40 DO LRADDNOD(.VALMCNT,LAX,LRPBED,LROUTPT,LRMMARY)
+41 if LROUTPT="DISPLAY"
DO CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM)
+42 if LROUTPT="MAIL"
DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+43 ;
+44 IF LRINIT
DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY)
+45 ;
+46 ;Reset Parameter Array
+47 SET (LRCBED,LRPBED)=""
+48 SET LRFSTLNE=1
+49 ;
+50 SET LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT
+51 DO SETEPARM(LRVALST,.LRPARAM)
+52 SET LRPARAM("LRCLOC")=LRCLOC
+53 SET LRPARAM("LRPLOC")=LRPLOC
+54 QUIT
+55 ;
LRADDNOD(LRNODECT,LRCUR,LRPREV,LROUTPT,LRMMARY) ;Include Prev value in string, add to mail array
+1 ; INPUT:
+2 ; LRNODECT - Node number
+3 ; LRCUR - Cur entry display
+4 ; LRPREV - Prev entry display
+5 ; LROUTPT - Type of array to populate (Display or Mail)
+6 ; LRMMARY - Array of output for Mail messages
+7 ;
+8 ; OUTPUT:
+9 ; Display array
+10 ;
+11 NEW LRLGTH
+12 if $GET(LRPREV)=""
SET LRPREV=""
+13 if $GET(LROUTPT)=""
SET LROUTPT="DISPLAY"
+14 if $GET(LRMMARY)=""
SET LRMMARY=""
+15 SET LRLGTH=$LENGTH(LRCUR)
+16 SET LRCUR=LRCUR_$JUSTIFY(LRPREV,3+$LENGTH(LRPREV)+(42-LRLGTH))
+17 if LROUTPT="DISPLAY"
DO ADD^LRJSMLU(.LRNODECT,LRCUR)
+18 if LROUTPT="MAIL"
DO LRADDLNE(.LRNODECT,LRCUR,LRMMARY)
+19 QUIT
+20 ;
LRADDLNE(LRNODECT,MSG,LRMMARY) ; -- add line to build display
+1 ;INPUT:
+2 ; LRNODECT - Node number
+3 ; MSG - Text to mail
+4 ; LRMMARY - Array for MailMan call
+5 ;
+6 ;OUTPUT:
+7 ; Array for Mail message
+8 ;
+9 SET LRNODECT=LRNODECT+1
+10 SET @LRMMARY@(LRNODECT)=MSG
+11 QUIT
