source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRDIDLE0.m

LRDIDLE0 ;DALOI/JMC; Create audit trail of changed values ;Feb 21, 2003
 ;;5.2;LAB SERVICE;**140,171,153,286**;Sep 27, 1994
 ; 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" ; new value
 . 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)_" normalcy reported incorrectly as "_LRSQ9_"."
 . S LRJ=LRJ+1,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