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

LRJSMLA1.m

Go to the documentation of this file.
  1. LRJSMLA1 ;ALB/PO,GTS Lab Hospital Location Update Notification ;02/19/2010 12:01:53
  1. ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
  1. ;
  1. ; IAs : 10040, 10039, 1380 & 5611
  1. ;
  1. SRTCHG(LRFR,LRTO,REVNODE) ; sort and reverse the relation room-bed to hospital location
  1. ; Input:
  1. ; LRFR - start time to report the raw data
  1. ; LRTO - end time to report the raw data.
  1. ; Output:
  1. ; @REVNODE@- array in the following format.
  1. ;
  1. ;@REVNODE@("N",HLIEN,LRDT,WLIEN,LRIEN,LRFLNUM,LRD0)=@NODE
  1. ;where :
  1. ; HLIEN = hospital location ien
  1. ; LRDT = date/time recorded
  1. ; WLIEN = Ward Location
  1. ; LRIEN = Room-bed ien or {Room-bed ien, ward(s). sub-file}
  1. ; LRFLNUM = field number
  1. ; LRD0 = ien of the audit file
  1. ; @REVNODE@("N",hospital location ien, date time recorded, Ward Location ien, room-bed ien and ward(s) sub-file, field number, audit file ien)
  1. ; = new internal value ^ old internal value ^ new value ^ old value ^ user ^ data time recorded ^ entry name from audit file
  1. ;
  1. ;@REVNODE@("N",HLIEN,LRDT, 0, 0, LRFLNUM, LRD0)=@NODE for info extracted from Hospital Location
  1. ;@REVNODE@("N",HLIEN,LRDT, WLIEN, 0, LRFLNUM, LRD0)=@NODE for info extracted from Ward Location
  1. ;@REVNODE@("N",HLIEN,LRDT, WLIEN, LRIEN, LRFLNUM, LRD0)=@NODE for info extracted room-bed info
  1. ;
  1. NEW OUTNODE,NOFFSET,NODE,FILENUM,LRIEN,LRDT,LRFLNUM,LRD0,HLIEN,RMD0,RMD1,WLIEN,HLIEN,DTR
  1. NEW LRCHAR,LRCNT,LRPROC
  1. KILL @REVNODE
  1. ;
  1. SET (LRCNT,LRCHAR)=0
  1. SET OUTNODE=$NAME(@REVNODE@("OUTARR"))
  1. FOR NOFFSET=1:1 Q:$QS(OUTNODE,NOFFSET)="OUTARR"
  1. SET NODE=OUTNODE
  1. ;
  1. ; get the audit data for files 42,44 and 405.4
  1. DO EXTRACT(42,LRFR,$$NOW^XLFDT(),NODE)
  1. DO EXTRACT(44,LRFR,$$NOW^XLFDT(),NODE)
  1. DO EXTRACT(405.4,LRFR,LRTO,NODE)
  1. ;
  1. FOR SET NODE=$Q(@NODE) QUIT:NODE="" Q:$QS(NODE,NOFFSET)'="OUTARR" DO
  1. . SET LRCNT=LRCNT+1
  1. . IF LRCNT#150=0 DO
  1. . . D HANGCHAR^LRJSMLU(.LRCHAR)
  1. . . S LRCNT=0
  1. .;
  1. .;NOTE: 1st subscript of NODE must be $J for this to work
  1. . SET LRPROC=$QS(NODE,1)
  1. . I LRPROC=$J DO
  1. . . SET FILENUM=$QS(NODE,NOFFSET+1)
  1. . . SET LRIEN=$QS(NODE,NOFFSET+2)
  1. . . SET LRDT=$QS(NODE,NOFFSET+3)
  1. . . SET LRFLNUM=$QS(NODE,NOFFSET+4)
  1. . . SET LRD0=$QS(NODE,NOFFSET+5)
  1. . . ;
  1. . . IF FILENUM="44" D
  1. . . . SET HLIEN=LRIEN
  1. . . . SET @REVNODE@("N",HLIEN,LRDT,0,0,LRFLNUM,LRD0)=@NODE
  1. . . ;
  1. . . IF FILENUM="42" DO
  1. . . . SET HLIEN=$$WLTOHL(LRIEN) ;Hospital Location ien
  1. . . . SET @REVNODE@("N",HLIEN,LRDT,LRIEN,0,LRFLNUM,LRD0)=@NODE
  1. . . ;
  1. . . IF FILENUM="405.4" D
  1. . . . SET RMD0=+LRIEN
  1. . . . ; if room's name changed or new room created or deleted
  1. . . . IF LRFLNUM=".01" D
  1. . . . . SET RMD1=0
  1. . . . . FOR SET RMD1=$O(^DG(405.4,RMD0,"W",RMD1)) Q:'RMD1 D
  1. . . . . . SET WLIEN=+$P($G(^DG(405.4,RMD0,"W",RMD1,0)),"^",1)
  1. . . . . . SET HLIEN=$$WLTOHL(WLIEN) ;Hospital Location ien
  1. . . . . . SET @REVNODE@("N",HLIEN,LRDT,WLIEN,LRIEN,LRFLNUM,LRD0)=@NODE
  1. . . . ;
  1. . . . IF LRFLNUM="100,.01" DO ; if the field number is 100,.01
  1. . . . . SET WLIEN=$P(LRIEN,",",2) ; Ward Location ien
  1. . . . . SET HLIEN=$$WLTOHL(WLIEN) ; Hospital Location ien
  1. . . . . SET @REVNODE@("N",HLIEN,LRDT,WLIEN,LRIEN,LRFLNUM,LRD0)=@NODE
  1. KILL @OUTNODE
  1. ;
  1. ;*Remove any HL activity that has nothing to report for entered date range
  1. SET HLIEN=0
  1. FOR SET HLIEN=$O(@REVNODE@("N",HLIEN)) Q:'HLIEN DO
  1. .S DTR=""
  1. .FOR SET DTR=$O(@REVNODE@("N",HLIEN,DTR)) Q:'DTR Q:DTR<LRTO DO
  1. ..K:DTR>LRTO @REVNODE@("N",HLIEN,DTR)
  1. ;
  1. QUIT
  1. ;
  1. EXTRACT(FILENUM,LRFR,LRTO,LRAUD) ; extract data from audit file for given file and date/time interval
  1. ; Input:
  1. ; FILENUM - file number for which to get audit data
  1. ; LRFR - start time for which to get the audit data
  1. ; LRTO - end time for which to get the audit data
  1. ; Output:
  1. ; @LRAUD@ - array in the following format.
  1. ;
  1. ; @LRAUD@(FILENUM,LRIEN,LRDT,LRFLNUM,LRD0)=LRNEWIEN_"^"_LROLDIEN_"^"_LRNEW_"^"_LROLD_"^"_LRUSER_"^"_LRDT_"^"_LRENTNM
  1. ; @LRAUD@(file num, record ien, date time recorded, field number, audit file ien)=
  1. ; = new internal value ^ old internal value ^ new value ^ old value ^ user ^ data time recorded ^ entry name from audit file
  1. ;
  1. NEW LRDATA,LRD0,LRDT,LRFLDNM,LRFLNUM,LRIEN,LRNEW,LRNEWIEN,LROLD,LROLDIEN,LRUSER,LRENTNM,LRCHAR
  1. SET LRCHAR=0
  1. SET LRAUD=$G(LRAUD)
  1. SET LRDATA=$NAME(@LRAUD@("LRDATA"))
  1. KILL @LRDATA
  1. ; extract the audit data for given file number for given time interval.
  1. DO GAUDATA(FILENUM,LRFR,LRTO,.LRDATA)
  1. ;
  1. SET LRD0=0
  1. FOR SET LRD0=$O(@LRDATA@(LRD0)) QUIT:'LRD0 DO
  1. . ; quit if audited field is not to be monitored
  1. . QUIT:'((";"_$$GMONLST(FILENUM,2)_";")[(";"_@LRDATA@(LRD0,.03)_";"))
  1. . SET LRDT=@LRDATA@(LRD0,".02") ;date/time recorded
  1. . QUIT:(LRDT<LRFR)!(LRDT>LRTO) ;make sure date time recorded is within range
  1. . SET LRENTNM=@LRDATA@(LRD0,1) ;entry name from audit File
  1. . SET LRFLDNM=@LRDATA@(LRD0,1.1) ;field name
  1. . SET LRFLNUM=@LRDATA@(LRD0,.03) ;field number
  1. . SET LRIEN=@LRDATA@(LRD0,.01) ;file entry ien
  1. . SET LRNEW=@LRDATA@(LRD0,3) ;new value
  1. . SET LRNEWIEN=@LRDATA@(LRD0,3.1) ;new internal value
  1. . SET LROLD=@LRDATA@(LRD0,2) ;old value
  1. . SET LROLDIEN=@LRDATA@(LRD0,2.1) ;old internal value
  1. . SET LRUSER=@LRDATA@(LRD0,.04) ;user name
  1. . SET @LRAUD@(FILENUM,LRIEN,LRDT,LRFLNUM,LRD0)=LRNEWIEN_"^"_LROLDIEN_"^"_LRNEW_"^"_LROLD_"^"_LRUSER_"^"_LRDT_"^"_LRENTNM
  1. KILL @LRDATA
  1. QUIT
  1. ;
  1. GAUDATA(FILENUM,LRFR,LRTO,LRDATA) ; -- Get audited data change for the given file changes
  1. ; Input:
  1. ; FILENUM - file number for which to get audit data
  1. ; LRFR - start time for which to get the audit data ( SEE NOTE)
  1. ; LRTO - end time for which to get the audit data (SEE NOTE
  1. ; Output:
  1. ; @LRDATA@ - array containing data to get from audit file
  1. ;
  1. ; NOTE: print template seems that returns all the data and
  1. ; does not screen against given date range (FR and TO)
  1. ;
  1. ; set up parameters to run the print template to a null device and store the
  1. ; results in @LRDATA array
  1. ; in case there is no null defined, print template with IOP of ";;99999" still
  1. ; will store the results in LRDATA
  1. ;
  1. NEW DIC,BY,FLDS,LRDEV,FR,TO,DIA,D0,DISYS,DILOCKTM,X1,IOP
  1. NEW LRDT,LRFLDNM,LRFLNUM,LRIEN,LRNEW,LROLD,LRUSER,LRX
  1. DO:'$D(U) DT^DICRW
  1. SET DIC="^DIA("_FILENUM_","
  1. SET BY="DATE/TIME RECORDED"
  1. SET FR=LRFR
  1. SET TO=LRTO
  1. SET FLDS="[LRJ SYS GET INDIRECT AUDIT]" ; make sure LRDATA is set to array or temp global name before the print template gets called.
  1. ;
  1. FOR LRDEV="NULL DEVICE","NULL" SET IOP=$$GIOP(LRDEV) QUIT:IOP'=""
  1. IF IOP="" SET IOP=";;99999" ; if no IOP then set the number of lines per page to maximum
  1. DO EN1^DIP
  1. QUIT
  1. ;
  1. GIOP(DEVICE) ; -- return the device if exists and it is not FORCED to queue, otherwise return ""
  1. ;Input
  1. ; DEVICE - Device to lookup
  1. ;
  1. ;Output
  1. ; DEVICE - Device Characteristics
  1. ; or
  1. ; "" : Device doesn't exist
  1. ;
  1. ;
  1. NEW IOP,%ZIS,POP,IO
  1. SET IOP=DEVICE
  1. SET %ZIS="NQ" ; ^%ZIS call does not open the device & allows QUEUING. Replaces: %ZIS="N"
  1. DO ^%ZIS ; retrun the characteristics of the device.
  1. IF POP=1 DO ; does the device exist?
  1. .SET DEVICE=""
  1. ELSE DO
  1. . ; is queuing forced for this device? {%ZIS["Q" & QUEUING field = FORCED; returns IO("Q")=1}
  1. . IF $D(IO("Q"))=1 SET DEVICE="" ;;Replaces: IF $P(^%ZIS(1,IOS,0),"^",12)=1 SET DEVICE=""
  1. ;
  1. DO ^%ZISC ; restore the device variables
  1. QUIT DEVICE
  1. ;
  1. WLTOHL(WLIEN) ; -- get associated hospital location from ward location
  1. ;IA #10039 allows reference to ^DIC(42
  1. Q +$G(^DIC(42,WLIEN,44))
  1. ;
  1. HLTOWL(HLIEN) ; get associated ward location from hospital location
  1. ;IA #10040 allows reference to ^SC(
  1. Q +$G(^SC(HLIEN,42))
  1. ;
  1. KEEPBED(RMBDIEN,BEDNODE) ;* Check for existence of Room-Bed when Ward is reactivated
  1. ;
  1. ;Input:
  1. ; RMBDIEN - IEN of Room-Bed record to check
  1. ; BEDNODE - Reverse Location Array for report [$NAME(@OUT@("REVARR","N",HLIEN)) from LRJSMLA]
  1. ;
  1. ;Output:
  1. ; RMBDXST :
  1. ; 0 - Room-Bed did not exist when reactivated
  1. ; 1 - Room-Bed existed when reactivated
  1. ;
  1. NEW RMBDXST,LRDT,WLIEN,LRIEN,LRCHAR
  1. SET LRDT=""
  1. SET RMBDXST=0
  1. SET LRCHAR=0
  1. FOR SET LRDT=$O(@BEDNODE@(LRDT)) QUIT:LRDT="" QUIT:RMBDXST=1 DO
  1. .D HANGCHAR^LRJSMLU(.LRCHAR)
  1. .SET WLIEN=""
  1. .FOR SET WLIEN=$O(@BEDNODE@(LRDT,WLIEN)) QUIT:WLIEN="" QUIT:RMBDXST=1 DO
  1. ..SET LRIEN=""
  1. ..FOR SET LRIEN=$O(@BEDNODE@(LRDT,WLIEN,LRIEN)) QUIT:LRIEN="" QUIT:RMBDXST=1 DO
  1. ...SET:LRIEN[$P(RMBDIEN,",") RMBDXST=1
  1. QUIT RMBDXST
  1. ;
  1. CLNUP(NODE) ;* Check for date of RM-BD change against when it was added to Location
  1. ;
  1. ;Input:
  1. ; NODE - Value of previous node [@OUT@(HLSORT,HLIEN,0,"PREVIOUS")]
  1. ;
  1. ;Output:
  1. ; NODE - Room/Bed nodes with edits prior to addition of new Ward Location removed
  1. ;
  1. NEW LRDT,WLIEN,RMBDIEN,LRFLDNM,RMBDARY,LRCHAR
  1. ;
  1. SET LRDT=""
  1. SET LRCHAR=0
  1. FOR SET LRDT=$O(NODE(LRDT)) QUIT:LRDT="" DO
  1. .D HANGCHAR^LRJSMLU(.LRCHAR)
  1. .SET WLIEN=""
  1. .FOR SET WLIEN=$O(NODE(LRDT,WLIEN)) QUIT:WLIEN="" DO
  1. ..SET RMBDIEN=""
  1. ..FOR SET RMBDIEN=$O(NODE(LRDT,WLIEN,RMBDIEN)) QUIT:RMBDIEN="" DO
  1. ...SET LRFLDNM=""
  1. ...FOR SET LRFLDNM=$O(NODE(LRDT,WLIEN,RMBDIEN,LRFLDNM)) QUIT:LRFLDNM="" DO
  1. ....IF LRFLDNM[".01",$P(LRFLDNM,".",2)="01" DO
  1. .....SET:(LRFLDNM'["100") $P(RMBDARY(WLIEN,$P(RMBDIEN,","),LRFLDNM),"^")=LRDT ;Dt/Tm edited Rm-Bd name
  1. .....SET:(LRFLDNM'["100") $P(RMBDARY(WLIEN,$P(RMBDIEN,","),LRFLDNM),"^",3)=$O(NODE(LRDT,WLIEN,RMBDIEN,LRFLDNM,"")) ;IEN of Edited Rm-Bd
  1. .....SET:(LRFLDNM["100") $P(RMBDARY(WLIEN,$P(RMBDIEN,","),$P(LRFLDNM,",",2)),"^",2)=LRDT ;Dt/Tm added Rm-Bd to Ward-Loc
  1. ;
  1. ;Check RMBDARY for Room-Beds that were edited before adding to Ward-Location
  1. ; If found, remove changes prior to addition to Ward-Location
  1. ;
  1. ; RMBDARY()=
  1. ; Date/Time RM-BD edited ^ Date/Time RM-BD added to Ward-Loc ^ Last Subscript of RM-BD Edit NODE
  1. SET WLIEN=""
  1. FOR SET WLIEN=$O(RMBDARY(WLIEN)) QUIT:WLIEN="" DO
  1. .SET RMBDIEN=""
  1. .FOR SET RMBDIEN=$O(RMBDARY(WLIEN,RMBDIEN)) QUIT:RMBDIEN="" DO
  1. ..SET LRFLDNM=""
  1. ..FOR SET LRFLDNM=$O(RMBDARY(WLIEN,RMBDIEN,LRFLDNM)) QUIT:LRFLDNM="" DO
  1. ...IF $P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^")<$P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^",2) DO
  1. ....; If PREVIOUS defines change but must report no change when the Rm-Bed is added during the
  1. ....; date range, then KILL NODE if 2nd piece of NODE data is not Null
  1. ....KILL:(+$P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^")>0) NODE($P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^",1),WLIEN,RMBDIEN,LRFLDNM,$P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^",3))
  1. QUIT
  1. ;
  1. ;--------------------------------------------------------------------------
  1. GRPTLST(FILENUM,PIECE) ; -- get the list of fields to be reported for given file Num
  1. QUIT $$GFLDS(FILENUM,"RPTLST",PIECE)
  1. ;
  1. GMONLST(FILENUM,PIECE) ; -- get the list of audited fields for given file number
  1. QUIT $$GFLDS(FILENUM,"MONLST",PIECE)
  1. ;
  1. RPTLST ; -- list of files and fields to be reported
  1. ;;44^.01;2;3;3.5;2505;2506^44,.01;44,2;44,3;44,3.5;44,2505;44,2506
  1. ;;42^.01;.015;44^42,.01;42,.015;42,44
  1. ;;405.4^**^405.4,.01;405.41,.01
  1. ; End of List - do not change or remove this comment
  1. ;
  1. MONLST ; -- list of audited file numbers and fields to be monitored
  1. ;;44^.01;2;3;3.5;2505;2506
  1. ;;42^.01;.015;44
  1. ;;405.4^.01;100,.01
  1. ; End of List - do not change or remove this comment
  1. ;
  1. GFLDS(FILENUM,TAGRTN,PIECE) ; search in the given tag for FileNum and get list of fields
  1. NEW TAG,RTN,I,LIST,FLDS
  1. SET TAG=$P(TAGRTN,"^",1)
  1. SET RTN=$P(TAGRTN,"^",2)
  1. SET:'$D(PIECE) PIECE=2
  1. SET:RTN="" RTN=$T(+0)
  1. SET LIST="",FLDS=""
  1. FOR I=1:1 DO QUIT:LIST=""
  1. .SET LIST=$P($TEXT(@TAG+I^@RTN),";;",2)
  1. .IF FILENUM=+LIST SET FLDS=$P(LIST,"^",PIECE),LIST=""
  1. QUIT FLDS
  1. ;
  1. ;----------------------------
  1. ;
  1. AUDSET ; -- enable audit some fields for Hospital Location, Ward Location and Room-Bed
  1. ; This API not executed by Lab system.
  1. ; PURPOSE: Execute from programmer mode, IF Fileman Auditing required for HLCMS accidentally turned off.
  1. ;
  1. NEW LRI,LRAFLDS
  1. FOR LRI=1:1 SET LRAFLDS=$P($TEXT(AFLDS+LRI),";;",2) QUIT:LRAFLDS="" DO
  1. . DO TURNON^DIAUTL(+LRAFLDS,$P(LRAFLDS,"^",2)) ;IA #5611 allows audit in HL files
  1. . W !,"Turning on audit for file/Subfile ",+LRAFLDS,?44,"for fields ",$P(LRAFLDS,"^",2)
  1. QUIT
  1. ;
  1. AFLDS ; --- file^fields for which to turn on the audit
  1. ;;44^.01;2;3;3.5;2505;2506
  1. ;;42^.01;.015;44
  1. ;;405.4^.01
  1. ;;405.41^.01
  1. ; End of List - do not change or remove this comment
  1. ;
  1. ;----------------------------