source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRACM3.m@ 861

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1LRACM3 ;SLC/DCM - REPRINT/INITIALIZE PATIENT CUM REPORT ;6/12/89 16:21 ;
2 ;;5.2;LAB SERVICE;**174,201**;Sep 27, 1994
3EN02 ;
4PAT D A^LRACM1 I LRNOT D MSG^LRACM
5 D ASK^LRACM1 S LRRE=1 D LOOP,END^LRACM Q
6LOOP 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
14DQ 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
18TIRE 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
23A ;
24 S LRRE=0 K ^LR(LRDFN,"PG"),^LAC(LRXLR,LRDFN),^LAC("LGOT",LRDFN),^LRO(68,"AC",LRDFN),^LRO(68,"MI",LRDFN)
25LRIDT 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
28LRSB 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
Note: See TracBrowser for help on using the repository browser.