Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRLNCNLT

LRLNCNLT.m

Go to the documentation of this file. 
  1. LRLNCNLT ;DALOI/FHS-PRINT LAB TEST W/O RESULT NLT CODE ;1-OCT-1998
  1.  ;;5.2;LAB SERVICE;**215,278,418**;NOV 01, 1997;Build 31
  1. EN ;
  1.  W @IOF,!! S LREND=0
  1.  W $$CJ^XLFSTR("This option will print tests and their RESULT NLT CODES",IOM)
  1.  W !,$$CJ^XLFSTR("assigned. Result NLT codes are required for LEDI and LOINC",IOM)
  1.  W !,$$CJ^XLFSTR("Mapping software to function properly.",IOM)
  1.  W !,$$CJ^XLFSTR("You may use the option 'Link Result NLT Manual' to make necessary changes.",IOM)
  1. ASK ;
  1.  K DIR S DIR(0)="S^0:All Lab Tests;1:Lab Tests with Result NLT Codes;2:Lab Tests without Result NLT Codes"
  1.  S DIR("?")="All will print Lab Tests with and w/o result NLT codes tests"
  1.  D ^DIR K DIR
  1.  G END:$S($G(DIRUT):1,$G(DUOUT):1,$G(DTOUT):1,1:0)
  1.  S LRSEL=Y
  1.  K %ZIS S %ZIS="Q" D ^%ZIS
  1.  G END:POP
  1.  I IO'=IO(0) S ZTRTN="DQ^LRLNCNLT",ZTIO=ION,ZTDESC="Print Lab Tests and Result Codes",ZTSAVE("LRSEL")="" D ^%ZTLOAD I $D(ZTSK)'[0 W !!?5," Tasked to Print on : ",ION G END
  1.  W @IOF D DQ G END
  1.  Q
  1. DQ ;
  1.  N DIR,LREND
  1.  S:$D(ZTQUEUED) ZTREQ="@" S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,1)
  1.  S (LRPAGE,LRCNT,LREND)=0
  1.  D HDR
  1.  S LRNODE="^LAB(60,""B"",0)",LRCNT=0
  1.  F  S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'="B"  Q:$G(LREND)  D
  1.  . Q:$G(@LRNODE)!($G(LREND))
  1.  . S LRIEN=$QS(LRNODE,4),LRNAME=$QS(LRNODE,3),LRC=$P($G(^LAB(60,LRIEN,64)),U,2)
  1.  . S LRX=$G(^LAB(60,+$G(LRIEN),0)) Q:$P(LRX,U,3)=""
  1.  . Q:$P(LRX,"^",4)'="CH"           ;only CH tests are relevant
  1.  . Q:$O(^LAB(60,LRIEN,2,0))'=""    ;only atomic tests are relevant
  1.  . Q:"BO"'[$P(LRX,U,3)
  1.  . I $G(LRSEL)=2,LRC Q
  1.  . I $G(LRSEL)=1,'LRC Q
  1.  . S LRCNT=$G(LRCNT)+1
  1.  . D TOF Q:$G(LREND)
  1.  . W !,$$RJ^XLFSTR(LRIEN,5),?8,LRNAME
  1.  . I $G(LRC) D NLTPRT(LRC)
  1.  Q
  1. NLTPRT(LRC) ;
  1.  D TOF Q:LREND
  1.  N LRSPEC
  1.  I '$D(^LAM(LRC,0))#2 W !?15," **** Corrupt DATABASE ****" Q
  1.  W !?5,"[ ",$P(^LAM(LRC,0),U,2),?18,$P(^(0),U)," ]",!
  1.  S LRSPEC=0 F  S LRSPEC=$O(^LAB(60,LRIEN,1,LRSPEC)) Q:LRSPEC<1!($G(LREND))  D
  1.  . S LRX=+$G(^LAB(60,LRIEN,1,LRSPEC,95.3)) Q:'LRX
  1.  . I $Y>(IOSL-4) D TOF1 Q:$G(LREND)  W !,$$RJ^XLFSTR(LRIEN,5),?8,LRNAME
  1.  . W !?10,"Specimen [ ",$P($G(^LAB(61,LRSPEC,0)),U),"]  Mapped to LOINC CODE"
  1.  . W !,$G(^LAB(95.3,LRX,80)),!
  1.  Q
  1. END ;
  1.  I $G(LRCNT) W !?20,"Total Printed Tests: ",LRCNT,!
  1.  I $E(IOST)="P-" W @IOF
  1.  D ^%ZISC
  1.  K DIR,DIRUT,DUOUT,LRC,LRCNT,LREND,LRIEN,LRNAME,LRNODE,LRPAGE
  1.  K LRPDT,LRSEL,LRX,POP,ZTIO,ZTDESC,ZTRTN,ZTSAVE
  1.  ;
  1.  Q
  1. TOF ;
  1.  Q:$Y<(IOSL-3)
  1. TOF1 I $E(IOST,1,2)="C-" D  Q:$G(LREND)
  1.  . S DIR(0)="E" D ^DIR
  1.  . S:$S($G(DIRUT):1,$G(DUOUT):1,1:0) LREND=1
  1. HDR ;
  1.  I $G(LRPAGE) W @IOF
  1.  S LRPAGE=$G(LRPAGE)+1 W !,?5,LRPDT,?60,"Page: ",LRPAGE
  1.  W !,$$CJ^XLFSTR("Alphabetical Listing of CH Subscripted Lab Tests",IOM)
  1.  I $G(LRSEL)=1 W !,$$CJ^XLFSTR("That have RESULT NLT CODES assigned",IOM),!
  1.  I $G(LRSEL)=2 W !,$$CJ^XLFSTR("That do not have RESULT NLT CODES assigned",IOM),!
  1.  W !,"  IEN     Lab Test Name " I $G(LRSEL)=2 W ! Q
  1.  W !,"      NLT #        Result NLT Code Name ",!
  1.  Q