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