source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRDPA.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: 5.7 KB
Line 
1LRDPA ;SLC/RWF/WTY/KLL - FILE OF FILES LOOKUP ON ENTITIES ; 2/28/03 4:10pm
2 ;;5.2;LAB SERVICE;**137,121,153,202,211,248,305,360**;Sep 27, 1994;Build 1
3 ;
4 ;Reference to ^DIC( supported by IA #916
5 ;Reference to ^DIC("AC" supported by IA #511
6 ;Reference to ^ORD(100.99 supported by IA #2414
7 ;Reference to ^DIC supported by IA #10006
8 ;Reference to LK^ORX2 supported by IA #867
9 ;Reference to ULK^ORX2 supported by IA #867
10 ;Reference to $$DTIME^XUP supported by IA # -none available-
11 ;Reference to EN^DDIOL supported by IA #10142
12 ;
13 ;IF '$D(DIC) USE PATIENT FILE, ALLOW "FILE:NAME" EXTENDED SYNTAX
14 ;IF DIC=0 ASK FILE NAME, IF PATIENT FILE, USE DPA,
15 ; OTHERWISE ^DIC LOOK-UP
16 ;IF DIC=N^GLOBAL, LOOK-UP ON FILE N
17 ;RETURN (DFN,Y)=IFN, LRDPF=N^GLOBAL, '$D(DIC), LRDFN=IFN OF ^LR
18 ; GLOBAL PNM=NAME,SSN=SSN,SSN(1)=LAST4,SSN(2)=SSN WITHOUT '-'
19 ;ROUTINE SSN^LRU CONTROLS SSN FORMAT
20 ;ALSO WILL RETURN LRLABKY variable if not defined.
21 ;LRLOOKUP=1 blocks ability to add new entries (lookup only)
22 S:$G(LRREFFL) DIC="67^LRT(67"
23 G:$G(LRORDRR)="R" ^LRDPAREF
24 S X="",U="^",DTIME=$$DTIME^XUP(DUZ)
25 S DIC(0)=$S('$D(DIC(0)):"EMQZ",DIC(0)["A":"EMQZ",1:DIC(0))
26 S:DIC(0)'["Z" DIC(0)=DIC(0)_"Z"
27 K DLAYGO I '($D(DIC)[0),DIC'=0,'$P(DIC,"^") S DIC=0
28DPA ;from LRUPS
29 D:'$D(LRLABKY) LABKEY^LRPARAM
30 K VADM,VAIN,VA
31 S LRDPF="" G ANY:'($D(DIC)[0)
32 R !,"Select Patient Name: ",X:DTIME
33DPA1 ;Entry point from PNAME^LRAPDA
34 I X'?1"%"9N.E,X=""!(X["^") S DFN=-1 K DLAYGO G END
35 ;The X'?1"%"9N.E was added since the VIC data stream contains a carat.
36 I X="??" W !,"You may enter patient identification or enter a file name followed by "":"".",!,"You may enter ""?:?"" for more extended help." G DPA
37EN1 ;from LRUG, LRUPS
38 I X[":" S LRX=$P(X,":",2),X=$P(X,":",1),DIC=0 K:LRX="" LRX G ANY:X=""!(X["?") W !," File: ",X G FL
39EN ;
40 S:DIC(0)'["Z" DIC(0)=DIC(0)_"Z"
41 S DIC="^DPT(",LRDPF="2^DPT(",VA200=""
42 ; DLAYGO not allowed for DPT( on first pass
43 S DIC("S")="S:X?1""%""9N.E1""?"" X=$E(X,2,10) I 1"
44 ;The DIC("S") was added to preprocess any data from a VIC card. The VIC
45 ;card data has guard codes before and after the patient data. The SSN
46 ;is extracted if these guard codes exist. DIC("S") was added in several
47 ;places and in all instances it is being killed immediately after use.
48 D ^DIC K DIC("S"),DLAYGO K:Y>0 DUOUT
49 ;Since VIC card data contains carats, DUOUT will be returned whenever
50 ;the VIC card is used. If the user ^'s out, Y will be equal to -1.
51 ;If Y is greater than 0 the data is valid and DUOUT should be ignored.
52 I Y<1 K DIC D LAYG G DPA
53 S DFN=+Y,PNM=$P(Y(0),"^") D PT^LRX D:DOD'="" WARN G END
54 ;
55LAYG ;Don't allow DLAYGO on second pass.
56 K DLAYGO S DIC(0)="EQMZ" Q
57 Q:'$P($G(LRPARAM),"^",6)
58 Q:'$D(LRLABKY)
59 S DLAYGO=2 S DIC(0)="EQMZL"
60 Q
61ANY S:DIC'=0 LRDPF=+DIC_^DIC(+DIC,0,"GL") G FL1:DIC'=0 D FILE
62 G NONE:Y=-1,FL0
63 ;
64FL S DIC="^DIC(",DIC(0)=$S(X]"":"EMQZ",1:"AEMQZ"),DIC("S")="I $D(^DIC(""AC"",""LR"",+Y))" D ^DIC G NONE:Y=-1
65FL0 S LRDPF=+Y_^DIC(+Y,0,"GL"),DIC=LRDPF I +$G(LRDPF)=2 K DIC G LRDPA
66FL1 ;
67 D:'$D(LRLABKY) LABKEY^LRPARAM
68 ;DLAYGO not allowed for DPT(
69 I +LRDPF'=2,'$G(LRLOOKUP) S DLAYGO=+LRDPF
70 S DIC="^"_$P(LRDPF,"^",2),DIC(0)=$S($D(LRX):"EMQZ",1:"AEMQZ")
71 I '$G(LRLOOKUP) D
72 .S DIC(0)=DIC(0)_$S(+LRDPF>60&(+LRDPF<70)&$D(LRLABKY):"L",+LRDPF>1000:"L",1:"")
73 .S:DIC(0)["L" DLAYGO=+LRDPF
74 S:$D(LRX) X=LRX K LRX,DIC("S")
75 I X["?" S DIC("S")="S:X?1""%""9N.E1""?"" X=$E(X,2,10) I 1" D ^DIC K DIC("S") K:Y>0 DUOUT S:DIC(0)'["A" DIC(0)=DIC(0)_"A"
76 W:DIC(0)'["A" " Entry: ",X
77 S DIC("S")="S:X?1""%""9N.E1""?"" X=$E(X,2,10) I 1"
78 S:DIC="^LAB(62.3," DIC("S")=DIC("S")_" "_"I '$P(^LAB(62.3,Y,0),U,4)"
79 D ^DIC K DIC("S") G NONE:Y=-1 S DFN=+Y,PNM=$P(Y(0),"^") D PT^LRX
80 G END
81NONE S Y=-1,DFN=-1,LRDFN=-1,LRDPF="0^NULL("
82 K DIC,VAIN,VADM,VA S VA200="" Q
83 Q
84REASK S DFN=-1,DIC("S")="S:X?1""%""9N.E1""?"" X=$E(X,2,10) I 1",DIC(0)=DIC(0)_"A"
85 D ^DIC K:Y>0 DUOUT K DIC("S") G:Y<1 END S DFN=+Y,PNM=$P(Y(0),"^") D PT^LRX
86END ;from LROR, LRSETUP
87 S:'$D(DFN) DFN=-1 S Y=DFN
88 I DFN=-1 D Q
89 .S LRDFN=-1 K DIC,DLAYGO S VA200=""
90 S X="^"_$P(LRDPF,"^",2)_Y_",""LR"")",LRDFN=+$S($D(@X):@X,1:-1)
91 G E3:LRDFN>0
92 L +^LR(0):5 I '$T D Q
93 .S MSG="The LAB DATA file is locked. Please try again later."
94 .D EN^DDIOL(MSG,"","!!") K MSG
95 .S (DFN,LRDFN)=-1,VA200=""
96 .K DIC,DLAYGO
97 S LRDFN=$P(^LR(0),"^",3)+1
98 I $D(@X) L -^LR(0) K DIC,DLAYGO G LRDPA
99E2 I $D(^LR(LRDFN)) S LRDFN=LRDFN+1 G E2
100 S ^LR(LRDFN,0)=LRDFN_"^"_+LRDPF_"^"_DFN,@X=LRDFN,^(0)=$P(^LR(0),"^",1,2)_"^"_LRDFN_"^"_(1+$P(^(0),"^",4)),^LR("B",LRDFN,LRDFN)="" L -^LR(0)
101E3 I '$D(^LR(LRDFN,0))#2 W !!,"Internal patient ID incorrect in ^LR( for ",PNM,". Contact Lab Coordinator.",$C(7) S LRDFN=-1 Q
102 I LRDFN>0,$P(^LR(LRDFN,0),"^",2)'=+LRDPF!($P(^(0),"^",3)'=DFN) W !,$C(7),"Internal patient ID incorrect for ",PNM,". Contact Lab Coordinator." S LRDFN=-1 Q
103 D INF^LRX
104 D ^LRDPA1:($D(LRDPAF)&(LRDFN>0)) K DIC,DLAYGO S VA200=""
105 I DFN,$P($G(^ORD(100.99,1,"CONV")),"^")=0 D EN^LR7OV2(DFN_";"_$P(LRDPF,"^",2),1)
106 Q
107 ;
108FILE I X'["?" W !,"Select FILE: " R X:DTIME I X["^"!(X="") S X="",Y=-1 Q
109 D DICQ:X["?" G FILE:X=""
110 S DIC="^DIC(",DIC(0)="EMQZ"
111 S DIC("S")="I $D(^DIC(""AC"",""LR"",+Y)),+Y'=44"
112 D ^DIC K DIC("S") I Y=-1 G FILE
113 Q
114DICQ ;
115 S DIC="^DIC(",DIC(0)="EQZ",D="AC",X="LR"
116 S DIC("S")="I +Y'=44" D IX^DIC
117 I Y=-1 S X="" Q
118 S X=Y(0,0)
119 K D,DIC S Y=1
120 Q
121% R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
122 ;
123EN2(DFN,LOCK,TALK) ;Patient Lock
124 ;TALK 1:write, 0:silent
125 ;LOCK 1:lock, 0:unlock
126 Q:'$G(DFN)
127 S:'$D(LOCK) LOCK=0 S:'$D(TALK) TALK=0
128 S X=DFN_";DPT("
129 I LOCK D LK^ORX2
130 I 'LOCK D ULK^ORX2
131 Q
132WARN ;Warn the user the patient has died and display date of death (LR*5.2*360)
133 S Y=DOD D DD^LRX
134 W !?10,@LRVIDO,"Patient ",PNM," died on: ",Y,@LRVIDOF,!
135 S DIR(0)="Y"
136 S DIR("A")="Do you wish to continue with this patient [Yes/No]"
137 S DIR("T")=120
138 D ^DIR K DIR
139 I Y=0!($D(DIRUT)) S DFN=-1
140 K DIRUT
141 Q
Note: See TracBrowser for help on using the repository browser.