source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAP.m@ 1046

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

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1LRAP ;AVAMC/REG/WTY - ANATOMIC PATH UTILITY ;10/23/01
2 ;;5.2;LAB SERVICE;**72,248,259**;Sep 27, 1994
3 ;
4 ;called by many routines in AP package
5 D END,CK G:Y=-1 END D LRDICS G:Y B
6 S DIC=68,DIC(0)="AEOQMZ"
7 S DIC("A")="Select ANATOMIC PATHOLOGY SECTION: "
8 S DIC("S")="I LRDICS[$P(^(0),U,2),$P(^(0),U,2)]"""",$G(^(3,DUZ(2),0))"
9 D ^DIC K DIC,LRDICS G:Y<1 END
10B S X=$P(Y,U,2) D ^LRUTL G:Y=-1 END Q
11AU ;log-in autopsy
12 Q ;see routine LRAUAW
13CY ;log-in cytopath
14 S (LRMD,LRSIT)=""
15 S DR=".06///"_LRAC_";.08///"_$S(LRLLOC["?":"UNKNOWN",1:LRLLOC)
16 S DR=DR_";.07;D:X P^LRUA;.011//^S X=LRPRAC(1);.012;.1//NOW"
17 S DR=DR_";S LRRC=X;.02;.99;S LRC(5)=X;1"
18 S DR(2,63.902)=".01;S LR(63.902)=X;S:'LRCAPA Y=0;.02//^S X=LR(63.902)"
19 Q
20EM ;log-in electron microscopy
21 S (LRMD,LRSIT)=""
22 S DR=".06///"_LRAC_";.08///"_$S(LRLLOC["?":"UNKNOWN",1:LRLLOC)
23 S DR=DR_";.07;D:X P^LRUA;.011//^S X=LRPRAC(1);.012;.1//NOW;S LRRC=X"
24 S DR=DR_";.02;.021;.99;S LRC(5)=X",DR(2,63.202)=.01
25 Q
26SP ;log-in surg path
27 S LR("FS")=+$G(^LAB(69.9,1,11)),(LRMD,LRSIT)=""
28 S DR=".06///"_LRAC_";.08///"_$S(LRLLOC["?":"UNKNOWN",1:LRLLOC)
29 S DR=DR_";.07//^S X=LR(.07);D:X P^LRUA;.011//^S X=LRPRAC(1);.012;.1//NOW"
30 S DR=DR_";S LRRC=X;.02;.99;S LRC(5)=X;S:'LR(""FS"") Y=0;1.3"
31 S DR(2,63.812)=.01
32 S:LRABV'["SP" LR("FS")=""
33 Q
34M ;edit path report parameters
35 W !
36 S DIC="^LRO(69.2,",DIC(0)="AEOQM"
37 S DIC("S")="I ""AUCYEMSP""[$P(^(0),U,2)&($P(^(0),U,2)]"""")"
38 D ^DIC K DIC G:Y<1 END S DA=+Y
39 L +^LRO(69.2,DA):5 I '$T D G M
40 .S MSG="This entry is locked by another user. Please try again later."
41 .D EN^DDIOL(MSG,"","!!") K MSG,DIE,DR,DA
42 .D END
43 S DR="[LRAPHDR]",DIE="^LRO(69.2,"
44 D ^DIE
45 L -^LRO(69.2,DA)
46 K DIE,DR,DA
47 G M
48D ;Edit path descriptions
49 W ! S DIC="^LAB(62.5,",DIC(0)="AEQLM"
50 S DLAYGO=62,DIC("S")="I ""ESCI""[$P(^(0),U,4)"
51 D ^DIC K DIC,DLAYGO G:X=""!(X[U) END S DA=+Y
52 S DIE("NO^")="",DIE="^LAB(62.5,"
53 L +^LAB(62.5,DA):5 I '$T D G D
54 .S MSG="This entry is locked by another user. Please try again later."
55 .D EN^DDIOL(MSG,"","!!") K MSG,DIE,DR,DA
56 .D END
57 S DR=".01;1;5;I ""ESCI""'[X W $C(7),!,""Enter E, S, C, or I"" S Y=5;10"
58 D ^DIE
59 L -^LAB(62.5,DA)
60 K DIE,DR,DA
61 G D
62V ;input transform DD(63.08,.11,0)
63 I $D(LRH(2)),LRH(2)'=$E(X,1,3) K X W !,"Year received must be same as log-in year (",LRH(2)+1700,") "
64 Q
65 ;
66CK S Y=1 I '$D(DUZ(2)) W !,$C(7)," Something is wrong...",!!,"I can't tell if you're really here...",!!,"Ask your IRM why you don't have a DUZ(2) variable defined!",! S Y=-1 Q
67 S LRAA(4)=$P($G(^DIC(4,+DUZ(2),0)),U) I LRAA(4)="" W $C(7),!!,"I can't tell what DIVISION you are from. Contact your IRM " S Y=-1 Q
68 Q
69 ;
70LRDICS S Y=0,X=$G(LRDICS) I $L(X)=2,"SPCYEMAU"[X D C I Y K LRDICS Q
71 S LRDICS=$S($L($G(LRDICS)):LRDICS,1:"SPCYEMAU") Q
72C G:$D(LRDICS(2)) CC S (A,B)=0 F S A=$O(^LRO(68,A)) Q:'A I $P($G(^LRO(68,A,0)),"^",2)=LRDICS,$G(^(3,DUZ(2),0)) S B=B+1,B(B)=A
73 I B=1 S Y=B(1)_U_$P(^LRO(68,B(1),0),U) K A,B Q
74 I B>1,$D(LRDICS(1)) S Y=B(1)_U_$P(^LRO(68,B(1),0),U) K A,B
75 Q
76CC S (A,B)=0 F S A=$O(^LRO(68,A)) Q:'A I $P($G(^LRO(68,A,0)),"^",2)=LRDICS S B=B+1,B(B)=A Q
77 I B=1 S Y=B(1)_U_$P(^LRO(68,B(1),0),U) K A,B
78 Q
79 ;
80END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.