Changeset 623 for WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSPT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSPT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSPT.m
r613 r623 1 LRSPT 2 ;;5.2;LAB SERVICE;**1,72,248,259,373**;Sep 27, 1994;Build 1 3 4 5 6 7 8 9 10 11 12 13 GETP 14 15 16 17 18 19 20 21 22 23 24 CH 25 26 27 28 29 30 DEV 31 32 33 34 35 36 37 38 39 QUE 40 41 42 43 44 45 46 47 48 49 50 51 52 K 53 54 55 56 57 58 59 D 60 61 62 63 64 65 66 AU 67 68 69 .D:$Y>(IOSL-13) F^LRAPF,H S X=^LRO(69.2,LRAA,10,LR("A"),0) D ^DIWP70 71 72 73 H 74 75 END 76 77 78 SGL 79 CONT 80 81 82 83 1 LRSPT ;AVAMC/REG/WTY - AP PRELIMINARY REPORTS ;10/16/01 2 ;;5.2;LAB SERVICE;**1,72,248,259**;Sep 27, 1994 3 ; 4 ;Reference to ^%DT supported by IA #10003 5 ;Reference to ^DPT supported by IA #918 6 ;Reference to ^DIWP suppported by IA #10011 7 ;Reference to ^DIWW suppported by IA #10029 8 ;Reference to EN^DDIOL supported by IA #10142 9 ; 10 S X="T",%DT="" D ^%DT,D^LRU S LRTOD=Y D EN2^LRUA 11 W !!,"Preliminary reports for ",LRO(68) 12 G END:LRAPX=2,SGL:LRAPX=3,CH:LRAPX=4 13 GETP D EN1^LRUPS Q:LRAN=-1 14 G:$D(^LRO(69.2,LRAA,1,LRAN,0)) GETP 15 L +^LRO(69.2,LRAA,1):5 I '$T D G GETP 16 .S MSG(1)="The preliminary reports queue is in use by another person. " 17 .S MSG(1,"F")="!!" 18 .S MSG(2)="You will need to add this accession to the queue later." 19 .D EN^DDIOL(.MSG) K MSG 20 S ^LRO(69.2,LRAA,1,LRAN,0)=LRDFN_"^"_LRI 21 S X=^LRO(69.2,LRAA,1,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 22 L -^LRO(69.2,LRAA,1) 23 G GETP 24 CH S LRAPX(1)=1 D EN^LRSPRPT2 Q:%<1 25 W !!,"Save preliminary reports for reprinting " 26 S %=2 D YN^LRU S:%=1 LRSAV=1 27 ;Variable LR("DVD") is used to divide reports displayed in the browser 28 K LR("DVD") 29 S $P(LR("DVD"),"|",IOM)="" 30 DEV ; 31 W ! 32 S %ZIS="Q" D ^%ZIS 33 I POP W ! Q 34 I $D(IO("Q")) D Q 35 .S ZTDESC="ANAT PATH PRELIM REPORT" 36 .S ZTSAVE("LR*")="",ZTRTN="QUE^LRSPT" 37 .D ^%ZTLOAD W:$D(ZTSK) !,"Request Queued, #",ZTSK W ! 38 .K ZTSK,IO("Q") D HOME^%ZIS 39 QUE ; 40 U IO 41 ;LRSF515=1 means this is generating and SF515. 42 S:'$D(LRSF515) LRSF515=0 43 D L^LRU,L1^LRU,S^LRU,SET^LRUA 44 S LR("SPSM")=1 ;Set flag to suppress printing of SNOMED codes 45 S LRS(5)=1,LRQ(2)=1,LRA=$S($D(^LRO(69.2,LRAA,0)):$P(^(0),U,9),1:1) 46 S:LRA="" LRA=1 47 S LR("DIWF")=$S($P(^LRO(69.2,LRAA,0),"^",6)="D":"D",1:"")_"W" 48 I $D(LRAP) S LRDFN=$P(LRAP,"^"),LRI=$P(LRAP,"^",2) D D G K 49 S LRAN=0 F S LRAN=$O(^LRO(69.2,LRAA,1,LRAN)) Q:'LRAN!(LR("Q")) D 50 .S X=^LRO(69.2,LRAA,1,LRAN,0),LRDFN=+X,LRI=$P(X,"^",2) D D 51 .W:IOST["BROWSER" !!,LR("DVD") 52 K K:'$D(LRSAV) ^LRO(69.2,LRAA,1) K P,S,LRAN 53 S ^LRO(69.2,LRAA,1,0)="^69.21A^^" 54 I 'LR("Q"),$D(LR("F")),IOST?1"C".E D CONT 55 K LRSAV 56 W:IOST?1"P-".E @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" 57 K %,DIR,DTOUT,DUOUT,DIRUT,X,Y 58 Q 59 D K ^UTILITY($J) I '$D(^LR(LRDFN,0)) K ^LRO(69.2,LRAA,1,LRAN) Q 60 N LRPRE S LRPRE=1 ;Notifies EN^LRSPRPT that this is a prelim report 61 D EN^LRSPRPT Q:LR("Q") 62 I $P($G(^LR(LRDFN,0)),"^",2)=2 D Q:LR("Q") 63 .D ^LRAPPOW 64 G:'$D(^LR(LRDFN,"SP",0))&('$D(^LR(LRDFN,"CY",0)))&('$D(^LR(LRDFN,"EM",0))) AU 65 D ^LRAPT1 Q:LR("Q") 66 AU I $D(^LR(LRDFN,"AU")),$L($P(^LR(LRDFN,"AU"),"^")) D ^LRAPT2 Q:LR("Q") 67 K ^UTILITY($J) S DIWR=IOM-5,DIWF="W",LR("A")=0 68 W ! F LRZ=0:1 S LR("A")=$O(^LRO(69.2,LRAA,10,LR("A"))) Q:'LR("A") D 69 .D:$Y>(IOSL-6) H S X=^LRO(69.2,LRAA,10,LR("A"),0) D ^DIWP 70 D:LRZ ^DIWW 71 S LRO=1 D F^LRAPF 72 Q 73 H ;from LRAPPF1 74 D F^LRU W !,"ANATOMIC PATHOLOGY",!,LR("%") Q 75 END W $C(7),!!,"OK TO DELETE THE ",LRO(68)," PRELIMINARY REPORT LIST" S %=2 D YN^LRU I %=1 K ^LRO(69.2,LRAA,1) S ^LRO(69.2,LRAA,1,0)="^69.21A^0^0" W $C(7),!,"LIST DELETED !" Q 76 W !!,"FINE, LET'S FORGET IT",! Q 77 ; 78 SGL D EN1^LRUPS Q:LRAN=-1 S LRAP=LRDFN_"^"_LRI,LRSAV=1 D EN2^LRUA G DEV 79 CONT ; 80 K DIR S DIR(0)="E" 81 D ^DIR W ! 82 S:$D(DTOUT)!(X[U) LR("Q")=1 83 Q
Note:
See TracChangeset
for help on using the changeset viewer.
