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

LRJSMLA.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ;IA #1380 allows references to ^DG(405.4
  1. ;
  1. BLDREC(LRFR,LRTO,LRES,LRTYPE) ; -- output the HLCMS updates
  1. ; Input:
  1. ; LRFR - start time to report the raw data for.
  1. ; LRTO - end to report the raw data.
  1. ; LRES - Root for array that defines result data
  1. ; LRTYPE - report type
  1. ; 1: do not report records that that have changed
  1. ; but returned back to its original values (Default)
  1. ; 2: report all reocrds
  1. ; Output:
  1. ; @OUT@(seguence number) - array containing the results
  1. ;
  1. NEW NODE,OUT,I,NOFFSET,KEEPHL,KEEPRM,KEEPBED,LRTMP,LAST,CURDATA,PREVDATA,TOTALRM,TOTALBED,LRCHAR
  1. SET LRTYPE=$G(LRTYPE,1) ; if LRTYPE not defined, default type 1
  1. SET OUT=$NAME(@LRES@("OUT"))
  1. SET LRCHAR=0
  1. DO IOXY^XGF(IOSL-1,52)
  1. WRITE "[Extract HL Changes..."
  1. DO BLDRAW(LRFR,LRTO,OUT)
  1. ;
  1. FOR NOFFSET=1:1 QUIT:$QS(OUT,NOFFSET)="OUT"
  1. SET LRTMP=$NAME(@LRES@("TMP"))
  1. SET NODE=$NAME(@OUT@("SORT1RAW"))
  1. FOR I=1:1 SET NODE=$Q(@NODE) QUIT:$E(NODE,1,$L(OUT)-1)'=$E(OUT,1,$L(OUT)-1) DO
  1. . D HANGCHAR^LRJSMLU(.LRCHAR)
  1. . SET:LRTYPE=1 @LRTMP@(I)=@NODE
  1. . SET:LRTYPE=2 @LRES@(I)=@NODE
  1. KILL @OUT
  1. QUIT:LRTYPE=2
  1. ; Continue for report type 1 starting from last node and remove BED, ROOM or LOCATION
  1. ; to remove records that are not changed (actually ones that have changed and returned back
  1. ; to original values)
  1. SET LAST=$O(@LRTMP@(""),-1)
  1. SET TOTALRM=0
  1. SET TOTALBED=0
  1. SET I=LAST+2
  1. FOR SET I=I-2 QUIT:I<2 DO ;I=LAST:-1:1 DO
  1. . D HANGCHAR^LRJSMLU(.LRCHAR)
  1. . SET PREVDATA=$G(@LRTMP@(I))
  1. . IF (PREVDATA="")!($P(PREVDATA,"^",1)="NEW") SET I=0 QUIT ; got to NEW records, don't care any more
  1. . SET CURDATA=$G(@LRTMP@(I-1))
  1. . IF $P(PREVDATA,"^",1)="PREVIOUS" DO
  1. . . ;
  1. . . IF $P(PREVDATA,"^",2)="BED" DO
  1. . . . IF $P(PREVDATA,"^",8,9)=$P(CURDATA,"^",8,9) DO
  1. . . . . KILL @LRTMP@(I),@LRTMP@(I-1)
  1. . . . ELSE SET TOTALBED=TOTALBED+1
  1. . . ;
  1. . . ELSE IF $P(PREVDATA,"^",2)="ROOM" DO
  1. . . . IF TOTALBED=0 DO
  1. . . . . KILL @LRTMP@(I),@LRTMP@(I-1)
  1. . . . ELSE SET TOTALRM=TOTALRM+1
  1. . . . SET TOTALBED=0 ; initialize the total number of beds for next room encounter
  1. . . ELSE IF $P(PREVDATA,"^",2)="LOCATION" DO
  1. . . . IF TOTALRM=0,$P(PREVDATA,"^",4,9)="^^^^^" DO
  1. . . . . KILL @LRTMP@(I),@LRTMP@(I-1)
  1. . . . ELSE SET (TOTALRM,TOTALBED)=0
  1. ;
  1. SET NODE=LRTMP
  1. 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
  1. IF '$D(@LRES@(1)) SET @LRES@(1)=" NO CHANGES FOUND!!"
  1. KILL @LRTMP
  1. ;
  1. QUIT
  1. ;
  1. BLDRAW(LRFR,LRTO,OUT) ; -- build raw data for given time interval into @OUT array
  1. ; Input:
  1. ; LRFR - start date/time for raw data report
  1. ; LRTO - end date/time for raw data report
  1. ; OUT - Name of array holding raw data
  1. ; Output:
  1. ; @OUT@ - array in the following format.
  1. ; @OUT@(sort order, HL ien, 0, "CURRENT" or "PREVIOUS" or "NEW") = CURRENT or PREVIOUS or NEW HL field values
  1. ; @OUT@(sort order, HL ien,"AAAROOM", room value,-.235681, "CURRENT" or "PREVIOUS" or "NEW")=CURRENT or PREVIOUS or NEW room field values
  1. ; @OUT@(sort order, HL ien,"AAAROOM", room value, bed value, "CURRENT" or "PREVIOUS" or "NEW")=CURRENT or PREVIOUS or NEW bed field values
  1. ; e.g.
  1. ;
  1. ; @OUT@("SORT2RAW",432,0,"CURRENT")="CURRENT^LOCATION^432^ZZW 100Ar^WARD^ALABAMA^TROY^^^OSTOVARI,PARVIZ^3081208.165853"
  1. ; @OUT@("SORT2RAW",432,0,"PREVIOUS")="PREVIOUS^LOCATION^432^ZZW 100A^^ALBANY AREA^DEVVLD^^"
  1. ; @OUT@("SORT2RAW",432,"AAAROOM",1001,-.235681,"CURRENT")="CURRENT^ROOM^432^ZZW 100Ar^WARD^ALABAMA^TROY^^"
  1. ; @OUT@("SORT2RAW",432,"AAAROOM",1001,-.235681,"PREVIOUS")="PREVIOUS^ROOM^432^ZZW 100A^^ALBANY AREA^DEVVLD^1001^"
  1. ; @OUT@("SORT2RAW",432,"AAAROOM",1001,"AB","ACUR")="CURRENT^BED^432^ZZW 100Ar^WARD^ALABAMA^TROY^1001^"
  1. ; @OUT@("SORT2RAW",432,"AAAROOM",1001,"AB","APREV")="PREVIOUS^BED^432^ZZW100A^^ALBANY AREA^DEVVLD^1001^AB"
  1. ;
  1. NEW CUR,PREV,MOD,REVNODE,HLIEN,NFLDNUM,RBIEN,NEWIENV,OLDIENV,NEWVAL,OLDVAL,USER,DTR,ENTNM,RBIEN,RMBD,RMBDUNQ,NODE,NARR,CURMBD,FLDNUM,HLSORT
  1. NEW NEWCUR,OLDBDNM,OLDRMNM,PREVIOUS,ROOMNAME,FLAG,BEDNAME,RMBDLIST,WLIEN,RMBDIEN
  1. NEW CURTYPE,PREVTYPE,IGNORE,ACTDT,INACTDT,LRCHAR
  1. SET LRCHAR=0
  1. ;
  1. SET REVNODE=$NAME(@OUT@("REVARR"))
  1. KILL @OUT,@REVNODE
  1. ;
  1. ;
  1. ; sort audit records; reverse HL and room-bed changes.
  1. DO SRTCHG^LRJSMLA1(LRFR,LRTO,REVNODE)
  1. ;
  1. ; for each HL ien, check to see if the entry is new or modified.
  1. SET HLIEN=0
  1. FOR SET HLIEN=$O(@REVNODE@("N",HLIEN)) Q:'HLIEN I $D(^SC(HLIEN)) DO
  1. . D HANGCHAR^LRJSMLU(.LRCHAR)
  1. . KILL ARR,MOD,NARR,CUR,PREV,RMBD,RMBDUNQ
  1. . SET (ACTDT,INACTDT)=""
  1. . ; get the current values for this HL
  1. . DO GHL(HLIEN,.CUR) ;Returns current Hosp Loc fields from file 44
  1. . ;
  1. . ; get the changes for this HL into NARR
  1. . MERGE NARR=@REVNODE@("N",HLIEN)
  1. . ;
  1. . ;CUR - current values of HL fields
  1. . DO ROLLUP(HLIEN,.CUR,.NARR,LRTO) ;Roll back current HL values from current time to "TO" time
  1. . DO CLNUP^LRJSMLA1(.NARR) ;*Remove Room-Bed edits made before RM-BD added to Ward-Location
  1. . ;
  1. . SET CUR("HL","FLAG")="CURRENT" ; HL record flag
  1. . SET CUR("HL","NAME")="LOCATION" ; HL record type
  1. . ;
  1. . ; find out which node is new and which one is current.
  1. . SET NODE="NARR"
  1. . FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO
  1. . . SET DTR=$P(@NODE,"^",6) ; Date/Time Recorded
  1. . . QUIT:DTR>LRTO ; quit if Date/time recorded is in future.
  1. . . SET NFLDNUM=$QS(NODE,4) ; field number
  1. . . SET RBIEN=$QS(NODE,3) ; room-bed ien
  1. . . SET NEWIENV=$P(@NODE,"^",1) ; New IEN value
  1. . . SET OLDIENV=$P(@NODE,"^",2) ; Old IEN value
  1. . . SET NEWVAL=$P(@NODE,"^",3) ; New value
  1. . . SET OLDVAL=$P(@NODE,"^",4) ; Old value
  1. . . SET:DTR'="" CUR("HL","DTR")=DTR ; date/time recorded. Last date/time changed for any fields.
  1. . . SET USER=$P(@NODE,"^",5) ; Accessed by (USER)
  1. . . SET:USER'="" CUR("HL","USER")=USER ; accessed by (USER). Last user who changed any field.
  1. . . SET ENTNM=$P(@NODE,"^",7) ; Entry Name From Audit File
  1. . . ;
  1. . . ; if change is to HL or Ward Loaction (room-bed ien is 0)
  1. . . IF RBIEN=0 DO
  1. . . . ;if HL change is to .01 field with no previous value
  1. . . . IF NFLDNUM=.01 DO
  1. . . . . IF OLDVAL="<no previous value>" DO
  1. . . . . . SET CUR("HL","FLAG")="NEW" ; HL record flag
  1. . . . ;
  1. . . . ; if current flag not new, keep track and store the old value data in MOD array
  1. . . . IF $G(CUR("HL","FLAG"))'="NEW" DO
  1. . . . . ; store the old value only for the oldest changes for the given field
  1. . . . . IF '$D(MOD("HL",NFLDNUM)) DO
  1. . . . . . SET MOD("HL",NFLDNUM)=OLDVAL ; Old value
  1. . . . ;
  1. . . . ; if type is modified
  1. . . . IF NFLDNUM="2" DO
  1. . . . . ; if type changed from other to clinic/ward/operating room
  1. . . . . IF OLDVAL'="<no previous value>","CLINIC^WARD^OPERATING ROOM"'[OLDVAL,"CLINIC^WARD^OPERATING ROOM"[NEWVAL SET ACTDT=DTR
  1. . . . . ;
  1. . . . . ; if type changed from clinic/ward/operating room to other.
  1. . . . . IF "CLINIC^WARD^OPERATING ROOM"[OLDVAL,"CLINIC^WARD^OPERATING ROOM"'[NEWVAL SET INACTDT=DTR
  1. . . ;
  1. . . ; if this is for Room-bed changes (Note: nodes sorted by date/time from lowest to highest)
  1. . . ; node value is in the format of:
  1. . . ; new room-bed ien ^ New Value ^ Old ien ^ Old Value ^ Current Value
  1. . . IF RBIEN'=0 DO
  1. . . . SET CURMBD=$P($G(^DG(405.4,+RBIEN,0)),"^") ;room bed current value
  1. . . . ; Check room-bed .01 field to see if room bed is new or not
  1. . . . IF (NFLDNUM=".01") DO
  1. . . . . IF OLDVAL="<no previous value>" DO
  1. . . . . . KILL RMBDUNQ(+RBIEN,"CHANGE") ; Make sure "CHANGED node does not exist"
  1. . . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; If already deleted verify DELETED100 node does not exist"
  1. . . . . . SET RMBDUNQ(+RBIEN,"NEW")=(+RBIEN)_"^"_NEWVAL_"^^^"_$$CURRMBED("NARR",RBIEN)
  1. . . . . ELSE DO
  1. . . . . . KILL RMBDUNQ(+RBIEN,"NEW") ; Make sure "CHANGED node does not exist"
  1. . . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; If it was already deleted make sure DELETED100 node does not exist"
  1. . . . . . ; only store the first change
  1. . . . . . SET:'$D(RMBDUNQ(+RBIEN,"CHANGE"))#2 RMBDUNQ(+RBIEN,"CHANGE")=(+RBIEN)_"^"_NEWVAL_"^"_(+RBIEN)_"^"_OLDVAL_"^"_$$CURRMBED("NARR",RBIEN)
  1. . . . ;
  1. . . . ; ward location is added/removed to/from the room-bed
  1. . . . IF (NFLDNUM="100,.01") DO
  1. . . . . ; if ward location is added to the room-bed.
  1. . . . . IF OLDVAL="<no previous value>" DO
  1. . . . . . SET:'$D(RMBDUNQ(+RBIEN,"CHANGE")) RMBDUNQ(+RBIEN,"NEW")=(+RBIEN)_"^"_CURMBD_"^^^"_CURMBD
  1. . . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; if deleted, verify DELETED100 node does not exist.
  1. . . . . .;
  1. . . . . ; if the the ward location is deleted from the room-bed, make sure not newed.
  1. . . . . IF NEWVAL="<deleted>" DO
  1. . . . . . KILL RMBDUNQ(+RBIEN,"NEW")
  1. . . . . . SET RMBDUNQ(+RBIEN,"DELETED100")="^^"_(+RBIEN)_"^"_ENTNM_"^"_CURMBD ; report Entry Name (ENTNM) from audit file
  1. . . . ;
  1. . ;
  1. . ; Store results for current HL file entry in CUR and PREV arrays
  1. . IF $D(CUR("HL","FLAG")),CUR("HL","FLAG")'="NEW" DO
  1. . . MERGE PREV=CUR
  1. . . SET CUR("HL","FLAG")="CURRENT"
  1. . . SET PREV("HL","FLAG")="PREVIOUS"
  1. . ; modify the PREV array from MOD array to record changes for HL file
  1. . 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
  1. . SET FLDNUM=0 FOR SET FLDNUM=$O(MOD("HL",FLDNUM)) QUIT:'FLDNUM SET PREV("HL",FLDNUM)=MOD("HL",FLDNUM)
  1. . 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)=""
  1. . ;
  1. . ;determine if this HL was reactivated or inactivated.
  1. . IF ACTDT'="",ACTDT>INACTDT S CUR("HL",2506)=ACTDT ; current reactivate date
  1. . IF INACTDT'="",INACTDT>ACTDT S CUR("HL",2505)=INACTDT ; current inactivate date
  1. . IF ACTDT'="",ACTDT<INACTDT S PREV("HL",2506)=ACTDT ; previous reactive date
  1. . IF INACTDT'="",INACTDT<ACTDT S PREV("HL",2505)=INACTDT ; previous inactivate date
  1. . ;
  1. . ; Determine if HL type is changed or not.
  1. . SET CURTYPE=CUR("HL",2) ;$P(NEWCUR,"^",5)
  1. . SET PREVTYPE=$G(PREV("HL",2)) ;$P(PREVIOUS,"^",5)
  1. . SET IGNORE=0
  1. . IF CUR("HL","FLAG")="NEW" DO
  1. . . IF "CLINIC^WARD^OPERATING ROOM"'[CURTYPE SET IGNORE=1 QUIT ;do not Report this HL.
  1. . IF CUR("HL","FLAG")="CURRENT" DO
  1. . . IF PREVTYPE="","CLINIC^WARD^OPERATING ROOM"'[CURTYPE SET IGNORE=1 QUIT ;do not Report HL
  1. . . ;
  1. . . ; if type changed from others to "CLINIC^WARD^OPERATING ROOM" report all room-beds containing location
  1. . . IF PREVTYPE'="","CLINIC^WARD^OPERATING ROOM"'[PREVTYPE,"CLINIC^WARD^OPERATING ROOM"[CURTYPE DO
  1. . . . SET CUR("HL","FLAG")="NEW" ; force the HL to be new even though currently exists
  1. . . . SET WLIEN=$$HLTOWL^LRJSMLA1(HLIEN)
  1. . . . SET RMBDIEN=0
  1. . . . ;IA #1380 for ^DG(405.4,"W", reference
  1. . . . FOR SET RMBDIEN=$O(^DG(405.4,"W",WLIEN,RMBDIEN)) QUIT:'RMBDIEN DO
  1. . . . . 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)
  1. . . ;
  1. . . ; if type changed from "CLINIC^WARD^OPERATING ROOM" to others report deleted room-beds containing location
  1. . . IF PREVTYPE'="","CLINIC^WARD^OPERATING ROOM"[PREVTYPE,"CLINIC^WARD^OPERATING ROOM"'[CURTYPE DO
  1. . . . SET WLIEN=$$HLTOWL^LRJSMLA1(HLIEN)
  1. . . . SET RMBDIEN=0
  1. . . . FOR SET RMBDIEN=$O(^DG(405.4,"W",WLIEN,RMBDIEN)) QUIT:'RMBDIEN DO
  1. . . . . SET RMBDUNQ(+RMBDIEN,"DELETED100")="^^"_(+RMBDIEN)_"^"_$P($G(^DG(405.4,RMBDIEN,0)),"^",1)_"^"_$P($G(^DG(405.4,RMBDIEN,0)),"^",1)
  1. . . . ;
  1. . IF IGNORE=1 D QUIT
  1. . . KILL @OUT@(HLIEN)
  1. . ;
  1. . ; store HL record in output array
  1. . SET HLSORT="SORT2RAW"
  1. . IF CUR("HL","FLAG")="NEW" SET HLSORT="SORT1RAW"
  1. . IF "NEW^CURRENT"[CUR("HL","FLAG") SET @OUT@(HLSORT,HLIEN,0,CUR("HL","FLAG"))=$$BLDHLREC(.CUR)
  1. . IF "CURRENT"[CUR("HL","FLAG") SET @OUT@(HLSORT,HLIEN,0,PREV("HL","FLAG"))=$$BLDHLREC(.PREV)
  1. . ;
  1. . KILL RMBDLIST
  1. . ;
  1. . IF HLSORT="SORT1RAW" DO
  1. . . SET NEWCUR=@OUT@(HLSORT,HLIEN,0,"NEW")
  1. . . SET PREVIOUS=$P(NEWCUR,"^",1,3)_"^^^^^"
  1. . IF HLSORT="SORT2RAW" DO
  1. . . SET NEWCUR=@OUT@(HLSORT,HLIEN,0,"CURRENT")
  1. . . SET PREVIOUS=@OUT@(HLSORT,HLIEN,0,"PREVIOUS")
  1. . ;
  1. . ; Build the NEW, CURRENT/PREVIOUS ROOM and BED records.
  1. . SET NODE="RMBDUNQ"
  1. . ;
  1. . ;NOTE: -.235681 is the "BEDNAME" subscript on ROOM node to assure the ROOM node of the
  1. . ; array is ordered before BED node.
  1. . ; -.235681 not a legitimate BED name in .01 field of the ROOM-BED file
  1. . ; .01 Input transform will prevent entry of -.235681 for bed name via FileMan
  1. . FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO
  1. . . SET ROOMNAME=$P($P(@NODE,"^",5),"-",1)
  1. . . SET BEDNAME=$P($P(@NODE,"^",5),"-",2,3)
  1. . . SET OLDRMNM=$P($P(@NODE,"^",4),"-",1)
  1. . . SET OLDBDNM=$P($P(@NODE,"^",4),"-",2,3)
  1. . . SET FLAG=$QS(NODE,2)
  1. . . SET RBIEN=$QS(NODE,1)
  1. . . ;
  1. . . IF CUR("HL","FLAG")="NEW" DO
  1. . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"NEW")="NEW^ROOM^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
  1. . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"NEW")="NEW^BED^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"_BEDNAME
  1. . . ELSE DO
  1. . . . IF FLAG="DELETED100" DO
  1. . . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"CURRENT")="CURRENT^ROOM^"_$P(NEWCUR,"^",3,7)_"^^"
  1. . . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"PREVIOUS")="PREVIOUS^ROOM^"_$P(PREVIOUS,"^",3,7)_"^"_ROOMNAME_"^"
  1. . . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"ACUR")="CURRENT^BED^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
  1. . . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"APREV")="PREVIOUS^BED^"_$P(PREVIOUS,"^",3,7)_"^"_OLDRMNM_"^"_OLDBDNM
  1. . . . ELSE DO
  1. . . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"CURRENT")="CURRENT^ROOM^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"
  1. . . . . SET RMBDLIST("AAAROOM",ROOMNAME,-.235681,"PREVIOUS")="PREVIOUS^ROOM^"_$P(PREVIOUS,"^",3,7)_"^"_ROOMNAME_"^"
  1. . . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"ACUR")="CURRENT^BED^"_$P(NEWCUR,"^",3,7)_"^"_ROOMNAME_"^"_BEDNAME
  1. . . . . SET RMBDLIST("AAAROOM",ROOMNAME,BEDNAME,"APREV")="PREVIOUS^BED^"_$P(PREVIOUS,"^",3,7)_"^"_OLDRMNM_"^"_OLDBDNM
  1. . ;
  1. . MERGE @OUT@(HLSORT,HLIEN)=RMBDLIST
  1. ;
  1. KILL @REVNODE
  1. QUIT
  1. ;
  1. BLDHLREC(RES) ; return the record from RES array.
  1. ; Input:
  1. ; RES - new/current or previous results from audit file and file 44
  1. ; Output:
  1. ; Return the record
  1. NEW X
  1. SET X=RES("HL","FLAG") ; flag (.e.g. NEW, CURRENT, PREVIOUS)
  1. SET X=X_"^"_RES("HL","NAME") ; Record Type ( only "LOCATION")
  1. SET X=X_"^"_RES("HL",.001) ; file 44 ien
  1. SET X=X_"^"_RES("HL",.01) ; HL Name
  1. SET X=X_"^"_RES("HL",2) ; Type of file 44 entry
  1. SET X=X_"^"_RES("HL",3) ; Institution
  1. SET X=X_"^"_RES("HL",3.5) ; Division
  1. SET X=X_"^"_RES("HL",2505) ; Inactivation Date
  1. SET X=X_"^"_RES("HL",2506) ; Reactivation Date
  1. ;
  1. IF (RES("HL","FLAG")="NEW")!(RES("HL","FLAG")="CURRENT") DO
  1. . SET X=X_"^"_RES("HL","USER") ; Accessed by (editing person)
  1. . SET X=X_"^"_RES("HL","DTR") ; Date/Time of Change
  1. QUIT X
  1. ;
  1. ROLLUP(HLIEN,CUR,NARR,TO) ; roll back the CUR HL values from current time back to "TO" time
  1. ; Input:
  1. ; HLIEN - HL ien.
  1. ; NARR - array containing the audit file data for given HL
  1. ; CUR - array containing HL data.
  1. ; TO - End Date for extract
  1. ; Output:
  1. ; CUR - array containing HL data.
  1. ;
  1. NEW NODE,NFLDNUM,RBIEN,NEWIENV,OLDIENV,NEWVAL,OLDVAL,USER,DTR,ENTNM
  1. NEW REVNARR,RNODE
  1. ; Reverse the order of NARR array by date/time (first subscript) from highest to lowest
  1. SET NODE="NARR"
  1. FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO
  1. . SET RNODE="REVNARR("_(9999999-$QS(NODE,1))
  1. . FOR I=2:1 QUIT:$QS(NODE,I)="" SET RNODE=RNODE_","_$QS(NODE,I)
  1. . SET RNODE=RNODE_")"
  1. . SET @RNODE=@NODE
  1. ;
  1. SET NODE="REVNARR"
  1. FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO
  1. . SET DTR=$P(@NODE,"^",6) ; Date/Time Recorded
  1. . QUIT:'(DTR>TO)
  1. . SET NFLDNUM=$QS(NODE,4) ; field number
  1. . SET RBIEN=$QS(NODE,3) ; room-bed ien
  1. . SET OLDVAL=$P(@NODE,"^",4) ; Old value (from last audit after "TO" date/time
  1. . ; if change HL or Ward Location (room-bed ien is 0)
  1. . ; rollback the current value to old value.
  1. . IF RBIEN=0 DO
  1. . . SET CUR("HL",NFLDNUM)=OLDVAL
  1. Q
  1. ;
  1. GHL(HLIEN,CUR) ; get the fields that are to be reported for given HL into CUR array
  1. ; Input:
  1. ; HLIEN - Hosp Loc ien.
  1. ; Output:
  1. ; CUR - array containing hosiptal location data.
  1. NEW ARR,FILENUM
  1. SET FILENUM=44
  1. SET HLIEN=+HLIEN
  1. ;
  1. ;IA #10040 for Fileman ref (GETS^DIQ) into file 44 (Hospital Location)
  1. DO GETS^DIQ(FILENUM,HLIEN_",",$$GRPTLST^LRJSMLA1(FILENUM,2),"IE","ARR")
  1. SET CUR("HL",.001)=HLIEN ; ien
  1. SET CUR("HL",.01)=ARR(44,HLIEN_",",.01,"E") ; HL name
  1. SET CUR("HL",2)=ARR(44,HLIEN_",",2,"E") ; type
  1. SET CUR("HL",3)=ARR(44,HLIEN_",",3,"E") ; institution
  1. SET CUR("HL",3.5)=ARR(44,HLIEN_",",3.5,"E") ; division
  1. SET CUR("HL",2505)=ARR(44,HLIEN_",",2505,"E") ; inactivation date
  1. SET CUR("HL",2506)=ARR(44,HLIEN_",",2506,"E") ; reactivation date
  1. SET CUR("HL","NAME")="LOCATION"
  1. QUIT
  1. ;
  1. CURRMBED(LRARRY,RBIEN) ; Find value of Room-Bed after last change before End-Date
  1. ;INPUT:
  1. ; LRARRY - "NARR" Array name for local array with form:
  1. ; NARR(date time recorded, Ward Location ien, room-bed ien and ward(s) sub-file, field number, audit file ien)
  1. ; Node data = new internal value (NULL) ^ old internal value (NULL) ^ new value ^ old value ^ user ^ data time recorded ^ audit file entry name
  1. ;
  1. ; RBIEN - Room-Bed IEN
  1. ;
  1. ;OUTPUT:
  1. ; LRRMBD - Current Room-Bed just prior to Change Report "End Date"
  1. ;
  1. NEW LRWLN,LRRBWN,LRFN,LRAUDN,LRLASTDT
  1. ;
  1. ;[Two Room-Bed Audit records will not have the same dt/tm]
  1. SET (LRLASTDT,LRWLN,LRRBWN)=""
  1. FOR SET LRRBWN=$$RBIENCK(.LRLASTDT,.LRWLN,LRARRY) Q:LRRBWN=RBIEN
  1. ;
  1. SET LRFN=$O(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,"")) ;Get field number
  1. ;
  1. ; Find last audit file ien subscript
  1. SET LRAUDN=$O(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,LRFN,""),-1)
  1. QUIT $P(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,LRFN,LRAUDN),"^",3) ;Return "Changed to" Rm-Bed for last entry
  1. ;
  1. RBIENCK(LRLSTDT,LRWLN,LRARRY) ; Check for correct Room-Bed IEN
  1. ;INPUT:
  1. ; LRLSTDT - Date of Last Change being processed [Passed by Reference]
  1. ; LRWLN - IEN for Ward-Location being processed [Passed by Reference]
  1. ; LRARRY - "NARR" Array name for local array [Passed from CURRMBED]
  1. ;
  1. ;OUTPUT:
  1. ; Room-Bed IEN and Ward(s) sub-file just prior to "End Date" being processed
  1. ;
  1. SET LRLSTDT=$O(@LRARRY@(LRLSTDT),-1) ;Get last date
  1. ;
  1. SET LRWLN=$O(@LRARRY@(LRLSTDT,"")) ;Get Ward Location ien
  1. ;
  1. QUIT $O(@LRARRY@(LRLSTDT,LRWLN,"")) ;Return Room-Bed IEN and Ward(s) sub-file