source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRVR5.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1LRVR5 ;DALOI/CJS/DALOI/FHS - LAB ROUTINE DATA VERIFICATION ;4/20/89 18:02
2 ;;5.2;LAB SERVICE;**1,42,153,263,283,286**;Sep 27, 1994
3 ;
4 S LRNX=0,LRVRM=11
5V40 ;
6 S LRNX=$O(LRORD(LRNX))
7 G V44:LRNX<1 D SUBS G V40:'LRTS,V40:'$D(LRVTS(LRSB))
8 ;
9 ; Only allow verifying reference lab results which exist in LAH, no
10 ; entering results "on the fly" - use EM options (^LRVER)
11 I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2),'$D(^LAH(LRLL,1,LRSQ,LRSB)) K LRSB(LRSB) G V40
12 ;
13 I $D(^LR(LRDFN,LRSS,LRIDT,LRSB)),^(LRSB)'["pending" D V25^LRVR4 G:LRVF V40
14V42 D V25
15 S X=$S($D(LRSB(LRSB)):$P(LRSB(LRSB),U),1:""),LREDIT=0
16 I X="",LRDV'="" S $P(LRSB(LRSB),"^")=LRDV,X=LRDV
17 S LRTEST=$P(^LAB(60,+LRTS,0),U),LROUT=0 K LRNOVER(LRSB)
18Q42 W !,LRTEST," " W:X'="" @LRFP R "//",X:DTIME I X'?.ANP W $C(7)," No Control Characters Allowed." G V42
19 I X=""&$D(LRSB(LRSB)) S X=$P(LRSB(LRSB),U)
20Q43 S LRDL=X G V40:X="",V45:X'["^",V44:X="^",OUT:X="^^"
21V43 S X=$P(X,U,2),DIC="^LAB(60,",DIC(0)="EOQZ" D ^DIC G:Y<1 Q42
22 S LRPLOC=$P(Y(0),U,5),LRSSQ=$P(LRPLOC,";",1),LRSB=$P(LRPLOC,";",2),LRTS=+Y
23 I LRSSQ="" W !,"Not in this group" G OUT
24 I LRSS'=LRSSQ!'$D(^TMP("LR",$J,"TMP",LRSB)) W !,"Not in this group" G OUT
25 F LRNX=0:0 S LRNX=$O(LRORD(LRNX)) Q:LRNX<1 G V42:LRSB=LRORD(LRNX)
26V44 D COM^LRVR4
27 S LRNUF=1
28 Q
29 ;
30 ;
31V45 ;
32 K LRSKIP
33 S LRDL=X
34 I X="@" D G V46
35 . S X=$S($D(LRM(LRSB)):"pending",1:"")
36 . S $P(LRSB(LRSB),"^")=X,$P(LRSB(LRSB),"^",2)=""
37 ;
38 S X7=U_$P(^LAB(60,+LRTS,0),U,12),X6=X7_"0)"
39 X:'(X="*"!($E(X)="?")!(X="C")!(X="#")!(X="canc")!(X="pending")) $P(@X6,U,5,99)
40 I '$D(X)#2 D HELP G V42
41 I $D(X)#2,X["?" D HELP G:'($P(@X6,U,2)["S") V42
42 I $D(X)#2,$P(@X6,U,2)["S",X'="*",X'="#",X'="canc",X'="pending" D SET G:'$D(X)#2 V42
43 I $D(X)#2,X="C",$P(@X6,U,2)'["S" D COMP^LRVER5 G V42
44 ;
45V46 G V44:'$D(X)#2
46 S X1=$S($D(^LR(LRDFN,LRSS,LRLDT,LRSB)):$P(^(LRSB),U),1:""),LRFLG=""
47 S:X="*" X="canc" S:X="#" X="comment"
48 K LRQ S Y=0
49 I LRDEL'="" S LRQ=1 X LRDEL K LRQ
50 D RANGE
51 G:$D(LRNUF) V44
52 K LRNUF
53 G V40:'$D(LRSKIP)
54 S X=LRSKIP
55 G Q43:X["^",V40
56 G RANGE
57 ;
58 ;
59RANGE D RANGE^LRVER5
60RQ S X=Y
61NR ;
62 S:$P(X,U)="" LRSB(LRSB)="" Q:$D(LRQ)
63 I $P(X,U)'="" D
64 . N I,LRX,LRY
65 . S $P(LRSB(LRSB),U,1,2)=X_U_LRFLG
66 . S $P(LRSB(LRSB),U,4)=$G(DUZ)
67 . I $P(LRSB(LRSB),U,9)="" S $P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"")
68 . S LRX=$$TMPSB^LRVER1(LRSB),LRY=$P(LRSB(LRSB),U,3)
69 . F I=1:1:$L(LRX,"!") I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,"!",I)
70 . S $P(LRSB(LRSB),U,3)=LRY
71 . S LRX=LRNGS,LRY=$P(LRSB(LRSB),U,5)
72 . F I=1:1:$L(LRX,U) I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,U,I)
73 . S $P(LRSB(LRSB),U,5)=LRY
74 Q
75 ;
76 ;
77SUBS ;
78 D LRSUBS^LRVER5
79 Q
80 ;
81 ;
82SET ;
83 D LRSET^LRVER5
84 Q
85 ;
86 ;
87HUH W !,"CHOOSE:" F I=1:1 S LRSUBS=$P(LRSET,";",I) Q:LRSUBS="" W !,$P(LRSUBS,":")," FOR ",$P(LRSUBS,":",2)
88 K X
89 Q
90 ;
91 ;
92V25 ; From LRVR4
93 D V25^LRVER5
94 Q
95 ;
96 ;
97OUT S LROUT=1
98 Q
99 ;
100 ;
101HELP ;
102 W !," ??",$C(7)
103 S X5=X7_"3)"
104 W:$D(@X5) " ",@X5
105 W !,"Enter * to report ""canc"" for canceled."
106 W !,"Enter # to report ""comment""."
107 W:'($P(@X6,U,2)["S") !,"Enter C to enter calculate mode."
108 Q
Note: See TracBrowser for help on using the repository browser.