source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRDIDLE0.m@ 1535

Last change on this file since 1535 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1LRDIDLE0 ;DALOI/JMC; Create audit trail of changed values ;Feb 21, 2003
2 ;;5.2;LAB SERVICE;**140,171,153,286**;Sep 27, 1994
3 ; Called by LRVER3
4 ;
5INIT ;
6 ; This code controls the automatic audit trail entries for CH subscripted
7 ; tests which are reported and subsequently changed. Modification of this
8 ; code by local stations may have Medical/Legal ramifications. Local
9 ; stations are STRONGLY advised to NOT make changes.
10 ;
11 N LRCHDT7,LRI,LRJ,LRNEW,LROLD,LRSQ9,LRTXT,LRUSER
12 ;
13 S LRJ=0,LROK=1,LRCHDT7=$$FMTE^XLFDT(LRNOW7,"MZ"),LRUSER=$$USERID(.DUZ)
14 ;
15EVAL ;
16 ;
17 ; Result changed
18 I $P($G(LRSA(LRSB,2)),"^") D
19 . S LRNEW=$P(LRSB(LRSB),"^") S:LRNEW="" LRNEW="<no value>" ; new value
20 . S LROLD=$P(LRSA(LRSB),"^") S:LROLD="" LROLD="<no value>" ; old value
21 . S LRSQ9=LROLD_" by ["_$$USERID($P(LRSA(LRSB),"^",4))_"]" ; old result
22 . S LRJ=LRJ+1,LRTXT(LRJ)=LRSA(LRSB,1)_" reported incorrectly as "_LRSQ9_"."
23 . S LRJ=LRJ+1,LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
24 ;
25 ; Normalcy flag changed
26 I $P($G(LRSA(LRSB,2)),"^",2) D
27 . S LRNEW=$P(LRSB(LRSB),"^",2) S:LRNEW="" LRNEW="normal" ; new value
28 . S LROLD=$P(LRSA(LRSB),"^",2) S:LROLD="" LROLD="normal" ; old value
29 . S LRSQ9=LROLD_" by ["_$$USERID($P(LRSA(LRSB),"^",4))_"]" ; old result
30 . S LRJ=LRJ+1,LRTXT(LRJ)=LRSA(LRSB,1)_" normalcy reported incorrectly as "_LRSQ9_"."
31 . S LRJ=LRJ+1,LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
32 ;
33 ; Check normal ranges
34 I $P($G(LRSA(LRSB,2)),"^",5) D
35 . N LRI,LRX,LRY,LRZ
36 . S LRX=$P(LRSB(LRSB),"^",5),LRY=$P(LRSA(LRSB),"^",5)
37 . ; Units changed
38 . I $P(LRX,"!",7)'=$P(LRY,"!",7) D
39 . . S LRNEW=$P(LRX,"!",7) S:LRNEW="" LRNEW="<no value>" ; new value
40 . . S LROLD=$P(LRY,"!",7) S:LROLD="" LROLD="<no value>" ; old value
41 . . S LRSQ9=LROLD_" by ["_$$USERID($P(LRSA(LRSB),"^",4))_"]" ; old value
42 . . S LRJ=LRJ+1,LRTXT(LRJ)=LRSA(LRSB,1)_" units reported incorrectly as "_LRSQ9_"."
43 . . S LRJ=LRJ+1,LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
44 . ; Reference ranges changed
45 . S LRZ(0)="^reference low^reference high^critical low^critical high^^^^^^therapeutic low^therapeutic high^"
46 . F LRI=2,3,4,5,11,12 I $P(LRX,"!",LRI)'=$P(LRY,"!",LRI) D
47 . . S LRNEW=$P(LRX,"!",LRI) S:LRNEW="" LRNEW="<no value>" ; new value
48 . . S LROLD=$P(LRY,"!",LRI) S:LROLD="" LROLD="<no value>" ; old value
49 . . S LRZ=$P(LRZ(0),"^",LRI)
50 . . S LRSQ9=LROLD_" by ["_$$USERID($P(LRSA(LRSB),"^",4))_"]" ; old value
51 . . S LRJ=LRJ+1,LRTXT(LRJ)=LRSA(LRSB,1)_" "_LRZ_" reported incorrectly as "_LRSQ9_"."
52 . . S LRJ=LRJ+1,LRTXT(LRJ)="Changed to "_LRNEW_" on "_LRCHDT7_" by ["_LRUSER_"]."
53 ;
54 I LRJ D STORE
55 Q
56 ;
57 ;
58STORE ; Store comments in file #63, field #99 COMMENTS
59 ;
60 N DIWF,DIWL,DIWR,LRI,LRJ,LRK,LRX,X
61 ;
62 ; Check comment lengths and if greater than 68 break line
63 S LRI=0
64 F S LRI=$O(LRTXT(LRI)) Q:'LRI D
65 . I $L(LRTXT(LRI))<69 Q
66 . S X=LRTXT(LRI),DIWL=1,DIWR=68,DIWF="",LRJ=0
67 . K ^UTILITY($J,"W"),LRTXT(LRI)
68 . D ^DIWP
69 . F S LRJ=$O(^UTILITY($J,"W",DIWL,LRJ)) Q:'LRJ D
70 . . S LRK=LRI+(LRJ/100),LRTXT(LRK)=^UTILITY($J,"W",DIWL,LRJ,0)
71 . . I $L(LRTXT(LRK))<68 Q
72 . . F J=69:68:$L(LRTXT(LRK)) S LRTXT(LRK+(J/10000))=$E(LRTXT(LRK),J,J+68)
73 . . S LRTXT(LRK)=$E(LRTXT(LRK),1,68)
74 . K ^UTILITY($J,"W")
75 ;
76 S LRI=0
77 F S LRI=$O(LRTXT(LRI)) Q:'LRI D
78 . S LRX=LRTXT(LRI)
79 . D FILECOM^LRVR4(LRDFN,LRIDT,LRX)
80 . W !,LRX
81 ;
82 Q
83 ;
84 ;
85USERID(LRDUZ) ; Create user id for comment text
86 ;
87 ; Call with DUZ array by reference
88 ;
89 ; Returns LRY = formatted user id (DUZ-VAxxx) where xxx = VA station #
90 ;
91 N LRY
92 S LRY=LRDUZ
93 ; If agency or facility not passed assumed agency/facility of current user
94 I $G(LRDUZ("AG"))="" S LRDUZ("AG")=DUZ("AG")
95 I '$G(LRDUZ(2)) S LRDUZ(2)=DUZ(2)
96 ;
97 I LRDUZ("AG")="V" S LRY=LRY_"-VA"_$$GET1^DIQ(4,LRDUZ(2)_",",99)
98 Q LRY
Note: See TracBrowser for help on using the repository browser.