| [613] | 1 | LRAPT ;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="^"
|
|---|
| 13 | ASK 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
|
|---|
| 22 | QUE 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
|
|---|
| 31 | LOOP 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
|
|---|
| 44 | AU 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
|
|---|
| 47 | H ;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
|
|---|
| 50 | H1 D H Q:LR("Q") W !,LRP,?32,SSN,?52,"DOB:",DOB Q
|
|---|
| 51 | ;
|
|---|
| 52 | END D V^LRU Q
|
|---|
