LRDIDLE0 ;DALOI/JMC; Create audit trail of changed values ;Feb 21, 2003
;;5.2;LAB SERVICE;**140,171,153,286,396**;Sep 27, 1994;Build 3
; Called by LRVER3
;
INIT ;
; This code controls the automatic audit trail entries for CH subscripted
; tests which are reported and subsequently changed. Modification of this
; code by local stations may have Medical/Legal ramifications. Local
; stations are STRONGLY advised to NOT make changes.
;
N LRCHDT7,LRI,LRJ,LRNEW,LROLD,LRSQ9,LRTXT,LRUSER
;
S LRJ=0,LROK=1,LRCHDT7=$$FMTE^XLFDT(LRNOW7,"MZ"),LRUSER=$$USERID(.DUZ)
;
EVAL ;
;
; Result changed
I $P($G(LRSA(LRSB,2)),"^") D
. S LRNEW=$P(LRSB(LRSB),"^") S:LRNEW="" LRNEW="<no value>" ; new value
. S LROLD=$P(LRSA(LRSB),"^") S:LROLD="" LROLD="<no value>" ; old value
. S LRSQ9=LROLD_" by ["_$$USERID($P(LRSA(LRSB),"^",4))_"]" ; old result
. S LRJ=LRJ+1,LRTXT(LRJ)=LRSA(LRSB,1)_" reported incorrectly as "_LRSQ9_"."
. S LRJ=LRJ+1,LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
;
; Normalcy flag changed
I $P($G(LRSA(LRSB,2)),"^",2) D
. S LRNEW=$P(LRSB(LRSB),"^",2) S:LRNEW="" LRNEW="normal" D ; new value
. . I $P(LRSB(LRSB),"^")="canc"!($P(LRSB(LRSB),"^")="CANC") S LRNEW="canc"
. S LROLD=$P(LRSA(LRSB),"^",2) S:LROLD="" LROLD="normal" ; old value
. S LRSQ9=LROLD_" by ["_$$USERID($P(LRSA(LRSB),"^",4))_"]" ; old result
. S LRJ=LRJ+1,LRTXT(LRJ)=LRSA(LRSB,1)_" flagged incorrectly as "_LRSQ9_"."
. S LRJ=LRJ+1 D
. . I LRNEW="canc" S LRTXT(LRJ)="Abnormal flag removed on "_LRCHDT7_" by ["_LRUSER_"]." Q
. . S LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
;
; Check normal ranges
I $P($G(LRSA(LRSB,2)),"^",5) D
. N LRI,LRX,LRY,LRZ
. S LRX=$P(LRSB(LRSB),"^",5),LRY=$P(LRSA(LRSB),"^",5)
. ; Units changed
. I $P(LRX,"!",7)'=$P(LRY,"!",7) D
. . S LRNEW=$P(LRX,"!",7) S:LRNEW="" LRNEW="<no value>" ; new value
. . S LROLD=$P(LRY,"!",7) S:LROLD="" LROLD="<no value>" ; old value
. . S LRSQ9=LROLD_" by ["_$$USERID($P(LRSA(LRSB),"^",4))_"]" ; old value
. . S LRJ=LRJ+1,LRTXT(LRJ)=LRSA(LRSB,1)_" units reported incorrectly as "_LRSQ9_"."
. . S LRJ=LRJ+1,LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
. ; Reference ranges changed
. S LRZ(0)="^reference low^reference high^critical low^critical high^^^^^^therapeutic low^therapeutic high^"
. F LRI=2,3,4,5,11,12 I $P(LRX,"!",LRI)'=$P(LRY,"!",LRI) D
. . S LRNEW=$P(LRX,"!",LRI) S:LRNEW="" LRNEW="<no value>" ; new value
. . S LROLD=$P(LRY,"!",LRI) S:LROLD="" LROLD="<no value>" ; old value
. . S LRZ=$P(LRZ(0),"^",LRI)
. . S LRSQ9=LROLD_" by ["_$$USERID($P(LRSA(LRSB),"^",4))_"]" ; old value
. . S LRJ=LRJ+1,LRTXT(LRJ)=LRSA(LRSB,1)_" "_LRZ_" reported incorrectly as "_LRSQ9_"."
. . S LRJ=LRJ+1,LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
;
I LRJ D STORE
Q
;
;
STORE ; Store comments in file #63, field #99 COMMENTS
;
N DIWF,DIWL,DIWR,LRI,LRJ,LRK,LRX,X
;
; Check comment lengths and if greater than 68 break line
S LRI=0
F S LRI=$O(LRTXT(LRI)) Q:'LRI D
. I $L(LRTXT(LRI))<69 Q
. S X=LRTXT(LRI),DIWL=1,DIWR=68,DIWF="",LRJ=0
. K ^UTILITY($J,"W"),LRTXT(LRI)
. D ^DIWP
. F S LRJ=$O(^UTILITY($J,"W",DIWL,LRJ)) Q:'LRJ D
. . S LRK=LRI+(LRJ/100),LRTXT(LRK)=^UTILITY($J,"W",DIWL,LRJ,0)
. . I $L(LRTXT(LRK))<68 Q
. . F J=69:68:$L(LRTXT(LRK)) S LRTXT(LRK+(J/10000))=$E(LRTXT(LRK),J,J+68)
. . S LRTXT(LRK)=$E(LRTXT(LRK),1,68)
. K ^UTILITY($J,"W")
;
S LRI=0
F S LRI=$O(LRTXT(LRI)) Q:'LRI D
. S LRX=LRTXT(LRI)
. D FILECOM^LRVR4(LRDFN,LRIDT,LRX)
. W !,LRX
;
Q
;
;
USERID(LRDUZ) ; Create user id for comment text
;
; Call with DUZ array by reference
;
; Returns LRY = formatted user id (DUZ-VAxxx) where xxx = VA station #
;
N LRY
S LRY=LRDUZ
; If agency or facility not passed assumed agency/facility of current user
I $G(LRDUZ("AG"))="" S LRDUZ("AG")=DUZ("AG")
I '$G(LRDUZ(2)) S LRDUZ(2)=DUZ(2)
;
I LRDUZ("AG")="V" S LRY=LRY_"-VA"_$$GET1^DIQ(4,LRDUZ(2)_",",99)
Q LRY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRDIDLE0 4066 printed Dec 13, 2024@02:13:53 Page 2
LRDIDLE0 ;DALOI/JMC; Create audit trail of changed values ;Feb 21, 2003
+1 ;;5.2;LAB SERVICE;**140,171,153,286,396**;Sep 27, 1994;Build 3
+2 ; Called by LRVER3
+3 ;
INIT ;
+1 ; This code controls the automatic audit trail entries for CH subscripted
+2 ; tests which are reported and subsequently changed. Modification of this
+3 ; code by local stations may have Medical/Legal ramifications. Local
+4 ; stations are STRONGLY advised to NOT make changes.
+5 ;
+6 NEW LRCHDT7,LRI,LRJ,LRNEW,LROLD,LRSQ9,LRTXT,LRUSER
+7 ;
+8 SET LRJ=0
SET LROK=1
SET LRCHDT7=$$FMTE^XLFDT(LRNOW7,"MZ")
SET LRUSER=$$USERID(.DUZ)
+9 ;
EVAL ;
+1 ;
+2 ; Result changed
+3 IF $PIECE($GET(LRSA(LRSB,2)),"^")
Begin DoDot:1
+4 ; new value
SET LRNEW=$PIECE(LRSB(LRSB),"^")
if LRNEW=""
SET LRNEW="<no value>"
+5 ; old value
SET LROLD=$PIECE(LRSA(LRSB),"^")
if LROLD=""
SET LROLD="<no value>"
+6 ; old result
SET LRSQ9=LROLD_" by ["_$$USERID($PIECE(LRSA(LRSB),"^",4))_"]"
+7 SET LRJ=LRJ+1
SET LRTXT(LRJ)=LRSA(LRSB,1)_" reported incorrectly as "_LRSQ9_"."
+8 SET LRJ=LRJ+1
SET LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
End DoDot:1
+9 ;
+10 ; Normalcy flag changed
+11 IF $PIECE($GET(LRSA(LRSB,2)),"^",2)
Begin DoDot:1
+12 ; new value
SET LRNEW=$PIECE(LRSB(LRSB),"^",2)
if LRNEW=""
SET LRNEW="normal"
Begin DoDot:2
+13 IF $PIECE(LRSB(LRSB),"^")="canc"!($PIECE(LRSB(LRSB),"^")="CANC")
SET LRNEW="canc"
End DoDot:2
+14 ; old value
SET LROLD=$PIECE(LRSA(LRSB),"^",2)
if LROLD=""
SET LROLD="normal"
+15 ; old result
SET LRSQ9=LROLD_" by ["_$$USERID($PIECE(LRSA(LRSB),"^",4))_"]"
+16 SET LRJ=LRJ+1
SET LRTXT(LRJ)=LRSA(LRSB,1)_" flagged incorrectly as "_LRSQ9_"."
+17 SET LRJ=LRJ+1
Begin DoDot:2
+18 IF LRNEW="canc"
SET LRTXT(LRJ)="Abnormal flag removed on "_LRCHDT7_" by ["_LRUSER_"]."
QUIT
+19 SET LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
End DoDot:2
End DoDot:1
+20 ;
+21 ; Check normal ranges
+22 IF $PIECE($GET(LRSA(LRSB,2)),"^",5)
Begin DoDot:1
+23 NEW LRI,LRX,LRY,LRZ
+24 SET LRX=$PIECE(LRSB(LRSB),"^",5)
SET LRY=$PIECE(LRSA(LRSB),"^",5)
+25 ; Units changed
+26 IF $PIECE(LRX,"!",7)'=$PIECE(LRY,"!",7)
Begin DoDot:2
+27 ; new value
SET LRNEW=$PIECE(LRX,"!",7)
if LRNEW=""
SET LRNEW="<no value>"
+28 ; old value
SET LROLD=$PIECE(LRY,"!",7)
if LROLD=""
SET LROLD="<no value>"
+29 ; old value
SET LRSQ9=LROLD_" by ["_$$USERID($PIECE(LRSA(LRSB),"^",4))_"]"
+30 SET LRJ=LRJ+1
SET LRTXT(LRJ)=LRSA(LRSB,1)_" units reported incorrectly as "_LRSQ9_"."
+31 SET LRJ=LRJ+1
SET LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
End DoDot:2
+32 ; Reference ranges changed
+33 SET LRZ(0)="^reference low^reference high^critical low^critical high^^^^^^therapeutic low^therapeutic high^"
+34 FOR LRI=2,3,4,5,11,12
IF $PIECE(LRX,"!",LRI)'=$PIECE(LRY,"!",LRI)
Begin DoDot:2
+35 ; new value
SET LRNEW=$PIECE(LRX,"!",LRI)
if LRNEW=""
SET LRNEW="<no value>"
+36 ; old value
SET LROLD=$PIECE(LRY,"!",LRI)
if LROLD=""
SET LROLD="<no value>"
+37 SET LRZ=$PIECE(LRZ(0),"^",LRI)
+38 ; old value
SET LRSQ9=LROLD_" by ["_$$USERID($PIECE(LRSA(LRSB),"^",4))_"]"
+39 SET LRJ=LRJ+1
SET LRTXT(LRJ)=LRSA(LRSB,1)_" "_LRZ_" reported incorrectly as "_LRSQ9_"."
+40 SET LRJ=LRJ+1
SET LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
End DoDot:2
End DoDot:1
+41 ;
+42 IF LRJ
DO STORE
+43 QUIT
+44 ;
+45 ;
STORE ; Store comments in file #63, field #99 COMMENTS
+1 ;
+2 NEW DIWF,DIWL,DIWR,LRI,LRJ,LRK,LRX,X
+3 ;
+4 ; Check comment lengths and if greater than 68 break line
+5 SET LRI=0
+6 FOR
SET LRI=$ORDER(LRTXT(LRI))
if 'LRI
QUIT
Begin DoDot:1
+7 IF $LENGTH(LRTXT(LRI))<69
QUIT
+8 SET X=LRTXT(LRI)
SET DIWL=1
SET DIWR=68
SET DIWF=""
SET LRJ=0
+9 KILL ^UTILITY($JOB,"W"),LRTXT(LRI)
+10 DO ^DIWP
+11 FOR
SET LRJ=$ORDER(^UTILITY($JOB,"W",DIWL,LRJ))
if 'LRJ
QUIT
Begin DoDot:2
+12 SET LRK=LRI+(LRJ/100)
SET LRTXT(LRK)=^UTILITY($JOB,"W",DIWL,LRJ,0)
+13 IF $LENGTH(LRTXT(LRK))<68
QUIT
+14 FOR J=69:68:$LENGTH(LRTXT(LRK))
SET LRTXT(LRK+(J/10000))=$EXTRACT(LRTXT(LRK),J,J+68)
+15 SET LRTXT(LRK)=$EXTRACT(LRTXT(LRK),1,68)
End DoDot:2
+16 KILL ^UTILITY($JOB,"W")
End DoDot:1
+17 ;
+18 SET LRI=0
+19 FOR
SET LRI=$ORDER(LRTXT(LRI))
if 'LRI
QUIT
Begin DoDot:1
+20 SET LRX=LRTXT(LRI)
+21 DO FILECOM^LRVR4(LRDFN,LRIDT,LRX)
+22 WRITE !,LRX
End DoDot:1
+23 ;
+24 QUIT
+25 ;
+26 ;
USERID(LRDUZ) ; Create user id for comment text
+1 ;
+2 ; Call with DUZ array by reference
+3 ;
+4 ; Returns LRY = formatted user id (DUZ-VAxxx) where xxx = VA station #
+5 ;
+6 NEW LRY
+7 SET LRY=LRDUZ
+8 ; If agency or facility not passed assumed agency/facility of current user
+9 IF $GET(LRDUZ("AG"))=""
SET LRDUZ("AG")=DUZ("AG")
+10 IF '$GET(LRDUZ(2))
SET LRDUZ(2)=DUZ(2)
+11 ;
+12 IF LRDUZ("AG")="V"
SET LRY=LRY_"-VA"_$$GET1^DIQ(4,LRDUZ(2)_",",99)
+13 QUIT LRY
