- 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 Feb 18, 2025@23:07 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")