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.  ;----------------------------