source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTL4.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1LAMIVTL4 ;DAL/HOAK 4th Vitek literal verify rtn
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,31,40**;Sep 27,1994
3INIT ;
4 I '$G(LRTS) S LRTS=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,1,4,0))
5 I 'OK D GLEEP^LAMIVTL3 QUIT
6 S OK=1
7DR ; FROM LAMIAUT1 BY FHS
8 ;-----------------------------------------------------------------------
9 ; This block runs edit template for comment, final report, bact etc.
10 K DR,DIC,DIE,DA
11 S DA(1)=LRDFN
12 S DA=LRIDT
13 S Y(0)=^LR(LRDFN,"MI",LRIDT,0),DIE="^LR("_LRDFN_",""MI"","
14 S DR="11.55////^S X=DUZ;11.5;11.6;13"
15 D ^DIE
16 ;-----------------------------------------------------------------------
17 S LREND=0
18 D ^LAMIAUT3 Q:LREND
19 D VERIFY
20 L -(^LR(LRDFN,"MI",LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN))
21 Q
22VERIFY ;
23 R !!," ('E'dit data, 'C'omments, 'O'rganism 'W'orklist) // ",LREDIT:DTIME
24 I '$T D GLEEP^LAMIVTL3 S OK=0 QUIT
25 I $E(LREDIT)="?" D HLP^LAMIAUT4,^LAMIAUT3 G VERIFY
26 I $E(LREDIT)="^"!($E(LREDIT="@")) D GLEEP^LAMIVTL3 S OK=0 K LRBDUP,LRMOVE Q
27 K DIC,DR,DIE,DA
28 S DA=LRIDT,DA(1)=LRDFN
29 S LRY(0)=^LR(LRDFN,"MI",LRIDT,0)
30 S DIE="^LR("_DA(1)_",""MI"",",DIC=DIE
31 I $E(LREDIT)="E" S ZX9=X9 D EDIT^LAMIAUT4,^LAMIAUT3 S X9=ZX9 K ZX9 G VERIFY
32 I $E(LREDIT)="O" S ZX9=X9 D ^LRMIBUG,^LAMIAUT3 S X9=ZX9 K ZX9 G VERIFY
33 I $E(LREDIT)="C" K DR S DR=".99;1;13" D ^DIE D ^LAMIAUT3 G VERIFY
34 I $E(LREDIT)="W" D EN^LRCAPV D ^LAMIAUT3 G VERIFY
35 R !,"Approve for release by entering your initials: ",X:DTIME
36 I '$T!($E(X)="^") D GLEEP^LAMIVTL3 Q
37 I X'=LRINI W !!,$C(7)," NOT APPROVED " Q
38 I X=LRINI W !!,"Approved for Release" D VER D QUIT
39 . ;time stamp
40 . D NOW^%DTC
41 . S $P(^LR(LRDFN,LRSUB,LRIDT,0),U,3)=%,$P(^(0),U,4)=$G(DUZ)
42 . S $P(^LR(LRDFN,LRSUB,LRIDT,1),U)=DT
43 . S LRODT=$P(^LR(LRDFN,LRSUB,LRIDT,0),U),LRODT=$P(LRODT,".")
44 . I $G(LRORGCNT) D
45 .. I $D(^LR(LRDFN,LRSUB,LRIDT,3,0)) S LRN12=$G(^(0)) D
46 ... S LRORGCNT=$P($G(LRN12),U,4)+LRORGCNT
47 .. S ^LR(LRDFN,LRSUB,LRIDT,3,0)=U_"63.3PA"_U_LRORGCNT_U_LRORGCNT
48 . S ^LRO(69,LRODT,1,"AL",LRLLOC,PNM,LRDFN)=""
49 . S ^LRO(69,LRODT,1,"AN",LRLLOC,LRDFN,LRIDT)=""
50 . S ^LRO(69,LRODT,1,"AP",LRPHYN,PNM,LRDFN)=""
51 . S ^LRO(69,LRODT,1,"AR",LRLLOC,PNM,LRDFN)=""
52 . S $P(^LRO(69,LRODT,1,LRSN,3),U,2)=%
53 ;-----------------------------------------------------------------
54VER ;Final report after initials
55 S LRSS=LRSUB
56 S LRUNDO=1
57 ;
58 S LRDPF=2,LRSSD=LRAA,LRACC="",LRADDF=LRSUB,LRORCOM=""
59 Q:'$G(LRBUX)
60 S LRORG(+LRBUX)=LRORGCNT
61 S LRORGN=+LRBUX
62 S LAMIAUTO=1
63 S LAMIAUT0=1
64 ;
65 S LRFIFO=0
66 S T1=1
67 D VER1 Q
68TIC ;
69 ;
70 ;I '$D(X9) S X9="F T1=1 "
71 N LRBG0
72 Q:X9="" S (LRBG0,Y(0))=^LR(LRDFN,"MI",LRIDT,0),LRCAPOK=1,LRUNDO=0 I '$P(Y(0),U,3) S:$P(Y(0),U,9) LRUNDO=1 G VER1
73 I $P(^LR(LRDFN,"MI",LRIDT,0),U,3) W !,"Final report has been verified by micro supervisor,",$C(7),!,"If you proceed in editing, the report will be reprinted"
74 F I=0:0 W !?10,"OK" S %=1 D YN^DICN Q:% W !," Enter 'Y' or 'N' : "
75 I %=2!(%<0) Q
76VER1 ;
77 S LRCAPOK=1
78 S LRT=LRTS
79 S LRCB7=LRIFN
80 D:'$P(^LAB(69.9,1,"NITE"),U) ANN^LRCAPV
81 ;N LRADD,GLB,LRBUG,LRBUGY
82 S LRSB=1
83 W !
84 X (X9_"S LRPTP=$O(LRNAME(T1,0))")
85 S LRCAPOK=1,Y(0)=^LR(LRDFN,"MI",LRIDT,0) D
86 . K DR
87 . S DR=11,LRSAME=0
88 . D:LRUNDO UNDO^LRMIEDZ
89 . I $G(^LAB(61.38,1,4))'>0 D
90 .. S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,0),U,5)=""
91 . D ^DIE,TIME^LRMIEDZ3
92 . S LRTS=LRPTP I $G(LRTS) I LRCAPOK&($P(LRPARAM,U,14)) D
93 .. S LRIFN=0
94 .. S LRIFN=$O(LRIFN(LRIFN)) Q:LRIFN="" D WKLD
95 ;
96 ;
97 ;
98 N LRWRDVEW
99 S LRWRDVEW=1
100 D VT^LRMIUT1 I $L($G(LRVT)) D STF^LRMIUT
101 S ^LRO(68,"AVS",LRAA,LRAD,LRAN)=LRDFN_U_LRIDT
102 K ^LAH(LRLL,1,"C",LRAN)
103 S LRPLA=0
104 ;-->make certain we get'em all
105 F S LRPLA=$O(^LAH(LRLL,1,"C",LRAN,LRPLA)) Q:+LRPLA'>0 K ^(LRAN,LRPLA)
106 D END^LAMIVTL0
107 W @IOF D S1^LAMIVTL0 W !!
108 Q
109 ; VITEK WORKLOAD----ETIOLOGY
110WKLD ;
111 D LOOK^LRCAPV1
112 Q
113 S LRT=LRTS
114 S LRPLUK=0
115 F S LRPLUK=$O(^LAH(LRLL,1,LRPLUK)) Q:+LRPLUK'>0 D
116 . Q:$P(^LAH(LRLL,1,LRPLUK,0),U,5)'=LRAN
117 . S LRORG=0
118 . S LRIFN=LRPLUK
119 . F S LRORG=$O(^LAH(LRLL,1,LRIFN,3,LRORG)) K LRADD Q:LRORG<1 D
120 .. I $D(^LAH(LRLL,1,LRIFN,3,LRORG,0))#2 S LRGB1=+^(0) D
121 ... S GLB="^LAB(61.2,LRGB1,9,A)",LRADD=""
122 ... D DISP1 Q:'$G(LRIFN) D ETIOL^LRCAPV1
123 K GLB
124 F W !!?10,"(D)isplay (A)dd Work Load " R X:DTIME S X=$E(X) S:'$T!(X=U)!(X="") LREND=1 Q:X="A"!(LREND) D:X="D" DIS^LRCAPU
125 Q
126DISP1 ;
127 W !,"PROCESSING: ",^LAB(61.2,LRGB1,0),?60,$G(LRCODE)
128 Q
Note: See TracBrowser for help on using the repository browser.