source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRVERA.m@ 1604

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1LRVERA ;DALOI/JMC - READ ACCESSION/UID ;2/7/91 14:49
2 ;;5.2;LAB SERVICE;**153,271,286**;Sep 27, 1994
3 ;
4 ;
5ACC ; Prompt for accession selection
6 D EN^LRWU4
7 Q
8 ;
9 ;
10UID ; Prompt for UID selection
11 ;
12 N LRQUIT,LRX,LRY
13 ;
14 W !
15 S (LRQUIT,LRY)=0
16 F D Q:LRQUIT
17 . S LRX=$$UID^LRWU4("Unique Identifier",$G(LRUID))
18 . I LRX=0 S LRUID="",(LRAA,LRAD,LRAN)=-1,LRQUIT=1 Q
19 . S LRY=$$CHECKUID^LRWU4(LRX)
20 . I LRY S LRQUIT=1 Q
21 . W !,"No accession on file for this UID."
22 . S LRUID=""
23 ;
24 ; If good UID then update variables if user selected a different UID
25 ; Display accession.
26 I LRY D
27 . I $G(LRUID)'=LRX S LRUID=LRX,LRAA=$P(LRY,"^",2),LRAD=$P(LRY,"^",3),LRAN=$P(LRY,"^",4)
28 . W " (",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^"),")"
29 Q
30 ;
31 ;
32SELPL(LR4) ; Select the performing laboratory to store with test results.
33 ; Call with LR4 = default institution, usually value of DUZ(2)
34 ;
35 ; Returns LR4 = ien of file #4 institution selected
36 ;
37 N DIC,DTOUT,DUOUT,X,Y
38 S DIC="^DIC(4,",DIC(0)="AEMOQ"
39 S DIC("A")="Select Performing Laboratory: "
40 I $G(LR4)>0 S DIC("B")=$$GET1^DIQ(4,LR4_",",.01)
41 S DIC("S")="I $$SCRNPL^LRVERA"
42 D ^DIC
43 I Y<1 S LR4=0
44 E S LR4=$P(Y,"^")
45 ;
46 Q LR4
47 ;
48 ;
49SCRNPL() ; Screen performing laboratory
50 ; Called by DIC("S") lookup above when selecting performing laboratory
51 N OK,LRX
52 S OK=0
53 I Y=DUZ(2) S OK=1
54 E I $D(^LAHM(62.9,"CH",DUZ(2),Y)) S OK=1
55 Q OK
56 ;
57 ;
58PLOK(LRX,LRY,LRZ,LR60) ; Check if user is editing results that appear to have
59 ; been performed by a lab different from the one they selected and.
60 ; ask if changing performing lab is ok.
61 ;
62 ; Call with LRX = file #4 ien of performing lab on record
63 ; LRY = file #4 ien of performing lab user selected
64 ; LRZ = user's current division - DUZ(2)
65 ; LR60 = file #60 ien of test selected
66 ;
67 ; Returns 1=YES, 0=NO
68 ;
69 N DIR,DIRUT,DTOUT,DUOUT,OK,X,Y
70 S OK=1
71 I LRX D
72 . I LRY,LRX=LRY Q
73 . I LRX=LRZ Q
74 . S DIR("A",1)="The performing lab recorded for test "_$$GET1^DIQ(60,LR60_",",.01)_" is: "_$$GET1^DIQ(4,LRX_",",.01)
75 . S DIR("A",2)="You indicated the performing lab is: "_$$GET1^DIQ(4,$S(LRY:LRY,1:LRZ)_",",.01)
76 . S DIR("A")="Do you want to continue",DIR("B")="NO"
77 . S DIR(0)="YO",OK=0
78 . W ! D ^DIR
79 . I Y=1 S OK=1
80 Q OK
81 ;
82 ;
83RFLAG(FLAG) ; Ask user for referral high/low/critical flag in case they
84 ; don't have values to calculate.
85 ; Call with FLAG = current abnormal flag if any
86 ;
87 ; Returns NULL=no selection 0=Calculate from entered values
88 ; 1=Abnormal Low 2=Critical Low
89 ; 3=Abnormal High 4=Critical High
90 ;
91 N DIR,DIROUT,DIRUT,DTOUT,X,Y
92 S DIR(0)="SOA^0:Calculate from entered values;1:Abnormal Low;2:Critical Low;3:Abnormal High;4:Critical High"
93 S DIR("A")="Result's Abnormality: "
94 S DIR("B")="Calculate from entered values"
95 I $G(FLAG)'="" S DIR("B")=$S(FLAG="L":"Abnormal Low",FLAG="L*":"Critical Low",FLAG="H":"Abnormal High",FLAG="H*":"Critical High",1:DIR("B"))
96 S DIR("?")="Select the abnormality if it cannot be calculated from reference values."
97 D ^DIR
98 I $D(DIRUT) S Y=""
99 Q Y
100 ;
101 ;
102DCOM ; From above and LRVR4 - display comments
103 ;
104 ; Quit if no current or previous comments
105 I '$O(^LR(LRDFN,LRSS,LRIDT,1,0)),'$O(^LR(LRDFN,LRSS,+$G(LRLDT),1,0)) Q
106 ;
107 N DA
108 ;
109 ; Display previous comments.
110 I $G(LRCMTDSP),$G(LRLDT)>0,$O(^LR(LRDFN,LRSS,LRLDT,1,0)) D
111 . W !,"*** Comments for Previous Accession "_$P($G(Z2),"^",6)_" ***"
112 . S DA=LRLDT D DSPCMT
113 ;
114 ; Display current comments
115 I $O(^LR(LRDFN,LRSS,LRIDT,1,0)) D
116 . I $G(LRCMTDSP),$G(LRLDT)>0,$O(^LR(LRDFN,LRSS,LRLDT,1,0)) D
117 . . W !,"*** Comments for Current Accession "_$G(LRACC)_" ***"
118 . . S LRLCT=LRLCT+1
119 . S DA=LRIDT D DSPCMT
120 Q
121 ;
122 ;
123CMTDSP ; Determine if display of previous results should include associated comments.
124 ;
125 N ERR,I
126 ;
127 ; Get stored list of tests from parameter tool
128 K ^TMP("LRXPAR",$J),^TMP("LR",$J,"DCMT")
129 D GETLST^XPAR("^TMP(""LRXPAR"",$J)","USR","LR VER DISPLAY PREV COMMENT","Q",.ERR,1)
130 I '$G(^TMP("LRXPAR",$J)) Q
131 ; Create list based in file #60 ien - makes checking easier
132 S I=0
133 F S I=$O(^TMP("LRXPAR",$J,I)) Q:'I I $P(^(I),"^",2) S ^TMP("LR",$J,"DCMT",+^TMP("LRXPAR",$J,I))=""
134 K ^TMP("LRXPAR",$J)
135 Q
136 ;
137 ;
138CHKCDSP() ; Check if previous comment should display when test on user's list
139 ; is present on test profile selected for this accession.
140 ;
141 N I,OK
142 S OK=0
143 I $G(LRLDT)>0,$D(^TMP("LR",$J,"DCMT")) D
144 . S I=0
145 . F S I=$O(LRM(I)) Q:'I D Q:OK
146 . . I $D(^TMP("LR",$J,"DCMT",+LRM(I))) S OK=1 Q
147 . . I $G(LRM(I,"P")),$D(^TMP("LR",$J,"DCMT",+LRM(I,"P"))) S OK=1 Q
148 Q OK
149 ;
150 ;
151DSPCMT ; Display comments stored in file #63
152 N DIR,DIRUT,DTOUT,DUOUT,I,X,Y
153 S I=0
154 F S I=$O(^LR(LRDFN,LRSS,DA,1,I)) Q:'I D Q:$D(DIRUT)
155 . S LRLCT=LRLCT+1
156 . W !,"COMMENTS: ",$P(^LR(LRDFN,LRSS,DA,1,I,0),"^")
157 . I LRLCT>21,$E(IOST,1,2)="C-" D Q:$D(DIRUT)
158 . . S DIR(0)="E" D ^DIR
159 . . S LRLCT=0
160 W ! S LRLCT=LRLCT+1
161 Q
Note: See TracBrowser for help on using the repository browser.