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

LA7VLCM1.m

Go to the documentation of this file.
  1. LA7VLCM1 ;DALOI/JDB - LAB CODE MAPPING FILE UTILITIES ;03/07/12 10:09
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
  1. ;
  1. Q
  1. ;
  1. QUE(ZTRTN,ZTDESC,ZTSAVE) ;
  1. ; QUEUE a routine
  1. ; Returns -1 if POP=1, 0 if not queued, or the QUEUED task #
  1. N %ZIS,POP,QUEUED,Y
  1. S QUEUED=0
  1. S %ZIS="MQ" D ^%ZIS
  1. I POP D HOME^%ZIS Q -1
  1. I $D(IO("Q")) D ;
  1. . ;S QUEUED=1
  1. . S QUEUED=$$TASK(ZTRTN,ZTDESC,.ZTSAVE)
  1. Q QUEUED
  1. ;
  1. INIT ;
  1. ; General INIT for all reports
  1. S NOW=$$NOW^XLFDT()
  1. S (EXIT,PAGE)=0
  1. Q
  1. ;
  1. DFL(R6247,DFL) ;
  1. ; Data Field Length
  1. ; Inputs
  1. ; R6247 File #62.47 IEN
  1. ; DFL <byref> See Outputs
  1. ; Outputs
  1. ; DFL DFL array holds the max field sizes for each field
  1. ;
  1. N X,I
  1. ; find max length of .001 field
  1. S X=$O(^LAB(62.47,R6247,1,"A"),-1)
  1. S X=$L(X)
  1. S DFL(1)=$$BIG($G(DFL(1)),X)
  1. ; find max length of .01 field
  1. S X=0
  1. S I="" F S I=$O(^LAB(62.47,R6247,1,"B",I)) Q:I="" D ;
  1. . S:$L(I)>X X=$L(I)
  1. S DFL(2)=$$BIG($G(DFL(2)),X)
  1. ; find max length of .02 field
  1. S X=0
  1. S I="" F S I=$O(^LAB(62.47,R6247,1,"C",I)) Q:I="" D ;
  1. . S:$L(I)>X X=$L(I)
  1. S DFL(3)=$$BIG($G(DFL(3)),X)
  1. S DFL(4)=6
  1. Q
  1. ;
  1. HDRCAP(HDRCAP) ;
  1. ; Header Captions
  1. ; Inputs
  1. ; HDRCAP <byref> See Outputs
  1. ; Outputs
  1. ; HDRCAP Holds the column titles
  1. ;
  1. S HDRCAP(1)="SEQ"
  1. S HDRCAP(2)="ID"
  1. S HDRCAP(3)="SYSTEM"
  1. S HDRCAP(4)="PURPOSE"
  1. S HDRCAP(5)="NATL"
  1. Q
  1. ;
  1. SUB(DFL,R6247,SCR,R624701) ;
  1. ; Driver for displaying one #62.4701 subfile entry or
  1. ; an entire #62.47 entry.
  1. ; Inputs
  1. ; DFL
  1. ; R6247
  1. ; SCR
  1. ; R624701
  1. ;
  1. N I,X,Y,DF,IENS,NODE
  1. S SCR=$G(SCR)
  1. S R624701=+$G(R624701)
  1. I R624701 D Q ;
  1. . I ($Y+EOP)>IOSL D HDR(.DFL,$G(TITLE))
  1. . Q:EXIT
  1. . D DF(R6247,R624701,.DF)
  1. . D SHOW(.DF,.DFL,SCR)
  1. . Q:EXIT
  1. ;
  1. S NODE="^LAB(62.47,R6247,1,""B"")"
  1. I 'R624701 F S NODE=$Q(@NODE) Q:NODE="" Q:$QS(NODE,4)'="B" Q:$QS(NODE,3)'=1 Q:$QS(NODE,2)'=R6247 D Q:EXIT ;
  1. . S R624701=$QS(NODE,6)
  1. . I ($Y+EOP)>IOSL D HDR(.DFL,$G(TITLE))
  1. . Q:EXIT
  1. . D DF(R6247,R624701,.DF)
  1. . D SHOW(.DF,.DFL,SCR)
  1. . Q:EXIT
  1. Q
  1. ;
  1. DF(R6247,R624701,DF) ;
  1. ; Setup and populate the Data Fields array
  1. ; Inputs
  1. ; R6247
  1. ; R624701
  1. ; DF <byref>
  1. ; Outputs
  1. ; DF
  1. ;
  1. N IENS,DATA,DIERR
  1. S IENS=R624701_","_R6247_","
  1. D GETS^DIQ(62.4701,IENS,".001;.01;.02;.03;.04;.05;2.1;2.2","EI","DATA","")
  1. S DF(1)=$G(DATA(62.4701,IENS,.001,"E")) ;SEQ
  1. S:DF(1)="" DF(1)=R624701
  1. S DF(2)=DATA(62.4701,IENS,.01,"E") ;CODE
  1. S DF(3)=$G(DATA(62.4701,IENS,.02,"E")) ;CODE SYS
  1. S DF(4)=$G(DATA(62.4701,IENS,.03,"E")) ;PURPOSE
  1. S DF(5)=$G(DATA(62.4701,IENS,.04,"E")) ;OVERRIDE
  1. S DF(6)=$G(DATA(62.4701,IENS,.05,"E")) ;NATL CODE
  1. S DF(7)=$G(DATA(62.4701,IENS,2.1,"I")) ;REL ENTRY
  1. S DF(7.1)=$G(DATA(62.4701,IENS,2.1,"E")) ;REL ENTRY
  1. S DF(8)=$G(DATA(62.4701,IENS,2.2,"E")) ;MSG CONFIG
  1. Q
  1. ;
  1. SHOW(DF,DFL,SCR) ;
  1. ; Generic driver to display the data of a record
  1. ; Inputs
  1. ; DF <byref> Data Fields array
  1. ; DFL <byref> Data Fields Length array
  1. ; SCR <opt> Screen
  1. ;
  1. N POS,POS2,X,X2,FN,EXTRA,HDRCAP
  1. S SCR=$G(SCR)
  1. I SCR'="" X SCR Q:'$T
  1. S EXTRA=0
  1. D HDRCAP(.HDRCAP)
  1. I ($Y+EOP)>IOSL D HDR(.DFL,$G(TITLE)) Q:EXIT ;
  1. S POS=1
  1. S POS2=$$BIG(DFL(1),$L(HDRCAP(1)))
  1. W !?POS,$$RJ^XLFSTR(DF(1),POS2," ")
  1. S POS=POS+2+POS2
  1. S POS2=$$BIG(DFL(2),$L(HDRCAP(2)))
  1. W ?POS,$$RJ^XLFSTR(DF(2),POS2," ") ;CODE
  1. S POS=POS+2+POS2
  1. S POS2=$$BIG(DFL(3),$L(HDRCAP(3))) ;COD SYS
  1. W ?POS,DF(3)
  1. S POS=POS+2+POS2
  1. W ?POS,DF(4)
  1. S POS2=$$BIG(DFL(4),$L(HDRCAP(4)))
  1. S POS=POS+2+POS2
  1. W ?POS,DF(6)
  1. ; Display LOINC code text
  1. I DF(3)="LN" I DF(2)'="" D ;
  1. . N MSG,R953,X
  1. . Q:'$$ISLOINC^LA7VLCM3(DF(2))
  1. . S R953=$$FIND1^DIC(95.3,"","QOX",$P(DF(2),"-",1),"B^","","MSG")
  1. . Q:'R953
  1. . S X=$$GET1^DIQ(95.3,R953_",",80,"","","MSG")
  1. . Q:X=""
  1. . S EXTRA=1 W !," LOINC: "
  1. . I $L(X)>(IOM-$X-2) S X=$E(X,1,IOM-$X-2-3)_"..."
  1. . W X
  1. I DF(5)'="" S EXTRA=1 W !,"Override Concept: ",DF(5)
  1. ; create [File#:IEN]
  1. S FN=DF(7)
  1. I FN'="" S FN=+$P(FN,"(",2)_":"_$P(FN,";",1) S FN="[#"_FN_"]"
  1. I FN'="" S EXTRA=1 W !," Related Entry: ",FN," "
  1. S X=DF(7.1)
  1. ;truncate related entry text if needed
  1. I $L(X)>(IOM-$L(FN)-2-18) S X=$E(X,1,IOM-$L(FN)-2-18-3)_"..."
  1. W X
  1. I DF(8)'="" S EXTRA=1 W !," Msg Config: ",DF(8)
  1. I EXTRA W !
  1. Q
  1. ;
  1. CLEAN ;
  1. ; Clean up and quit
  1. I $E(IOST,1,2)'="C-" W @IOF
  1. I '$G(EXIT) I $E(IOST,1,2)="C-" D ;
  1. . D MORE()
  1. . W $C(13)_$J("",$G(IOM,80))_$C(13)
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I '$D(ZTQUEUED) D ^%ZISC
  1. Q
  1. ;
  1. BIG(A,B) ;
  1. ; Returns the bigger of two values
  1. Q $S(A<B:B,B<A:A,1:A)
  1. ;
  1. HDR(DFL,TITLE) ;
  1. ; Generic driver to display the header of the report
  1. ; Inputs
  1. ; DFL <byref> Data Field Length array
  1. ; TITLE <opt> The title to use for this report
  1. ;
  1. N POS,POS2,HDRCAP
  1. S TITLE=$G(TITLE)
  1. I TITLE="" S TITLE="LAB CODE MAPPING"
  1. D HDRCAP(.HDRCAP)
  1. I '$D(ZTQUEUED),PAGE,$E(IOST,1,2)="C-" S EXIT=$$MORE() Q:EXIT
  1. W @IOF S $X=0
  1. S PAGE=PAGE+1
  1. W ?0,$E(TITLE,1,IOM-34),?IOM-32,$$FMTE^XLFDT(NOW),?IOM-10," Page: ",PAGE
  1. S POS=1
  1. S POS2=$$BIG($L(HDRCAP(1)),DFL(1))
  1. W !?POS,$$RJ^XLFSTR(HDRCAP(1),POS2," ") ;SEQ
  1. S POS=POS+2+POS2
  1. W ?POS,$$RJ^XLFSTR(HDRCAP(2),DFL(2)," ") ;ID
  1. S POS2=$$BIG($L(HDRCAP(2)),DFL(2))
  1. S POS=POS+2+POS2
  1. W ?POS,HDRCAP(3) ;"SYSTEM"
  1. S POS2=$$BIG($L(HDRCAP(3)),DFL(3))
  1. S POS=POS+2+POS2
  1. W ?POS,HDRCAP(4) ;PURPOSE
  1. S POS2=$$BIG($L(HDRCAP(4)),$G(DFL(4)))
  1. S POS=POS+2+POS2
  1. W ?POS,HDRCAP(5) ;NATL
  1. W !,$$REPEAT^XLFSTR("=",IOM)
  1. Q
  1. ;
  1. MORE(NULL) ;
  1. ; Prompts user to hit ENTER to continue
  1. ; Returns 1 if user enters "^" else returns 0
  1. N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. I $E($G(IOST),1,2)'="C-" Q 0
  1. I $D(ZTQUEUED) Q 0
  1. S DIR(0)="E"
  1. D ^DIR
  1. W $C(13)_$J("",$G(IOM,80))_$C(13)
  1. Q $D(DIRUT)
  1. ;
  1. TASK(ZTRTN,ZTDESC,ZTSAVE) ;
  1. ; Tasks the specified routine
  1. ; Returns the task # or 0
  1. N ZTDTH,ZTSK,ZTIO
  1. D ^%ZTLOAD
  1. D ^%ZISC
  1. W !,"Request "_$S($G(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued")
  1. Q +$G(ZTSK)
  1. ;
  1. RVID(I) ;
  1. ; Reverse Video On/Off
  1. ; Inputs
  1. ; I I=1 turns on reverse video I=0 turns off reverse video
  1. ;
  1. Q:$E($G(IOST),1,2)'="C-"
  1. I $G(IORVON)'="" I $G(IORVOFF)'="" D ;
  1. . W:'I IORVOFF
  1. . W:I IORVON
  1. Q
  1. ;
  1. PROGRESS(LAST) ;
  1. ; Prints a "." when NOW > LAST + INT
  1. ; Input
  1. ; LAST : <byref> The last $H when "." was shown
  1. N INT
  1. S INT=1 ;interval in seconds
  1. I $P($H,",",2)>(+$P(LAST,",",2)+INT) S LAST=$H W "."
  1. Q
  1. ;
  1. LOINCFSN(LOINC) ;
  1. ; Returns the FSN for this LOINC code
  1. ; Needs to be FM safe for use within FM calls
  1. N R953,LAMSG,LAX
  1. N X,Y,X1,X2,DA,FDA,IENS,DIC,DIE,DIERR
  1. Q:'$$ISLOINC^LA7VLCM3(LOINC) "" ;
  1. ; cant use $$FIND1 here -- not sym table safe
  1. S LAX=$P(LOINC,"-",1)
  1. S R953=0
  1. I LAX'="" S R953=$O(^LAB(95.3,"B",LAX,0))
  1. Q:'R953 "" ;
  1. Q $$GET1^DIQ(95.3,R953_",",80,"","","LAMSG")