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