source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPT.m@ 1604

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1LRAPT ;AVAMC/REG/WTY - AP PATIENT RPT ;9/22/00
2 ;;5.2;LAB SERVICE;**72,173,248**;Sep 27, 1994
3 ;
4 ;Reference to ^%DT supported by IA #10003
5 ;Reference to ^%ZIS supported by IA #10086
6 ;Reference to ^DIC( supported by IA #916
7 ;Reference to $$DTIME^XUP supported by IA # -none available-
8 ;
9 D END S X="T",%DT="" D ^%DT S LRT=Y D D^LRU S LRTOD=Y
10 S IOP="HOME" D ^%ZIS
11 W @IOF,!?28,"Cum path data summaries"
12 S DTIME=$$DTIME^XUP(DUZ),U="^"
13ASK W !!?14,"1. DISPLAY cum path data summary for A patient"
14 W !?14,"2. PRINT cum path data summary for patient(s)",!
15 R "Select (1-2): ",X:DTIME G:X=""!(X[U) END
16 G:X?1"1".E!(X?1"D".E) ^LRAPS
17 I X'?1"2".E&(X'?1"P".E) W $C(7),!!,"Answer 1 or 2",! G ASK
18 S LRDICS="SP",(LRDICS(1),LRDICS(2))=1 D ^LRAP G:'$D(Y) END
19 D ^LRUL I '$O(^LRO(69.2,LRAA,7,DUZ,1,0)) D R^LRUL G END
20 K DIC,DIE,DR S ZTRTN="QUE^LRAPT" D BEG^LRUTL
21 D:POP R^LRUL G:POP!($D(ZTSK)) END
22QUE U IO S (LRS(5),LRQ(9))=1 D L^LRU,S^LRU,EN^LRUA
23 S PNM=0
24 F PNM(1)=0:0 S PNM=$O(^LRO(69.2,LRAA,7,DUZ,1,"C",PNM)) Q:PNM=""!(LR("Q")) D
25 .F LRDFN=0:0 S LRDFN=$O(^LRO(69.2,LRAA,7,DUZ,1,"C",PNM,LRDFN)) Q:'LRDFN!(LR("Q")) D
26 ..D LOOP
27 K LRAU
28 W:IOST'?1"C".E&($E(IOST,1,2)'="P-"!($D(LR("FORM")))) @IOF
29 D R^LRUL,END^LRUTL,END
30 Q
31LOOP K ^LRO(69.2,LRAA,7,DUZ,1,LRDFN),^LRO(69.2,LRAA,7,DUZ,1,"C",PNM,LRDFN)
32 L +^LRO(69.2,LRAA,7,DUZ):1 Q:'$T
33 S X(1)=$O(^LRO(69.2,LRAA,7,DUZ,1,0)),X=^(0),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_($P(X,"^",4)-1)
34 L -^LRO(69.2,LRAA,7,DUZ)
35 S DR=1,LRQ=0,LRDPF=$P(^LR(LRDFN,0),U,2),LRPF=^DIC(LRDPF,0,"GL")
36 S LRFLN=+$P(@(LRPF_"0)"),"^",2),DFN=$P(^LR(LRDFN,0),"^",3)
37 S LRPPT=@(LRPF_DFN_",0)")
38 S LRP=$P(LRPPT,"^"),SEX=$P(LRPPT,"^",2),Y=$P(LRPPT,"^",3),SSN=$P(LRPPT,"^",9) D D^LRU,SSN^LRU S DOB=$S(Y[1700:"",1:Y)
39 S (LRADM,LRADX)=""
40 S LRLLOC=$S($D(@(LRPF_DFN_",.1)")):^(.1),$D(^LR(LRDFN,.1)):^(.1),1:"")
41 I LRPF="^DPT(",$D(VAIN) S LRADM=$P(VAIN(7),U,2),LRADX=VAIN(9)
42 G:'$D(^LR(LRDFN,"SP"))&('$D(^LR(LRDFN,"CY")))&('$D(^LR(LRDFN,"EM"))) AU
43 D ^LRAPT1 S LRV(1)=1
44AU Q:LR("Q") I $D(^LR(LRDFN,"AU")),+^("AU") S LRV(1)=1 D ^LRAPT2
45 Q:LR("Q") I '$D(LRV(1)) D H^LRAPT1 W !!,"NO PATHOLOGY ENTRIES IN LAB FILE !",!
46 Q
47H ;from LRAPT2, LRAPT3
48 I $D(LR("F")),$E(IOST,1,2)["C-" D M^LRU Q:LR("Q")
49 D F^LRU W !,"ANATOMIC PATHOLOGY" W:$D(LR("W")) !,LRAA(1)," QA from ",LRSTR," to ",LRLST W !,LR("%") Q
50H1 D H Q:LR("Q") W !,LRP,?32,SSN,?52,"DOB:",DOB Q
51 ;
52END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.