1 | LRXREF ;SLC/RWA/DALOI/FHS - BUILD CROSS-REFERENCES FOR RE-INDEX ;7/9/92 01:26
|
---|
2 | ;;5.2;LAB SERVICE;**70,153,263**;Sep 27, 1994
|
---|
3 | AVS1 ;Rebuild "AVS" cross-reference in file 68 for Re-index utility
|
---|
4 | I $D(DIU(0)),'$L($P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,4)) S ^LRO(68,"AVS",DA(2),DA(1),DA)=$P(^LRO(68,DA(2),1,DA(1),1,DA,0),U)_"^"_$P(^(3),U,5)
|
---|
5 | Q
|
---|
6 | AVS2 I $D(DIU(0)),$L($P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,4)) K ^LRO(68,"AVS",DA(2),DA(1),DA)
|
---|
7 | Q
|
---|
8 | AVS3 I '$D(DIU(0)),$L($P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,4)) K ^LRO(68,"AVS",DA(2),DA(1),DA)
|
---|
9 | Q
|
---|
10 | AVS4 I '$D(DIU(0)),'$L($P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,4)) S ^LRO(68,"AVS",DA(2),DA(1),DA)=$P(^LRO(68,DA(2),1,DA(1),1,DA,0),U)_"^"_$P(^(3),U,5)
|
---|
11 | Q
|
---|
12 | ;
|
---|
13 | AC1 ;Build "AC" cross-reference when comment is deleted from a verified
|
---|
14 | ;test in File 63. Audit trail only.
|
---|
15 | I '$D(DIU(0)),$D(DUZ),$P(^LR(DA(2),"CH",DA(1),0),U,3) S ^LR(DA(2),"CH",DA(1),1,"AC",DUZ,$H)=$P(^LR(DA(2),"CH",DA(1),0),U,3,4)_"^"_X
|
---|
16 | Q
|
---|
17 | ;Build and Kill "AN"" cross-reference in File 69, when results available
|
---|
18 | AN1 S ^LRO(69,"AN",$E($P(^LRO(69,DA(1),1,DA,0),U,7),1,15),$P(^(0),U),9999999-$P(^LRO(69,DA(1),1,DA,1),U))=""
|
---|
19 | Q
|
---|
20 | AN2 K ^LRO(69,"AN",$E($P(^LRO(69,DA(1),1,DA,0),U,7),1,15),$P(^(0),U),9999999-$P(^LRO(69,DA(1),1,DA,1),U))
|
---|
21 | Q
|
---|
22 | ; Build and Kill "AR" cross-reference in File 69, when results available
|
---|
23 | AR1 S LRDT=$E(X,1,7),LRLLOC=$E($P(^LRO(69,DA(1),1,DA,0),U,7),1,15)
|
---|
24 | S LRDFN=$P(^(0),U),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) S LRGN=^DIC(+LRDPF,0,"GL")_DFN_",0)" S LRGN=$S($D(@LRGN):@LRGN,1:"") S LRPNM=$P(LRGN,U)
|
---|
25 | Q
|
---|
26 | AR2 S ^LRO(69,LRDT,1,"AR",LRLLOC,LRPNM,LRDFN)="" K LRDT,LRGN,LRDFN,LRLLOC,LRPNM
|
---|
27 | Q
|
---|
28 | AR3 K ^LRO(69,LRDT,1,"AR",LRLLOC,LRPNM,LRDFN) K LRDT,LRGN,LRDFN,LRLLOC,LRPNM
|
---|
29 | Q
|
---|
30 | LRKILL ; This cross-reference will be reset when the cumulative runs. Due
|
---|
31 | ;to the complexity of the cumulative reporting it was felt that
|
---|
32 | ;it was better to have reprinted data rather than possibly having
|
---|
33 | ;some data not printed at all.
|
---|
34 | K ^LAC("LRKILL") Q
|
---|
35 | AP ;Build and kill "AP" cross-refernce in File 69, when results available
|
---|
36 | S LRDATE=$P($P(^LRO(69,DA(1),1,DA,3),U),"."),LRPHY=$P(^LRO(69,DA(1),1,DA,0),U,6),LRPHY=$S($D(^VA(200,LRPHY,0)):$E($P(^(0),U),1,20),1:"UNK")
|
---|
37 | S LRDFN=$P(^LRO(69,DA(1),1,DA,0),U),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) S LRGN=^DIC(+LRDPF,0,"GL")_DFN_",0)" S LRGN=$S($D(@LRGN):@LRGN,1:"") S LRPNM=$P(LRGN,U)
|
---|
38 | Q
|
---|
39 | AP1 S ^LRO(69,LRDATE,1,"AP",LRPHY,LRPNM,LRDFN)="" K LRDATE,LRPHY,LRPNM,LRDFN,LRGN,LRDPF,DFN
|
---|
40 | Q
|
---|
41 | AP2 K ^LRO(69,LRDATE,1,"AP",LRPHY,LRPNM,LRDFN) K LRDATE,LRPHY,LRPNM,LRDFN,LRGN,LRDPF,DFN
|
---|
42 | Q
|
---|
43 | AL ;Build and kill "AL" cross-reference inFile 69, when results available
|
---|
44 | S LRDATE=$P($P(^LRO(69,DA(1),1,DA,3),U),"."),LRDFN=$P(^LRO(69,DA(1),1,DA,0),U),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) S LRGN=^DIC(+LRDPF,0,"GL")_DFN_",0)" S LRGN=$S($D(@LRGN):@LRGN,1:"") S LRPNM=$P(LRGN,U)
|
---|
45 | S LRLLOC=$E($P(^LRO(69,DA(1),1,DA,0),U,7),1,15)
|
---|
46 | Q
|
---|
47 | AL1 S ^LRO(69,LRDATE,1,"AL",LRLLOC,LRPNM,LRDFN)="" K LRDATE,LRPNM,LRDFN,LRGN,LRDPF,DFN,LRLLOC
|
---|
48 | Q
|
---|
49 | AL2 K ^LRO(69,LRDATE,1,"AL",LRLLOC,LRPNM,LRDFN) K LRDATE,LRPNM,LRDFN,LRGN,LRDPF,DFN,LRLLOC
|
---|
50 | Q
|
---|
51 | UP ;Convert lower to upper case.
|
---|
52 | F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,1,%-1)_$C($A(X,%)-32)_$E(X,%+1,99)
|
---|
53 | Q
|
---|
54 | TRIG ;Trigger LAB Workload
|
---|
55 | ;Stuff the Cap Code Name into field .03 of field 4 of field 1 of field 1
|
---|
56 | ;of ^LRO(67.9 LAB MONTHLY WORKLOAD
|
---|
57 | S X=$P($G(^LAM($O(^LAM("E",$P(^LRO(67.9,DA(3),1,DA(2),1,DA(1),1,DA,0),U),0)),0)),U)
|
---|
58 | Q
|
---|
59 | TRIGTS ;Trigger to stuff treating specialty name into .03 field of ^DD(67.91148
|
---|
60 | S X=$P($G(^DIC(42.4,+$P($G(^LRO(67.9,DA(4),1,DA(3),1,DA(2),1,DA(1),1,DA,0)),U),0)),U) S:'$L(X) X="AMBULATORY CARE"
|
---|
61 | Q
|
---|
62 | TRIG9 ;Trigger for LAB Workload
|
---|
63 | ;Stuff the Cap Code Name into field .03 of field 4 of field 1 of field 1
|
---|
64 | ;of ^LRO(67.99999 ARCHIVED LAB MONTHLY WORKLOAD
|
---|
65 | S X=$P($G(^LAM($O(^LAM("E",$P(^LRO(67.99999,DA(3),1,DA(2),1,DA(1),1,DA,0),U),0)),0)),U)
|
---|
66 | Q
|
---|
67 | TRIGTS9 ;Trigger to stuff treating specialty name into .03 field of ^DD(67.999991148
|
---|
68 | S X=$P($G(^DIC(42.4,+$P($G(^LRO(67.99999,DA(4),1,DA(3),1,DA(2),1,DA(1),1,DA,0)),U),0)),U) S:'$L(X) X="AMBULATORY CARE"
|
---|
69 | Q
|
---|
70 | LAM185 ;Trigger logic to set TYPE(#5) of CODE (#18) of WKLD CODE (#64)
|
---|
71 | N %1
|
---|
72 | S %1=$P(X,";",2),X=$S(%1="ICPT(":"CPT",%1="LAB(61.1,":"SNO",%1="LAB(95.3,":"LOINC",%1="ICD9(":"ICD",1:"NOS")
|
---|
73 | Q
|
---|