31 lines
2.0 KiB
Mathematica
31 lines
2.0 KiB
Mathematica
|
LRAPLG ;AVAMC/REG/WTY - AP LOG-IN ;10/23/01
|
||
|
|
;;5.2;LAB SERVICE;**72,201,259**;Sep 27, 1994
|
||
|
|
D ^LRAP Q:'$D(Y) S LR("L")=LRSS_"^LRAP" I LRCAPA,"AUSP"[LRSS S X=$S(LRSS="SP":"H & E STAIN",1:"AUTOPSY H & E") D X^LRUWK G:'$D(X) END S LRW("H&E")=LRT K LRT
|
||
|
|
I LRCAPA,LRSS="EM" S X="THICK SECTION EM" D X^LRUWK G:'$D(X) END S X=11 D SET S LRW("SS")=LRT_U_X S X="GRID EM" D X^LRUWK G:'$D(X) END S X=12 D SET S LRW("G")=LRT_U_X K LRT
|
||
|
|
I LRCAPA D @(LRSS_"^LRAPSWK") G:'$D(X) END
|
||
|
|
D:"SPEMCY"[LRSS A^LRAPWU W !!,"Log-In for ",LRH(0)," " S %=1 D YN^LRU Q:%<1 S LRAA(3)=1 D XR^LRU
|
||
|
|
I %=2 S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: " D ^%DT K %DT Q:Y<1 S LRAD=$E(Y,1,3)_"0000",Y=LRAD D D^LRU S LRH(0)=Y
|
||
|
|
S LRH(2)=$E(LRAD,1,3),LRWHN=$E(LRAD,2,3)
|
||
|
|
S:'$D(^LRO(68,LRAA,1,0)) ^(0)="^68.01DA^^0"
|
||
|
|
S:'$D(^LRO(68,LRAA,1,LRAD,0)) ^(0)=LRAD,^LRO(68,LRAA,1,0)=$P(^LRO(68,LRAA,1,0),"^",1,2)_"^"_LRAD_"^"_($P(^(0),"^",4)+1)
|
||
|
|
S:'$D(^LRO(68,LRAA,1,LRAD,1,0)) ^(0)="^68.02PA^^"
|
||
|
|
S %DT="",X="T-4" D ^%DT S LRDTI=9999999-Y
|
||
|
|
GETP W ! S LRSIT="",LRDPAF=1 K DIC
|
||
|
|
D ^LRDPA G:LRDFN<1 END
|
||
|
|
S:'+$G(LRPRAC) LRPRAC(1)=""
|
||
|
|
I +$G(LRPRAC) S X=LRPRAC D D^LRUA S LRPRAC(1)=X
|
||
|
|
I LRSS="SP" S X=0 F S X=$O(^LR(LRDFN,LRSS,X)) Q:'X!(X>LRDTI) D
|
||
|
|
.S Y=^LR(LRDFN,LRSS,X,0)
|
||
|
|
.W $C(7),!?6,"Accession number assigned for ",$$FMTE^XLFDT(Y,"D")
|
||
|
|
.W " is: ",$P(Y,"^",6)
|
||
|
|
I LRSS="SP" S X="SROSPLG" X ^%ZOSF("TEST") I $T D ^SROSPLG
|
||
|
|
D ADD G GETP
|
||
|
|
ADD I LRSS="AU",'$D(LREXP) W $C(7),!!,"NO DATE DIED ENTERED IN ",LRFNAM," FILE",! Q:+LRDPF=2 S DIE=+LRDPF,DA=DFN,DR=.351 D ^DIE Q:$D(Y) S LREXP=X
|
||
|
|
I LRSS="AU",$D(^LR(LRDFN,"AU")),$P(^("AU"),U,6) S Y=^("AU"),X=+$P(Y,U,6),Y(1)=$E(Y,1,3)_"0000" W !,"Yr:",1700+$E(Y,1,3)," Acc#:",X," IN LAB FILE FOR ",$P(@(LRPF_DFN_",0)"),U)," SSN:",$P(^(0),U,9) D CK Q
|
||
|
|
D:LRPF="^DPT(" ^LRAPPOW ; for AFIP studies
|
||
|
|
D ^LRAPLG1 K LRMD,DIC,DIE,DR Q
|
||
|
|
CK I +$G(^LRO(68,LRAA,1,Y(1),1,X,0))=LRDFN W $C(7),!!?20,"Also in accession file" Q
|
||
|
|
W !,"Enter in Accession File " S %=2 D YN^LRU D:%=1 ^LRAPLG2 Q
|
||
|
|
SET S X=$P($G(^LRO(69.2,LRAA,0)),"^",X) S:'X X=1 Q
|
||
|
|
END D V^LRU Q
|