1 | LRACM3 ;SLC/DCM - REPRINT/INITIALIZE PATIENT CUM REPORT ;6/12/89 16:21 ;
|
---|
2 | ;;5.2;LAB SERVICE;**174,201**;Sep 27, 1994
|
---|
3 | EN02 ;
|
---|
4 | PAT D A^LRACM1 I LRNOT D MSG^LRACM
|
---|
5 | D ASK^LRACM1 S LRRE=1 D LOOP,END^LRACM Q
|
---|
6 | LOOP K DIC D ^LRDPA Q:LRDFN<1 S LRNM=PNM,LRPAT=1 I '$D(^LAC(LRXLR,LRDFN)) W !!,$C(7),"NO DATA IN CUMULATIVE FILE FOR THIS PATIENT!!!"
|
---|
7 | D LOC^LRWU
|
---|
8 | Q:LREND
|
---|
9 | R !!,"Select (1) Re-initialize/Print patient's entire cumulative",!," (2) Reprint patient's previous cumulative. 2// ",LRTI:DTIME Q:'$T
|
---|
10 | S:LRTI="" LRTI=2 Q:"12"'[LRTI I LRTI["1" D TIRE Q:Y<0
|
---|
11 | K IO("Q") S %ZIS="QM" D ^%ZIS Q:POP
|
---|
12 | I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^LRACM3",ZTSAVE("D*")="",ZTSAVE("LR*")="",ZTSAVE("S*")="",ZTSAVE("U")="" D ^%ZTLOAD,^%ZISC K ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE Q
|
---|
13 | U IO
|
---|
14 | DQ D LOAD^LRACM,PT^LRX S LRIDT=0
|
---|
15 | I LRTI["1" D A,PAT^LRAC1
|
---|
16 | D:LRTI'["1" LRCALE^LRAC2,ENT^LRAC3,MICRO^LRAC1
|
---|
17 | W @IOF D ^%ZISC K LRPAT,LREN,LRRE,LRAC D END^LRACM S ZTREQ="@" Q
|
---|
18 | TIRE W !!?10,$C(7),"** THIS PRINT-OUT MUST BE CHARTED!!! **",! S J=0
|
---|
19 | S I=0 F S I=$O(^LRO(68,"AC",LRDFN,I)) Q:I<1 S J=I
|
---|
20 | I J>0 S J=9999999-J W:J>1 !,"STARTING DATE SHOULD AT LEAST GO BACK TO ",$$Y2K^LRX($P(J,".")),".",!,"There is data in the cross-reference back to this date that should be ",!,"on this patient's cumulative.",!
|
---|
21 | S %DT="AEQ",%DT("A")="ENTER STARTING DATE FOR REINITIALIZATION: " D ^%DT K %DT Q:Y<0 S LRXDT=9999999-Y
|
---|
22 | Q
|
---|
23 | A ;
|
---|
24 | S LRRE=0 K ^LR(LRDFN,"PG"),^LAC(LRXLR,LRDFN),^LAC("LGOT",LRDFN),^LRO(68,"AC",LRDFN),^LRO(68,"MI",LRDFN)
|
---|
25 | LRIDT S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LRXDT) S $P(^(LRIDT,0),U,9)="" D LRSB
|
---|
26 | Q:'$D(^LR(LRDFN,"MI")) S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!(LRIDT>LRXDT) F LRSB=1,5,8,11,16 I $D(^LR(LRDFN,"MI",LRIDT,LRSB)),'$D(^LRO(68,"MI",LRDFN,LRIDT,LRSB)) S ^(LRSB)="" W ":"
|
---|
27 | Q
|
---|
28 | LRSB S LRSB=0 F S LRSB=$O(^LR(LRDFN,"CH",LRIDT,LRSB)) Q:LRSB<1 I '$D(^LRO(68,"AC",LRDFN,LRIDT,LRSB)) S ^(LRSB)="" W "."
|
---|
29 | Q
|
---|