source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLNCTOP.m@ 724

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1LRLNCTOP ;DALOI/RH-LEDI HL7 CODES ;11-OCT-1998
2 ;;5.2;LAB SERVICE;**215,232**;Sep 27,1994
3EN ;
4 W @IOF
5 W !,$$CJ^XLFSTR("This option prints a list of SITE/SPECIMENS from the LABORATORY TEST FILE",IOM)
6 W !,$$CJ^XLFSTR(" Standard LEDI HL7 specimen codes in the Topography file.",IOM)
7 W !,$$CJ^XLFSTR("You will be prompted to print the specimen with or without the LEDI HL7 codes; ",IOM)
8WHICH ;
9 W !!
10 W !,"Print Topography with or without a LEDI HL7 CODE and Time Aspect."
11 K DIR S DIR("?")="Print Topography with or without a LEDI HL7 CODE and Time Aspect"
12 S DIR(0)="S^1:WITH;2:WITHOUT" D ^DIR K DIR
13 S LRANS=Y
14 I $D(DIRUT) G EXIT Q
15 K %ZIS S %ZIS="Q" D ^%ZIS G:POP EXIT
16 I $D(IO("Q")) D QUE Q
17 U IO D START,^%ZISC Q
18QUE ;
19 S ZTRTN="START^LRLNCTOP",ZTDESC="TOPOGRAPHY REPORT"
20 S ZTSAVE("LRANS")=""
21 D ^%ZTLOAD
22 I $D(ZTSK)'[0 W !,"REQUEST QUEUED TO ",ION
23 D HOME^%ZIS K IO("Q") Q
24START ;BEGINS PRINTING THE REPORT
25 I LRANS=1 D ALPHA
26 I LRANS=2 D EN2
27 D EXIT
28 Q
29ALPHA ;PRINTS THE ALPHABETIC LISTING OF SPECIMEN THAT HAVE A LEDI HL7 CODE IN THE TOPOGRAPHY FILE
30 D INI,HDR1,EQUALS^LRX
31 S LRTOP="^LAB(61,""B"",0)"
32 F S LRTOP=$Q(@LRTOP) Q:$QS(LRTOP,2)'="B" Q:$G(LREND) D
33 . I $G(@LRTOP)!($G(LREND)) Q
34 . S LRIEN=+$QS(LRTOP,4)
35 . S LRY=$G(^LAB(61,LRIEN,0)) Q:'$L(LRY)
36 . I $Y+4>IOSL D HDR D:'LREND HDR1,EQUALS^LRX Q:$G(LREND)
37 . Q:'$P($G(^LAB(61,LRIEN,0)),U,9)!('$P($G(^LAB(61,LRIEN,0)),U,10))
38 . W !?3,"[",$J(LRIEN,4),"]",?11,$E($P(LRY,U),1,20)
39 . S LRIEN=$P(LRY,U,9) Q:'$D(^LAB(64.061,LRIEN,0))#2
40 . W ?33,$E($P(^LAB(64.061,LRIEN,0),U),1,20)_"|"_$$GET1^DIQ(64.061,+$P(LRY,U,10),1)
41 Q
42EN2 ;PRINTS THE SPECIMEN THAT DO NOT HAVE A LEDI HL7 CODE
43 D INI,HDR2,EQUALS^LRX
44 S LRNODE="^LAB(60,""B"",0)"
45 F S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'="B" Q:$G(LREND) D
46 . I $G(@LRNODE)!($G(LREND)) Q
47 . S LRI=+$QS(LRNODE,4)
48 . S LRX=$G(^LAB(60,LRI,0)) Q:'$L($P(LRX,U))!($P(LRX,U,3)="")!($P(LRX,U,3)="N")
49 . S LRIEN=0 F S LRIEN=$O(^LAB(60,LRI,1,LRIEN)) Q:LRIEN<1!$G(LREND) D
50 .. S LRY=$G(^LAB(61,LRIEN,0)) Q:$P(LRY,U)=""
51 .. I $P(LRY,U,9) Q
52 .. I $Y+5>IOSL D HDR D:'LREND HDR2,EQUALS^LRX Q:$G(LREND)
53 .. W !
54 .. W:LRTEST'=$P(LRX,U) ?5,$P(LRX,U)
55 .. W ?37,$E($P(LRY,U),1,30)
56 .. S LRTEST=$P(LRX,U)
57 Q
58INI ;INITIALIZE VARIABLES
59 S (LREND,LRPAGE)=0,LRTEST="" W:$E(IOST,1,2)="C-" @IOF
60HDR ;PRINT HEADING
61 I LRPAGE,$E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R LRN:DTIME S LREND='$T!(LRN="^") Q:LREND
62 S LRPAGE=LRPAGE+1
63 S LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"Z5M")
64 Q
65HDR1 ;PRINT HEADING FOR SPECIMENS WITH A LEDI HL7 CODE
66 W @IOF
67 W !?50,LRDT,?(IOM-10)," Page ",$J(LRPAGE,3)
68 W !
69 W !,$$CJ^XLFSTR("A LISTING FROM THE TOPOGRAPHY FILE OF SPECIMENS WITH LEDI HL7 CODE",IOM)
70 W !,$$CJ^XLFSTR("AND HAVE TIME ASPECT ENTERED",IOM)
71 W !
72 W !?3,"FILE 61"
73 W !?4,"[IEN]",?11,"SITE/SPECIMEN",?32,"ELEC CODE NAME|TIME ASPECT"
74 Q
75HDR2 ;PRINT HEADING FOR TESTS WITHOUT A LEDI HL7 CODE
76 W @IOF
77 W !?50,LRDT,?(IOM-10)," Page ",$J(LRPAGE,3)
78 W !!?23,"LAB SPECIMEN WITHOUT LEDI HL7 CODE"
79 W !,$$CJ^XLFSTR("THESE SPECIMENS NEED LEDI HL7 CODES DEFINED IN THE TOPOGRAPHY FILE",IOM)
80 W !!?5,"LAB TEST NAME",?37,"SITE/SPECIMEN"
81 Q
82EXIT ;
83 S:$D(ZTQUEUED) ZTREQ="@"
84 K LREND,LRPAGE,LRI,LRX,LRANS,LRY,LRDT,LRIEN,LRTEST
85 K DIR,DIRUT,DUOUT,ZTIO,ZTDESC,ZTRTN,ZTSAVE
86 K LRN,Y,POP,ZTSK,ZTQUEUED,ZTREQ
87 Q
Note: See TracBrowser for help on using the repository browser.