LRJSMLA ;ALB/PO,GTS Lab Hospital Location Update Notification ;02/24/2010 11:45:51
;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
;
;
;IA #1380 allows references to ^DG(405.4
;
BLDREC(LRFR,LRTO,LRES,LRTYPE) ; -- output the HLCMS updates
; Input:
; LRFR - start time to report the raw data for.
; LRTO - end to report the raw data.
; LRES - Root for array that defines result data
; LRTYPE - report type
; 1: do not report records that that have changed
; but returned back to its original values (Default)
; 2: report all reocrds
; Output:
; @OUT@(seguence number) - array containing the results
;
NEW NODE,OUT,I,NOFFSET,KEEPHL,KEEPRM,KEEPBED,LRTMP,LAST,CURDATA,PREVDATA,TOTALRM,TOTALBED,LRCHAR
SET LRTYPE=$G(LRTYPE,1) ; if LRTYPE not defined, default type 1
SET OUT=$NAME(@LRES@("OUT"))
SET LRCHAR=0
DO IOXY^XGF(IOSL-1,52)
WRITE "[Extract HL Changes..."
DO BLDRAW(LRFR,LRTO,OUT)
;
FOR NOFFSET=1:1 QUIT:$QS(OUT,NOFFSET)="OUT"
SET LRTMP=$NAME(@LRES@("TMP"))
SET NODE=$NAME(@OUT@("SORT1RAW"))
FOR I=1:1 SET NODE=$Q(@NODE) QUIT:$E(NODE,1,$L(OUT)-1)'=$E(OUT,1,$L(OUT)-1) DO
. D HANGCHAR^LRJSMLU(.LRCHAR)
. SET:LRTYPE=1 @LRTMP@(I)=@NODE
. SET:LRTYPE=2 @LRES@(I)=@NODE
KILL @OUT
QUIT:LRTYPE=2
; Continue for report type 1 starting from last node and remove BED, ROOM or LOCATION
; to remove records that are not changed (actually ones that have changed and returned back
; to original values)
SET LAST=$O(@LRTMP@(""),-1)
SET TOTALRM=0
SET TOTALBED=0
SET I=LAST+2
FOR SET I=I-2 QUIT:I<2 DO ;I=LAST:-1:1 DO
. D HANGCHAR^LRJSMLU(.LRCHAR)
. SET PREVDATA=$G(@LRTMP@(I))
. IF (PREVDATA="")!($P(PREVDATA,"^",1)="NEW") SET I=0 QUIT ; got to NEW records, don't care any more
. SET CURDATA=$G(@LRTMP@(I-1))
. IF $P(PREVDATA,"^",1)="PREVIOUS" DO
. . ;
. . IF $P(PREVDATA,"^",2)="BED" DO
. . . IF $P(PREVDATA,"^",8,9)=$P(CURDATA,"^",8,9) DO
. . . . KILL @LRTMP@(I),@LRTMP@(I-1)
. . . ELSE SET TOTALBED=TOTALBED+1
. . ;
. . ELSE IF $P(PREVDATA,"^",2)="ROOM" DO
. . . IF TOTALBED=0 DO
. . . . KILL @LRTMP@(I),@LRTMP@(I-1)
. . . ELSE SET TOTALRM=TOTALRM+1
. . . SET TOTALBED=0 ; initialize the total number of beds for next room encounter
. . ELSE IF $P(PREVDATA,"^",2)="LOCATION" DO
. . . IF TOTALRM=0,$P(PREVDATA,"^",4,9)="^^^^^" DO
. . . . KILL @LRTMP@(I),@LRTMP@(I-1)
. . . ELSE SET (TOTALRM,TOTALBED)=0
;
SET NODE=LRTMP
FOR I=1:1 SET NODE=$Q(@NODE) QUIT:$E(NODE,1,$L(LRTMP)-1)'=$E(LRTMP,1,$L(LRTMP)-1) SET @LRES@(I)=@NODE
IF '$D(@LRES@(1)) SET @LRES@(1)=" NO CHANGES FOUND!!"
KILL @LRTMP
;
QUIT
;
BLDRAW(LRFR,LRTO,OUT) ; -- build raw data for given time interval into @OUT array
; Input:
; LRFR - start date/time for raw data report
; LRTO - end date/time for raw data report
; OUT - Name of array holding raw data
; Output:
; @OUT@ - array in the following format.
; @OUT@(sort order, HL ien, 0, "CURRENT" or "PREVIOUS" or "NEW") = CURRENT or PREVIOUS or NEW HL field values
; @OUT@(sort order, HL ien,"AAAROOM", room value,-.235681, "CURRENT" or "PREVIOUS" or "NEW")=CURRENT or PREVIOUS or NEW room field values
; @OUT@(sort order, HL ien,"AAAROOM", room value, bed value, "CURRENT" or "PREVIOUS" or "NEW")=CURRENT or PREVIOUS or NEW bed field values
; e.g.
;
; @OUT@("SORT2RAW",432,0,"CURRENT")="CURRENT^LOCATION^432^ZZW 100Ar^WARD^ALABAMA^TROY^^^OSTOVARI,PARVIZ^3081208.165853"
; @OUT@("SORT2RAW",432,0,"PREVIOUS")="PREVIOUS^LOCATION^432^ZZW 100A^^ALBANY AREA^DEVVLD^^"
; @OUT@("SORT2RAW",432,"AAAROOM",1001,-.235681,"CURRENT")="CURRENT^ROOM^432^ZZW 100Ar^WARD^ALABAMA^TROY^^"
; @OUT@("SORT2RAW",432,"AAAROOM",1001,-.235681,"PREVIOUS")="PREVIOUS^ROOM^432^ZZW 100A^^ALBANY AREA^DEVVLD^1001^"
; @OUT@("SORT2RAW",432,"AAAROOM",1001,"AB","ACUR")="CURRENT^BED^432^ZZW 100Ar^WARD^ALABAMA^TROY^1001^"
; @OUT@("SORT2RAW",432,"AAAROOM",1001,"AB","APREV")="PREVIOUS^BED^432^ZZW100A^^ALBANY AREA^DEVVLD^1001^AB"
;
NEW CUR,PREV,MOD,REVNODE,HLIEN,NFLDNUM,RBIEN,NEWIENV,OLDIENV,NEWVAL,OLDVAL,USER,DTR,ENTNM,RBIEN,RMBD,RMBDUNQ,NODE,NARR,CURMBD,FLDNUM,HLSORT
NEW NEWCUR,OLDBDNM,OLDRMNM,PREVIOUS,ROOMNAME,FLAG,BEDNAME,RMBDLIST,WLIEN,RMBDIEN
NEW CURTYPE,PREVTYPE,IGNORE,ACTDT,INACTDT,LRCHAR
SET LRCHAR=0
;
SET REVNODE=$NAME(@OUT@("REVARR"))
KILL @OUT,@REVNODE
;
;
; sort audit records; reverse HL and room-bed changes.
DO SRTCHG^LRJSMLA1(LRFR,LRTO,REVNODE)
;
; for each HL ien, check to see if the entry is new or modified.
SET HLIEN=0
FOR SET HLIEN=$O(@REVNODE@("N",HLIEN)) Q:'HLIEN I $D(^SC(HLIEN)) DO
. D HANGCHAR^LRJSMLU(.LRCHAR)
. KILL ARR,MOD,NARR,CUR,PREV,RMBD,RMBDUNQ
. SET (ACTDT,INACTDT)=""
. ; get the current values for this HL
. DO GHL(HLIEN,.CUR) ;Returns current Hosp Loc fields from file 44
. ;
. ; get the changes for this HL into NARR
. MERGE NARR=@REVNODE@("N",HLIEN)
. ;
. ;CUR - current values of HL fields
. DO ROLLUP(HLIEN,.CUR,.NARR,LRTO) ;Roll back current HL values from current time to "TO" time
. DO CLNUP^LRJSMLA1(.NARR) ;*Remove Room-Bed edits made before RM-BD added to Ward-Location
. ;
. SET CUR("HL","FLAG")="CURRENT" ; HL record flag
. SET CUR("HL","NAME")="LOCATION" ; HL record type
. ;
. ; find out which node is new and which one is current.
. SET NODE="NARR"
. FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO
. . SET DTR=$P(@NODE,"^",6) ; Date/Time Recorded
. . QUIT:DTR>LRTO ; quit if Date/time recorded is in future.
. . SET NFLDNUM=$QS(NODE,4) ; field number
. . SET RBIEN=$QS(NODE,3) ; room-bed ien
. . SET NEWIENV=$P(@NODE,"^",1) ; New IEN value
. . SET OLDIENV=$P(@NODE,"^",2) ; Old IEN value
. . SET NEWVAL=$P(@NODE,"^",3) ; New value
. . SET OLDVAL=$P(@NODE,"^",4) ; Old value
. . SET:DTR'="" CUR("HL","DTR")=DTR ; date/time recorded. Last date/time changed for any fields.
. . SET USER=$P(@NODE,"^",5) ; Accessed by (USER)
. . SET:USER'="" CUR("HL","USER")=USER ; accessed by (USER). Last user who changed any field.
. . SET ENTNM=$P(@NODE,"^",7) ; Entry Name From Audit File
. . ;
. . ; if change is to HL or Ward Loaction (room-bed ien is 0)
. . IF RBIEN=0 DO
. . . ;if HL change is to .01 field with no previous value
. . . IF NFLDNUM=.01 DO
. . . . IF OLDVAL="<no previous value>" DO
. . . . . SET CUR("HL","FLAG")="NEW" ; HL record flag
. . . ;
. . . ; if current flag not new, keep track and store the old value data in MOD array
. . . IF $G(CUR("HL","FLAG"))'="NEW" DO
. . . . ; store the old value only for the oldest changes for the given field
. . . . IF '$D(MOD("HL",NFLDNUM)) DO
. . . . . SET MOD("HL",NFLDNUM)=OLDVAL ; Old value
. . . ;
. . . ; if type is modified
. . . IF NFLDNUM="2" DO
. . . . ; if type changed from other to clinic/ward/operating room
. . . . IF OLDVAL'="<no previous value>","CLINIC^WARD^OPERATING ROOM"'[OLDVAL,"CLINIC^WARD^OPERATING ROOM"[NEWVAL SET ACTDT=DTR
. . . . ;
. . . . ; if type changed from clinic/ward/operating room to other.
. . . . IF "CLINIC^WARD^OPERATING ROOM"[OLDVAL,"CLINIC^WARD^OPERATING ROOM"'[NEWVAL SET INACTDT=DTR
. . ;
. . ; if this is for Room-bed changes (Note: nodes sorted by date/time from lowest to highest)
. . ; node value is in the format of:
. . ; new room-bed ien ^ New Value ^ Old ien ^ Old Value ^ Current Value
. . IF RBIEN'=0 DO
. . . SET CURMBD=$P($G(^DG(405.4,+RBIEN,0)),"^") ;room bed current value
. . . ; Check room-bed .01 field to see if room bed is new or not
. . . IF (NFLDNUM=".01") DO
. . . . IF OLDVAL="<no previous value>" DO
. . . . . KILL RMBDUNQ(+RBIEN,"CHANGE") ; Make sure "CHANGED node does not exist"
. . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; If already deleted verify DELETED100 node does not exist"
. . . . . SET RMBDUNQ(+RBIEN,"NEW")=(+RBIEN)_"^"_NEWVAL_"^^^"_$$CURRMBED("NARR",RBIEN)
. . . . ELSE DO
. . . . . KILL RMBDUNQ(+RBIEN,"NEW") ; Make sure "CHANGED node does not exist"
. . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; If it was already deleted make sure DELETED100 node does not exist"
. . . . . ; only store the first change
. . . . . SET:'$D(RMBDUNQ(+RBIEN,"CHANGE"))#2 RMBDUNQ(+RBIEN,"CHANGE")=(+RBIEN)_"^"_NEWVAL_"^"_(+RBIEN)_"^"_OLDVAL_"^"_$$CURRMBED("NARR",RBIEN)
. . . ;
. . . ; ward location is added/removed to/from the room-bed
. . . IF (NFLDNUM="100,.01") DO
. . . . ; if ward location is added to the room-bed.
. . . . IF OLDVAL="<no previous value>" DO
. . . . . SET:'$D(RMBDUNQ(+RBIEN,"CHANGE")) RMBDUNQ(+RBIEN,"NEW")=(+RBIEN)_"^"_CURMBD_"^^^"_CURMBD
. . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; if deleted, verify DELETED100 node does not exist.
. . . . .;
. . . . ; if the the ward location is deleted from the room-bed, make sure not newed.
. . . . IF NEWVAL="<deleted>" DO
. . . . . KILL RMBDUNQ(+RBIEN,"NEW")
. . . . . SET RMBDUNQ(+RBIEN,"DELETED100")="^^"_(+RBIEN)_"^"_ENTNM_"^"_CURMBD ; report Entry Name (ENTNM) from audit file
. . . ;
. ;
. ; Store results for current HL file entry in CUR and PREV arrays
. IF $D(CUR("HL","FLAG")),CUR("HL","FLAG")'="NEW" DO
. . MERGE PREV=CUR
. . SET CUR("HL","FLAG")="CURRENT"
. . SET PREV("HL","FLAG")="PREVIOUS"
. ; modify the PREV array from MOD array to record changes for HL file
. IF $G(CUR("HL","FLAG"))="" SET CUR("HL","FLAG")="CURRENT",PREV("HL","FLAG")="PREVIOUS",CUR("HL",.001)=HLIEN,PREV("HL",.001)=HLIEN,MOD("HL",.001)=HLIEN
. SET FLDNUM=0 FOR SET FLDNUM=$O(MOD("HL",FLDNUM)) QUIT:'FLDNUM SET PREV("HL",FLDNUM)=MOD("HL",FLDNUM)
. SET FLDNUM=0 FOR SET FLDNUM=$O(PREV("HL",FLDNUM)) QUIT:'FLDNUM SET:(FLDNUM'=.001)&(PREV("HL",FLDNUM)=$G(CUR("HL",FLDNUM))) PREV("HL",FLDNUM)=""
. ;
. ;determine if this HL was reactivated or inactivated.
. IF ACTDT'="",ACTDT>INACTDT S CUR("HL",2506)=ACTDT ; current reactivate date
. IF INACTDT'="",INACTDT>ACTDT S CUR("HL",2505)=INACTDT ; current inactivate date
. IF ACTDT'="",ACTDT<INACTDT S PREV("HL",2506)=ACTDT ; previous reactive date
. IF INACTDT'="",INACTDT<ACTDT S PREV("HL",2505)=INACTDT ; previous inactivate date
. ;
. ; Determine if HL type is changed or not.
. SET CURTYPE=CUR("HL",2) ;$P(NEWCUR,"^",5)
. SET PREVTYPE=$G(PREV("HL",2)) ;$P(PREVIOUS,"^",5)
. SET IGNORE=0
. IF CUR("HL","FLAG")="NEW" DO
. . IF "CLINIC^WARD^OPERATING ROOM"'[CURTYPE SET IGNORE=1 QUIT ;do not Report this HL.
. IF CUR("HL","FLAG")="CURRENT" DO
. . IF PREVTYPE="","CLINIC^WARD^OPERATING ROOM"'[CURTYPE SET IGNORE=1 QUIT ;do not Report HL
. . ;
. . ; if type changed from others to "CLINIC^WARD^OPERATING ROOM" report all room-beds containing location
. . IF PREVTYPE'="","CLINIC^WARD^OPERATING ROOM"'[PREVTYPE,"CLINIC^WARD^OPERATING ROOM"[CURTYPE DO
. . . SET CUR("HL","FLAG")="NEW" ; force the HL to be new even though currently exists
. . . SET WLIEN=$$HLTOWL^LRJSMLA1(HLIEN)
. . . SET RMBDIEN=0
. . . ;IA #1380 for ^DG(405.4,"W", reference
. . . FOR SET RMBDIEN=$O(^DG(405.4,"W",WLIEN,RMBDIEN)) QUIT:'RMBDIEN DO
. . . . SET:$$KEEPBED^LRJSMLA1(+RMBDIEN,$NAME(@OUT@("REVARR","N",HLIEN))) RMBDUNQ(+RMBDIEN,"NEW")=(+RMBDIEN)_"^"_$P($G(^DG(405.4,RMBDIEN,0)),"^",1)_"^^^"_$P($G(^DG(405.4,RMBDIEN,0)),"^",1)
. . ;
. . ; if type changed from "CLINIC^WARD^OPERATING ROOM" to others report deleted room-beds containing location
. . IF PREVTYPE'="","CLINIC^WARD^OPERATING ROOM"[PREVTYPE,"CLINIC^WARD^OPERATING ROOM"'[CURTYPE DO
. . . SET WLIEN=$$HLTOWL^LRJSMLA1(HLIEN)
. . . SET RMBDIEN=0
. . . FOR SET RMBDIEN=$O(^DG(405.4,"W",WLIEN,RMBDIEN)) QUIT:'RMBDIEN DO
. . . . SET RMBDUNQ(+RMBDIEN,"DELETED100")="^^"_(+RMBDIEN)_"^"_$P($G(^DG(405.4,RMBDIEN,0)),"^",1)_"^"_$P($G(^DG(405.4,RMBDIEN,0)),"^",1)
. . . ;
. IF IGNORE=1 D QUIT
. . KILL @OUT@(HLIEN)
. ;
. ; store HL record in output array
. SET HLSORT="SORT2RAW"
. IF CUR("HL","FLAG")="NEW" SET HLSORT="SORT1RAW"
. IF "NEW^CURRENT"[CUR("HL","FLAG") SET @OUT@(HLSORT,HLIEN,0,CUR("HL","FLAG"))=$$BLDHLREC(.CUR)
. IF "CURRENT"[CUR("HL","FLAG") SET @OUT@(HLSORT,HLIEN,0,PREV("HL","FLAG"))=$$BLDHLREC(.PREV)
. ;
. KILL RMBDLIST
. ;
. IF HLSORT="SORT1RAW" DO
. . SET NEWCUR=@OUT@(HLSORT,HLIEN,0,"NEW")
. . SET PREVIOUS=$P(NEWCUR,"^",1,3)_"^^^^^"
. IF HLSORT="SORT2RAW" DO
. . SET NEWCUR=@OUT@(HLSORT,HLIEN,0,"CURRENT")
. . SET PREVIOUS=@OUT@(HLSORT,HLIEN,0,"PREVIOUS")
. ;
. ; Build the NEW, CURRENT/PREVIOUS ROOM and BED records.
. SET NODE="RMBDUNQ"
. ;
. ;NOTE: -.235681 is the "BEDNAME" subscript on ROOM node to assure the ROOM node of the
. ; array is ordered before BED node.
. ; -.235681 not a legitimate BED name in .01 field of the ROOM-BED file
. ; .01 Input transform will prevent entry of -.235681 for bed name via FileMan
. FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO
. . SET ROOMNAME=$P($P(@NODE,"^",5),"-",1)
. . SET BEDNAME=$P($P(@NODE,"^",5),"-",2,3)
. . SET OLDRMNM=$P($P(@NODE,"^",4),"-",1)
. . SET OLDBDNM=$P($P(@NODE,"^",4),"-",2,3)
. . SET FLAG=$QS(NODE,2)
. . SET RBIEN=$QS(NODE,1)
. . ;
. . IF CUR("HL","FLAG")="NEW" DO
. . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"NEW")="NEW^ROOM^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
. . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"NEW")="NEW^BED^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"_BEDNAME
. . ELSE DO
. . . IF FLAG="DELETED100" DO
. . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"CURRENT")="CURRENT^ROOM^"_$P(NEWCUR,"^",3,7)_"^^"
. . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"PREVIOUS")="PREVIOUS^ROOM^"_$P(PREVIOUS,"^",3,7)_"^"_ROOMNAME_"^"
. . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"ACUR")="CURRENT^BED^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
. . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"APREV")="PREVIOUS^BED^"_$P(PREVIOUS,"^",3,7)_"^"_OLDRMNM_"^"_OLDBDNM
. . . ELSE DO
. . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"CURRENT")="CURRENT^ROOM^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
. . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"PREVIOUS")="PREVIOUS^ROOM^"_$P(PREVIOUS,"^",3,7)_"^"_ROOMNAME_"^"
. . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"ACUR")="CURRENT^BED^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"_BEDNAME
. . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"APREV")="PREVIOUS^BED^"_$P(PREVIOUS,"^",3,7)_"^"_OLDRMNM_"^"_OLDBDNM
. ;
. MERGE @OUT@(HLSORT,HLIEN)=RMBDLIST
;
KILL @REVNODE
QUIT
;
BLDHLREC(RES) ; return the record from RES array.
; Input:
; RES - new/current or previous results from audit file and file 44
; Output:
; Return the record
NEW X
SET X=RES("HL","FLAG") ; flag (.e.g. NEW, CURRENT, PREVIOUS)
SET X=X_"^"_RES("HL","NAME") ; Record Type ( only "LOCATION")
SET X=X_"^"_RES("HL",.001) ; file 44 ien
SET X=X_"^"_RES("HL",.01) ; HL Name
SET X=X_"^"_RES("HL",2) ; Type of file 44 entry
SET X=X_"^"_RES("HL",3) ; Institution
SET X=X_"^"_RES("HL",3.5) ; Division
SET X=X_"^"_RES("HL",2505) ; Inactivation Date
SET X=X_"^"_RES("HL",2506) ; Reactivation Date
;
IF (RES("HL","FLAG")="NEW")!(RES("HL","FLAG")="CURRENT") DO
. SET X=X_"^"_RES("HL","USER") ; Accessed by (editing person)
. SET X=X_"^"_RES("HL","DTR") ; Date/Time of Change
QUIT X
;
ROLLUP(HLIEN,CUR,NARR,TO) ; roll back the CUR HL values from current time back to "TO" time
; Input:
; HLIEN - HL ien.
; NARR - array containing the audit file data for given HL
; CUR - array containing HL data.
; TO - End Date for extract
; Output:
; CUR - array containing HL data.
;
NEW NODE,NFLDNUM,RBIEN,NEWIENV,OLDIENV,NEWVAL,OLDVAL,USER,DTR,ENTNM
NEW REVNARR,RNODE
; Reverse the order of NARR array by date/time (first subscript) from highest to lowest
SET NODE="NARR"
FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO
. SET RNODE="REVNARR("_(9999999-$QS(NODE,1))
. FOR I=2:1 QUIT:$QS(NODE,I)="" SET RNODE=RNODE_","_$QS(NODE,I)
. SET RNODE=RNODE_")"
. SET @RNODE=@NODE
;
SET NODE="REVNARR"
FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO
. SET DTR=$P(@NODE,"^",6) ; Date/Time Recorded
. QUIT:'(DTR>TO)
. SET NFLDNUM=$QS(NODE,4) ; field number
. SET RBIEN=$QS(NODE,3) ; room-bed ien
. SET OLDVAL=$P(@NODE,"^",4) ; Old value (from last audit after "TO" date/time
. ; if change HL or Ward Location (room-bed ien is 0)
. ; rollback the current value to old value.
. IF RBIEN=0 DO
. . SET CUR("HL",NFLDNUM)=OLDVAL
Q
;
GHL(HLIEN,CUR) ; get the fields that are to be reported for given HL into CUR array
; Input:
; HLIEN - Hosp Loc ien.
; Output:
; CUR - array containing hosiptal location data.
NEW ARR,FILENUM
SET FILENUM=44
SET HLIEN=+HLIEN
;
;IA #10040 for Fileman ref (GETS^DIQ) into file 44 (Hospital Location)
DO GETS^DIQ(FILENUM,HLIEN_",",$$GRPTLST^LRJSMLA1(FILENUM,2),"IE","ARR")
SET CUR("HL",.001)=HLIEN ; ien
SET CUR("HL",.01)=ARR(44,HLIEN_",",.01,"E") ; HL name
SET CUR("HL",2)=ARR(44,HLIEN_",",2,"E") ; type
SET CUR("HL",3)=ARR(44,HLIEN_",",3,"E") ; institution
SET CUR("HL",3.5)=ARR(44,HLIEN_",",3.5,"E") ; division
SET CUR("HL",2505)=ARR(44,HLIEN_",",2505,"E") ; inactivation date
SET CUR("HL",2506)=ARR(44,HLIEN_",",2506,"E") ; reactivation date
SET CUR("HL","NAME")="LOCATION"
QUIT
;
CURRMBED(LRARRY,RBIEN) ; Find value of Room-Bed after last change before End-Date
;INPUT:
; LRARRY - "NARR" Array name for local array with form:
; NARR(date time recorded, Ward Location ien, room-bed ien and ward(s) sub-file, field number, audit file ien)
; Node data = new internal value (NULL) ^ old internal value (NULL) ^ new value ^ old value ^ user ^ data time recorded ^ audit file entry name
;
; RBIEN - Room-Bed IEN
;
;OUTPUT:
; LRRMBD - Current Room-Bed just prior to Change Report "End Date"
;
NEW LRWLN,LRRBWN,LRFN,LRAUDN,LRLASTDT
;
;[Two Room-Bed Audit records will not have the same dt/tm]
SET (LRLASTDT,LRWLN,LRRBWN)=""
FOR SET LRRBWN=$$RBIENCK(.LRLASTDT,.LRWLN,LRARRY) Q:LRRBWN=RBIEN
;
SET LRFN=$O(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,"")) ;Get field number
;
; Find last audit file ien subscript
SET LRAUDN=$O(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,LRFN,""),-1)
QUIT $P(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,LRFN,LRAUDN),"^",3) ;Return "Changed to" Rm-Bed for last entry
;
RBIENCK(LRLSTDT,LRWLN,LRARRY) ; Check for correct Room-Bed IEN
;INPUT:
; LRLSTDT - Date of Last Change being processed [Passed by Reference]
; LRWLN - IEN for Ward-Location being processed [Passed by Reference]
; LRARRY - "NARR" Array name for local array [Passed from CURRMBED]
;
;OUTPUT:
; Room-Bed IEN and Ward(s) sub-file just prior to "End Date" being processed
;
SET LRLSTDT=$O(@LRARRY@(LRLSTDT),-1) ;Get last date
;
SET LRWLN=$O(@LRARRY@(LRLSTDT,"")) ;Get Ward Location ien
;
QUIT $O(@LRARRY@(LRLSTDT,LRWLN,"")) ;Return Room-Bed IEN and Ward(s) sub-file
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRJSMLA 19203 printed Apr 09, 2024@21:20:27 Page 2
LRJSMLA ;ALB/PO,GTS Lab Hospital Location Update Notification ;02/24/2010 11:45:51
+1 ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
+2 ;
+3 ;
+4 ;IA #1380 allows references to ^DG(405.4
+5 ;
BLDREC(LRFR,LRTO,LRES,LRTYPE) ; -- output the HLCMS updates
+1 ; Input:
+2 ; LRFR - start time to report the raw data for.
+3 ; LRTO - end to report the raw data.
+4 ; LRES - Root for array that defines result data
+5 ; LRTYPE - report type
+6 ; 1: do not report records that that have changed
+7 ; but returned back to its original values (Default)
+8 ; 2: report all reocrds
+9 ; Output:
+10 ; @OUT@(seguence number) - array containing the results
+11 ;
+12 NEW NODE,OUT,I,NOFFSET,KEEPHL,KEEPRM,KEEPBED,LRTMP,LAST,CURDATA,PREVDATA,TOTALRM,TOTALBED,LRCHAR
+13 ; if LRTYPE not defined, default type 1
SET LRTYPE=$GET(LRTYPE,1)
+14 SET OUT=$NAME(@LRES@("OUT"))
+15 SET LRCHAR=0
+16 DO IOXY^XGF(IOSL-1,52)
+17 WRITE "[Extract HL Changes..."
+18 DO BLDRAW(LRFR,LRTO,OUT)
+19 ;
+20 FOR NOFFSET=1:1
if $QSUBSCRIPT(OUT,NOFFSET)="OUT"
QUIT
+21 SET LRTMP=$NAME(@LRES@("TMP"))
+22 SET NODE=$NAME(@OUT@("SORT1RAW"))
+23 FOR I=1:1
SET NODE=$QUERY(@NODE)
if $EXTRACT(NODE,1,$LENGTH(OUT)-1)'=$EXTRACT(OUT,1,$LENGTH(OUT)-1)
QUIT
Begin DoDot:1
+24 DO HANGCHAR^LRJSMLU(.LRCHAR)
+25 if LRTYPE=1
SET @LRTMP@(I)=@NODE
+26 if LRTYPE=2
SET @LRES@(I)=@NODE
End DoDot:1
+27 KILL @OUT
+28 if LRTYPE=2
QUIT
+29 ; Continue for report type 1 starting from last node and remove BED, ROOM or LOCATION
+30 ; to remove records that are not changed (actually ones that have changed and returned back
+31 ; to original values)
+32 SET LAST=$ORDER(@LRTMP@(""),-1)
+33 SET TOTALRM=0
+34 SET TOTALBED=0
+35 SET I=LAST+2
+36 ;I=LAST:-1:1 DO
FOR
SET I=I-2
if I<2
QUIT
Begin DoDot:1
+37 DO HANGCHAR^LRJSMLU(.LRCHAR)
+38 SET PREVDATA=$GET(@LRTMP@(I))
+39 ; got to NEW records, don't care any more
IF (PREVDATA="")!($PIECE(PREVDATA,"^",1)="NEW")
SET I=0
QUIT
+40 SET CURDATA=$GET(@LRTMP@(I-1))
+41 IF $PIECE(PREVDATA,"^",1)="PREVIOUS"
Begin DoDot:2
+42 ;
+43 IF $PIECE(PREVDATA,"^",2)="BED"
Begin DoDot:3
+44 IF $PIECE(PREVDATA,"^",8,9)=$PIECE(CURDATA,"^",8,9)
Begin DoDot:4
+45 KILL @LRTMP@(I),@LRTMP@(I-1)
End DoDot:4
+46 IF '$TEST
SET TOTALBED=TOTALBED+1
End DoDot:3
+47 ;
+48 IF '$TEST
IF $PIECE(PREVDATA,"^",2)="ROOM"
Begin DoDot:3
+49 IF TOTALBED=0
Begin DoDot:4
+50 KILL @LRTMP@(I),@LRTMP@(I-1)
End DoDot:4
+51 IF '$TEST
SET TOTALRM=TOTALRM+1
+52 ; initialize the total number of beds for next room encounter
SET TOTALBED=0
End DoDot:3
+53 IF '$TEST
IF $PIECE(PREVDATA,"^",2)="LOCATION"
Begin DoDot:3
+54 IF TOTALRM=0
IF $PIECE(PREVDATA,"^",4,9)="^^^^^"
Begin DoDot:4
+55 KILL @LRTMP@(I),@LRTMP@(I-1)
End DoDot:4
+56 IF '$TEST
SET (TOTALRM,TOTALBED)=0
End DoDot:3
End DoDot:2
End DoDot:1
+57 ;
+58 SET NODE=LRTMP
+59 FOR I=1:1
SET NODE=$QUERY(@NODE)
if $EXTRACT(NODE,1,$LENGTH(LRTMP)-1)'=$EXTRACT(LRTMP,1,$LENGTH(LRTMP)-1)
QUIT
SET @LRES@(I)=@NODE
+60 IF '$DATA(@LRES@(1))
SET @LRES@(1)=" NO CHANGES FOUND!!"
+61 KILL @LRTMP
+62 ;
+63 QUIT
+64 ;
BLDRAW(LRFR,LRTO,OUT) ; -- build raw data for given time interval into @OUT array
+1 ; Input:
+2 ; LRFR - start date/time for raw data report
+3 ; LRTO - end date/time for raw data report
+4 ; OUT - Name of array holding raw data
+5 ; Output:
+6 ; @OUT@ - array in the following format.
+7 ; @OUT@(sort order, HL ien, 0, "CURRENT" or "PREVIOUS" or "NEW") = CURRENT or PREVIOUS or NEW HL field values
+8 ; @OUT@(sort order, HL ien,"AAAROOM", room value,-.235681, "CURRENT" or "PREVIOUS" or "NEW")=CURRENT or PREVIOUS or NEW room field values
+9 ; @OUT@(sort order, HL ien,"AAAROOM", room value, bed value, "CURRENT" or "PREVIOUS" or "NEW")=CURRENT or PREVIOUS or NEW bed field values
+10 ; e.g.
+11 ;
+12 ; @OUT@("SORT2RAW",432,0,"CURRENT")="CURRENT^LOCATION^432^ZZW 100Ar^WARD^ALABAMA^TROY^^^OSTOVARI,PARVIZ^3081208.165853"
+13 ; @OUT@("SORT2RAW",432,0,"PREVIOUS")="PREVIOUS^LOCATION^432^ZZW 100A^^ALBANY AREA^DEVVLD^^"
+14 ; @OUT@("SORT2RAW",432,"AAAROOM",1001,-.235681,"CURRENT")="CURRENT^ROOM^432^ZZW 100Ar^WARD^ALABAMA^TROY^^"
+15 ; @OUT@("SORT2RAW",432,"AAAROOM",1001,-.235681,"PREVIOUS")="PREVIOUS^ROOM^432^ZZW 100A^^ALBANY AREA^DEVVLD^1001^"
+16 ; @OUT@("SORT2RAW",432,"AAAROOM",1001,"AB","ACUR")="CURRENT^BED^432^ZZW 100Ar^WARD^ALABAMA^TROY^1001^"
+17 ; @OUT@("SORT2RAW",432,"AAAROOM",1001,"AB","APREV")="PREVIOUS^BED^432^ZZW100A^^ALBANY AREA^DEVVLD^1001^AB"
+18 ;
+19 NEW CUR,PREV,MOD,REVNODE,HLIEN,NFLDNUM,RBIEN,NEWIENV,OLDIENV,NEWVAL,OLDVAL,USER,DTR,ENTNM,RBIEN,RMBD,RMBDUNQ,NODE,NARR,CURMBD,FLDNUM,HLSORT
+20 NEW NEWCUR,OLDBDNM,OLDRMNM,PREVIOUS,ROOMNAME,FLAG,BEDNAME,RMBDLIST,WLIEN,RMBDIEN
+21 NEW CURTYPE,PREVTYPE,IGNORE,ACTDT,INACTDT,LRCHAR
+22 SET LRCHAR=0
+23 ;
+24 SET REVNODE=$NAME(@OUT@("REVARR"))
+25 KILL @OUT,@REVNODE
+26 ;
+27 ;
+28 ; sort audit records; reverse HL and room-bed changes.
+29 DO SRTCHG^LRJSMLA1(LRFR,LRTO,REVNODE)
+30 ;
+31 ; for each HL ien, check to see if the entry is new or modified.
+32 SET HLIEN=0
+33 FOR
SET HLIEN=$ORDER(@REVNODE@("N",HLIEN))
if 'HLIEN
QUIT
IF $DATA(^SC(HLIEN))
Begin DoDot:1
+34 DO HANGCHAR^LRJSMLU(.LRCHAR)
+35 KILL ARR,MOD,NARR,CUR,PREV,RMBD,RMBDUNQ
+36 SET (ACTDT,INACTDT)=""
+37 ; get the current values for this HL
+38 ;Returns current Hosp Loc fields from file 44
DO GHL(HLIEN,.CUR)
+39 ;
+40 ; get the changes for this HL into NARR
+41 MERGE NARR=@REVNODE@("N",HLIEN)
+42 ;
+43 ;CUR - current values of HL fields
+44 ;Roll back current HL values from current time to "TO" time
DO ROLLUP(HLIEN,.CUR,.NARR,LRTO)
+45 ;*Remove Room-Bed edits made before RM-BD added to Ward-Location
DO CLNUP^LRJSMLA1(.NARR)
+46 ;
+47 ; HL record flag
SET CUR("HL","FLAG")="CURRENT"
+48 ; HL record type
SET CUR("HL","NAME")="LOCATION"
+49 ;
+50 ; find out which node is new and which one is current.
+51 SET NODE="NARR"
+52 FOR
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
Begin DoDot:2
+53 ; Date/Time Recorded
SET DTR=$PIECE(@NODE,"^",6)
+54 ; quit if Date/time recorded is in future.
if DTR>LRTO
QUIT
+55 ; field number
SET NFLDNUM=$QSUBSCRIPT(NODE,4)
+56 ; room-bed ien
SET RBIEN=$QSUBSCRIPT(NODE,3)
+57 ; New IEN value
SET NEWIENV=$PIECE(@NODE,"^",1)
+58 ; Old IEN value
SET OLDIENV=$PIECE(@NODE,"^",2)
+59 ; New value
SET NEWVAL=$PIECE(@NODE,"^",3)
+60 ; Old value
SET OLDVAL=$PIECE(@NODE,"^",4)
+61 ; date/time recorded. Last date/time changed for any fields.
if DTR'=""
SET CUR("HL","DTR")=DTR
+62 ; Accessed by (USER)
SET USER=$PIECE(@NODE,"^",5)
+63 ; accessed by (USER). Last user who changed any field.
if USER'=""
SET CUR("HL","USER")=USER
+64 ; Entry Name From Audit File
SET ENTNM=$PIECE(@NODE,"^",7)
+65 ;
+66 ; if change is to HL or Ward Loaction (room-bed ien is 0)
+67 IF RBIEN=0
Begin DoDot:3
+68 ;if HL change is to .01 field with no previous value
+69 IF NFLDNUM=.01
Begin DoDot:4
+70 IF OLDVAL="<no previous value>"
Begin DoDot:5
+71 ; HL record flag
SET CUR("HL","FLAG")="NEW"
End DoDot:5
End DoDot:4
+72 ;
+73 ; if current flag not new, keep track and store the old value data in MOD array
+74 IF $GET(CUR("HL","FLAG"))'="NEW"
Begin DoDot:4
+75 ; store the old value only for the oldest changes for the given field
+76 IF '$DATA(MOD("HL",NFLDNUM))
Begin DoDot:5
+77 ; Old value
SET MOD("HL",NFLDNUM)=OLDVAL
End DoDot:5
End DoDot:4
+78 ;
+79 ; if type is modified
+80 IF NFLDNUM="2"
Begin DoDot:4
+81 ; if type changed from other to clinic/ward/operating room
+82 IF OLDVAL'="<no previous value>"
IF "CLINIC^WARD^OPERATING ROOM"'[OLDVAL
IF "CLINIC^WARD^OPERATING ROOM"[NEWVAL
SET ACTDT=DTR
+83 ;
+84 ; if type changed from clinic/ward/operating room to other.
+85 IF "CLINIC^WARD^OPERATING ROOM"[OLDVAL
IF "CLINIC^WARD^OPERATING ROOM"'[NEWVAL
SET INACTDT=DTR
End DoDot:4
End DoDot:3
+86 ;
+87 ; if this is for Room-bed changes (Note: nodes sorted by date/time from lowest to highest)
+88 ; node value is in the format of:
+89 ; new room-bed ien ^ New Value ^ Old ien ^ Old Value ^ Current Value
+90 IF RBIEN'=0
Begin DoDot:3
+91 ;room bed current value
SET CURMBD=$PIECE($GET(^DG(405.4,+RBIEN,0)),"^")
+92 ; Check room-bed .01 field to see if room bed is new or not
+93 IF (NFLDNUM=".01")
Begin DoDot:4
+94 IF OLDVAL="<no previous value>"
Begin DoDot:5
+95 ; Make sure "CHANGED node does not exist"
KILL RMBDUNQ(+RBIEN,"CHANGE")
+96 ; If already deleted verify DELETED100 node does not exist"
KILL RMBDUNQ(+RBIEN,"DELETED100")
+97 SET RMBDUNQ(+RBIEN,"NEW")=(+RBIEN)_"^"_NEWVAL_"^^^"_$$CURRMBED("NARR",RBIEN)
End DoDot:5
+98 IF '$TEST
Begin DoDot:5
+99 ; Make sure "CHANGED node does not exist"
KILL RMBDUNQ(+RBIEN,"NEW")
+100 ; If it was already deleted make sure DELETED100 node does not exist"
KILL RMBDUNQ(+RBIEN,"DELETED100")
+101 ; only store the first change
+102 if '$DATA(RMBDUNQ(+RBIEN,"CHANGE"))#2
SET RMBDUNQ(+RBIEN,"CHANGE")=(+RBIEN)_"^"_NEWVAL_"^"_(+RBIEN)_"^"_OLDVAL_"^"_$$CURRMBED("NARR",RBIEN)
End DoDot:5
End DoDot:4
+103 ;
+104 ; ward location is added/removed to/from the room-bed
+105 IF (NFLDNUM="100,.01")
Begin DoDot:4
+106 ; if ward location is added to the room-bed.
+107 IF OLDVAL="<no previous value>"
Begin DoDot:5
+108 if '$DATA(RMBDUNQ(+RBIEN,"CHANGE"))
SET RMBDUNQ(+RBIEN,"NEW")=(+RBIEN)_"^"_CURMBD_"^^^"_CURMBD
+109 ; if deleted, verify DELETED100 node does not exist.
KILL RMBDUNQ(+RBIEN,"DELETED100")
+110 ;
End DoDot:5
+111 ; if the the ward location is deleted from the room-bed, make sure not newed.
+112 IF NEWVAL="<deleted>"
Begin DoDot:5
+113 KILL RMBDUNQ(+RBIEN,"NEW")
+114 ; report Entry Name (ENTNM) from audit file
SET RMBDUNQ(+RBIEN,"DELETED100")="^^"_(+RBIEN)_"^"_ENTNM_"^"_CURMBD
End DoDot:5
End DoDot:4
+115 ;
End DoDot:3
End DoDot:2
+116 ;
+117 ; Store results for current HL file entry in CUR and PREV arrays
+118 IF $DATA(CUR("HL","FLAG"))
IF CUR("HL","FLAG")'="NEW"
Begin DoDot:2
+119 MERGE PREV=CUR
+120 SET CUR("HL","FLAG")="CURRENT"
+121 SET PREV("HL","FLAG")="PREVIOUS"
End DoDot:2
+122 ; modify the PREV array from MOD array to record changes for HL file
+123 IF $GET(CUR("HL","FLAG"))=""
SET CUR("HL","FLAG")="CURRENT"
SET PREV("HL","FLAG")="PREVIOUS"
SET CUR("HL",.001)=HLIEN
SET PREV("HL",.001)=HLIEN
SET MOD("HL",.001)=HLIEN
+124 SET FLDNUM=0
FOR
SET FLDNUM=$ORDER(MOD("HL",FLDNUM))
if 'FLDNUM
QUIT
SET PREV("HL",FLDNUM)=MOD("HL",FLDNUM)
+125 SET FLDNUM=0
FOR
SET FLDNUM=$ORDER(PREV("HL",FLDNUM))
if 'FLDNUM
QUIT
if (FLDNUM'=.001)&(PREV("HL",FLDNUM)=$GET(CUR("HL",FLDNUM)))
SET PREV("HL",FLDNUM)=""
+126 ;
+127 ;determine if this HL was reactivated or inactivated.
+128 ; current reactivate date
IF ACTDT'=""
IF ACTDT>INACTDT
SET CUR("HL",2506)=ACTDT
+129 ; current inactivate date
IF INACTDT'=""
IF INACTDT>ACTDT
SET CUR("HL",2505)=INACTDT
+130 ; previous reactive date
IF ACTDT'=""
IF ACTDT<INACTDT
SET PREV("HL",2506)=ACTDT
+131 ; previous inactivate date
IF INACTDT'=""
IF INACTDT<ACTDT
SET PREV("HL",2505)=INACTDT
+132 ;
+133 ; Determine if HL type is changed or not.
+134 ;$P(NEWCUR,"^",5)
SET CURTYPE=CUR("HL",2)
+135 ;$P(PREVIOUS,"^",5)
SET PREVTYPE=$GET(PREV("HL",2))
+136 SET IGNORE=0
+137 IF CUR("HL","FLAG")="NEW"
Begin DoDot:2
+138 ;do not Report this HL.
IF "CLINIC^WARD^OPERATING ROOM"'[CURTYPE
SET IGNORE=1
QUIT
End DoDot:2
+139 IF CUR("HL","FLAG")="CURRENT"
Begin DoDot:2
+140 ;do not Report HL
IF PREVTYPE=""
IF "CLINIC^WARD^OPERATING ROOM"'[CURTYPE
SET IGNORE=1
QUIT
+141 ;
+142 ; if type changed from others to "CLINIC^WARD^OPERATING ROOM" report all room-beds containing location
+143 IF PREVTYPE'=""
IF "CLINIC^WARD^OPERATING ROOM"'[PREVTYPE
IF "CLINIC^WARD^OPERATING ROOM"[CURTYPE
Begin DoDot:3
+144 ; force the HL to be new even though currently exists
SET CUR("HL","FLAG")="NEW"
+145 SET WLIEN=$$HLTOWL^LRJSMLA1(HLIEN)
+146 SET RMBDIEN=0
+147 ;IA #1380 for ^DG(405.4,"W", reference
+148 FOR
SET RMBDIEN=$ORDER(^DG(405.4,"W",WLIEN,RMBDIEN))
if 'RMBDIEN
QUIT
Begin DoDot:4
+149 if $$KEEPBED^LRJSMLA1(+RMBDIEN,$NAME(@OUT@("REVARR","N",HLIEN)))
SET RMBDUNQ(+RMBDIEN,"NEW")=(+RMBDIEN)_"^"_$PIECE($GET(^DG(405.4,RMBDIEN,0)),"^",1)_"^^^"_$PIECE($GET(^DG(405.4,RMBDIEN,0)),"^",1)
End DoDot:4
End DoDot:3
+150 ;
+151 ; if type changed from "CLINIC^WARD^OPERATING ROOM" to others report deleted room-beds containing location
+152 IF PREVTYPE'=""
IF "CLINIC^WARD^OPERATING ROOM"[PREVTYPE
IF "CLINIC^WARD^OPERATING ROOM"'[CURTYPE
Begin DoDot:3
+153 SET WLIEN=$$HLTOWL^LRJSMLA1(HLIEN)
+154 SET RMBDIEN=0
+155 FOR
SET RMBDIEN=$ORDER(^DG(405.4,"W",WLIEN,RMBDIEN))
if 'RMBDIEN
QUIT
Begin DoDot:4
+156 SET RMBDUNQ(+RMBDIEN,"DELETED100")="^^"_(+RMBDIEN)_"^"_$PIECE($GET(^DG(405.4,RMBDIEN,0)),"^",1)_"^"_$PIECE($GET(^DG(405.4,RMBDIEN,0)),"^",1)
End DoDot:4
+157 ;
End DoDot:3
End DoDot:2
+158 IF IGNORE=1
Begin DoDot:2
+159 KILL @OUT@(HLIEN)
End DoDot:2
QUIT
+160 ;
+161 ; store HL record in output array
+162 SET HLSORT="SORT2RAW"
+163 IF CUR("HL","FLAG")="NEW"
SET HLSORT="SORT1RAW"
+164 IF "NEW^CURRENT"[CUR("HL","FLAG")
SET @OUT@(HLSORT,HLIEN,0,CUR("HL","FLAG"))=$$BLDHLREC(.CUR)
+165 IF "CURRENT"[CUR("HL","FLAG")
SET @OUT@(HLSORT,HLIEN,0,PREV("HL","FLAG"))=$$BLDHLREC(.PREV)
+166 ;
+167 KILL RMBDLIST
+168 ;
+169 IF HLSORT="SORT1RAW"
Begin DoDot:2
+170 SET NEWCUR=@OUT@(HLSORT,HLIEN,0,"NEW")
+171 SET PREVIOUS=$PIECE(NEWCUR,"^",1,3)_"^^^^^"
End DoDot:2
+172 IF HLSORT="SORT2RAW"
Begin DoDot:2
+173 SET NEWCUR=@OUT@(HLSORT,HLIEN,0,"CURRENT")
+174 SET PREVIOUS=@OUT@(HLSORT,HLIEN,0,"PREVIOUS")
End DoDot:2
+175 ;
+176 ; Build the NEW, CURRENT/PREVIOUS ROOM and BED records.
+177 SET NODE="RMBDUNQ"
+178 ;
+179 ;NOTE: -.235681 is the "BEDNAME" subscript on ROOM node to assure the ROOM node of the
+180 ; array is ordered before BED node.
+181 ; -.235681 not a legitimate BED name in .01 field of the ROOM-BED file
+182 ; .01 Input transform will prevent entry of -.235681 for bed name via FileMan
+183 FOR
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
Begin DoDot:2
+184 SET ROOMNAME=$PIECE($PIECE(@NODE,"^",5),"-",1)
+185 SET BEDNAME=$PIECE($PIECE(@NODE,"^",5),"-",2,3)
+186 SET OLDRMNM=$PIECE($PIECE(@NODE,"^",4),"-",1)
+187 SET OLDBDNM=$PIECE($PIECE(@NODE,"^",4),"-",2,3)
+188 SET FLAG=$QSUBSCRIPT(NODE,2)
+189 SET RBIEN=$QSUBSCRIPT(NODE,1)
+190 ;
+191 IF CUR("HL","FLAG")="NEW"
Begin DoDot:3
+192 SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"NEW")="NEW^ROOM^"_$PIECE(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
+193 SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"NEW")="NEW^BED^"_$PIECE(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"_BEDNAME
End DoDot:3
+194 IF '$TEST
Begin DoDot:3
+195 IF FLAG="DELETED100"
Begin DoDot:4
+196 SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"CURRENT")="CURRENT^ROOM^"_$PIECE(NEWCUR,"^",3,7)_"^^"
+197 SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"PREVIOUS")="PREVIOUS^ROOM^"_$PIECE(PREVIOUS,"^",3,7)_"^"_ROOMNAME_"^"
+198 SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"ACUR")="CURRENT^BED^"_$PIECE(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
+199 SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"APREV")="PREVIOUS^BED^"_$PIECE(PREVIOUS,"^",3,7)_"^"_OLDRMNM_"^"_OLDBDNM
End DoDot:4
+200 IF '$TEST
Begin DoDot:4
+201 SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"CURRENT")="CURRENT^ROOM^"_$PIECE(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
+202 SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"PREVIOUS")="PREVIOUS^ROOM^"_$PIECE(PREVIOUS,"^",3,7)_"^"_ROOMNAME_"^"
+203 SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"ACUR")="CURRENT^BED^"_$PIECE(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"_BEDNAME
+204 SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"APREV")="PREVIOUS^BED^"_$PIECE(PREVIOUS,"^",3,7)_"^"_OLDRMNM_"^"_OLDBDNM
End DoDot:4
End DoDot:3
End DoDot:2
+205 ;
+206 MERGE @OUT@(HLSORT,HLIEN)=RMBDLIST
End DoDot:1
+207 ;
+208 KILL @REVNODE
+209 QUIT
+210 ;
BLDHLREC(RES) ; return the record from RES array.
+1 ; Input:
+2 ; RES - new/current or previous results from audit file and file 44
+3 ; Output:
+4 ; Return the record
+5 NEW X
+6 ; flag (.e.g. NEW, CURRENT, PREVIOUS)
SET X=RES("HL","FLAG")
+7 ; Record Type ( only "LOCATION")
SET X=X_"^"_RES("HL","NAME")
+8 ; file 44 ien
SET X=X_"^"_RES("HL",.001)
+9 ; HL Name
SET X=X_"^"_RES("HL",.01)
+10 ; Type of file 44 entry
SET X=X_"^"_RES("HL",2)
+11 ; Institution
SET X=X_"^"_RES("HL",3)
+12 ; Division
SET X=X_"^"_RES("HL",3.5)
+13 ; Inactivation Date
SET X=X_"^"_RES("HL",2505)
+14 ; Reactivation Date
SET X=X_"^"_RES("HL",2506)
+15 ;
+16 IF (RES("HL","FLAG")="NEW")!(RES("HL","FLAG")="CURRENT")
Begin DoDot:1
+17 ; Accessed by (editing person)
SET X=X_"^"_RES("HL","USER")
+18 ; Date/Time of Change
SET X=X_"^"_RES("HL","DTR")
End DoDot:1
+19 QUIT X
+20 ;
ROLLUP(HLIEN,CUR,NARR,TO) ; roll back the CUR HL values from current time back to "TO" time
+1 ; Input:
+2 ; HLIEN - HL ien.
+3 ; NARR - array containing the audit file data for given HL
+4 ; CUR - array containing HL data.
+5 ; TO - End Date for extract
+6 ; Output:
+7 ; CUR - array containing HL data.
+8 ;
+9 NEW NODE,NFLDNUM,RBIEN,NEWIENV,OLDIENV,NEWVAL,OLDVAL,USER,DTR,ENTNM
+10 NEW REVNARR,RNODE
+11 ; Reverse the order of NARR array by date/time (first subscript) from highest to lowest
+12 SET NODE="NARR"
+13 FOR
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
Begin DoDot:1
+14 SET RNODE="REVNARR("_(9999999-$QSUBSCRIPT(NODE,1))
+15 FOR I=2:1
if $QSUBSCRIPT(NODE,I)=""
QUIT
SET RNODE=RNODE_","_$QSUBSCRIPT(NODE,I)
+16 SET RNODE=RNODE_")"
+17 SET @RNODE=@NODE
End DoDot:1
+18 ;
+19 SET NODE="REVNARR"
+20 FOR
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
Begin DoDot:1
+21 ; Date/Time Recorded
SET DTR=$PIECE(@NODE,"^",6)
+22 if '(DTR>TO)
QUIT
+23 ; field number
SET NFLDNUM=$QSUBSCRIPT(NODE,4)
+24 ; room-bed ien
SET RBIEN=$QSUBSCRIPT(NODE,3)
+25 ; Old value (from last audit after "TO" date/time
SET OLDVAL=$PIECE(@NODE,"^",4)
+26 ; if change HL or Ward Location (room-bed ien is 0)
+27 ; rollback the current value to old value.
+28 IF RBIEN=0
Begin DoDot:2
+29 SET CUR("HL",NFLDNUM)=OLDVAL
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
GHL(HLIEN,CUR) ; get the fields that are to be reported for given HL into CUR array
+1 ; Input:
+2 ; HLIEN - Hosp Loc ien.
+3 ; Output:
+4 ; CUR - array containing hosiptal location data.
+5 NEW ARR,FILENUM
+6 SET FILENUM=44
+7 SET HLIEN=+HLIEN
+8 ;
+9 ;IA #10040 for Fileman ref (GETS^DIQ) into file 44 (Hospital Location)
+10 DO GETS^DIQ(FILENUM,HLIEN_",",$$GRPTLST^LRJSMLA1(FILENUM,2),"IE","ARR")
+11 ; ien
SET CUR("HL",.001)=HLIEN
+12 ; HL name
SET CUR("HL",.01)=ARR(44,HLIEN_",",.01,"E")
+13 ; type
SET CUR("HL",2)=ARR(44,HLIEN_",",2,"E")
+14 ; institution
SET CUR("HL",3)=ARR(44,HLIEN_",",3,"E")
+15 ; division
SET CUR("HL",3.5)=ARR(44,HLIEN_",",3.5,"E")
+16 ; inactivation date
SET CUR("HL",2505)=ARR(44,HLIEN_",",2505,"E")
+17 ; reactivation date
SET CUR("HL",2506)=ARR(44,HLIEN_",",2506,"E")
+18 SET CUR("HL","NAME")="LOCATION"
+19 QUIT
+20 ;
CURRMBED(LRARRY,RBIEN) ; Find value of Room-Bed after last change before End-Date
+1 ;INPUT:
+2 ; LRARRY - "NARR" Array name for local array with form:
+3 ; NARR(date time recorded, Ward Location ien, room-bed ien and ward(s) sub-file, field number, audit file ien)
+4 ; Node data = new internal value (NULL) ^ old internal value (NULL) ^ new value ^ old value ^ user ^ data time recorded ^ audit file entry name
+5 ;
+6 ; RBIEN - Room-Bed IEN
+7 ;
+8 ;OUTPUT:
+9 ; LRRMBD - Current Room-Bed just prior to Change Report "End Date"
+10 ;
+11 NEW LRWLN,LRRBWN,LRFN,LRAUDN,LRLASTDT
+12 ;
+13 ;[Two Room-Bed Audit records will not have the same dt/tm]
+14 SET (LRLASTDT,LRWLN,LRRBWN)=""
+15 FOR
SET LRRBWN=$$RBIENCK(.LRLASTDT,.LRWLN,LRARRY)
if LRRBWN=RBIEN
QUIT
+16 ;
+17 ;Get field number
SET LRFN=$ORDER(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,""))
+18 ;
+19 ; Find last audit file ien subscript
+20 SET LRAUDN=$ORDER(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,LRFN,""),-1)
+21 ;Return "Changed to" Rm-Bed for last entry
QUIT $PIECE(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,LRFN,LRAUDN),"^",3)
+22 ;
RBIENCK(LRLSTDT,LRWLN,LRARRY) ; Check for correct Room-Bed IEN
+1 ;INPUT:
+2 ; LRLSTDT - Date of Last Change being processed [Passed by Reference]
+3 ; LRWLN - IEN for Ward-Location being processed [Passed by Reference]
+4 ; LRARRY - "NARR" Array name for local array [Passed from CURRMBED]
+5 ;
+6 ;OUTPUT:
+7 ; Room-Bed IEN and Ward(s) sub-file just prior to "End Date" being processed
+8 ;
+9 ;Get last date
SET LRLSTDT=$ORDER(@LRARRY@(LRLSTDT),-1)
+10 ;
+11 ;Get Ward Location ien
SET LRWLN=$ORDER(@LRARRY@(LRLSTDT,""))
+12 ;
+13 ;Return Room-Bed IEN and Ward(s) sub-file
QUIT $ORDER(@LRARRY@(LRLSTDT,LRWLN,""))
