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