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

LA7VLCM4.m

Go to the documentation of this file. 
  1. LA7VLCM4 ;DALOI/JDB - LAB CODE MAPPING FILE UTILITIES ;03/07/12  12:29
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
  1.  ;
  1.  ; Ex subs are the main entry points from menus, etc..
  1.  ; Px subs are the main workhorse (called from Ex)
  1.  Q
  1.  ;
  1. E1 ;
  1.  ; Print specific IDENTIFIER in #62.47
  1.  N CODE,X,DATA
  1.  S X=$$FINDID(.DATA)
  1.  Q:'X
  1.  S CODE=DATA(1)
  1.  S X="P1^LA7VLCM4("_CODE_")"
  1.  S QUE=$$QUE^LA7VLCM1(X,"Find Identifier from #62.47")
  1.  I QUE=-1 Q
  1.  I 'QUE D P1(CODE)
  1.  Q
  1.  ;
  1. P1(CODE) ;
  1.  ; Print code based on Message Config (R6248)
  1.  ; Inputs
  1.  ;   CODE  The code (IDENTIFIER) to display
  1.  N EXIT,LINE,LINE2,NOW,PAGE,EOP,START,TITLE
  1.  N R6247,R624701,DFL,IORVON,IORVOFF,X,CODSET,CONCLAST
  1.  N TMPNM,MSGCFG,LAMSG
  1.  S TMPNM="LA7VLCM4-P1"
  1.  K ^TMP(TMPNM,$J)
  1.  D INIT^LA7VLCM1
  1.  S EOP=5
  1.  S TITLE="LAB CODE MAPPING ("_CODE_")"
  1.  S X="IORVON;IORVOFF"
  1.  D  ;
  1.  . N %ZIS
  1.  . D ENDR^%ZISS
  1.  ; get max field sizes
  1.  S R6247=0
  1.  F  S R6247=$O(^LAB(62.47,R6247)) Q:'R6247  D  ;
  1.  . D DFL^LA7VLCM1(R6247,.DFL)
  1.  S R6247=0
  1.  S START=1
  1.  D HDR^LA7VLCM1(.DFL,TITLE)
  1.  ; find matching records
  1.  S NODE="^LAB(62.47,""AH"",CODE)"
  1.  F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,2)'="AH"  Q:$QS(NODE,3)'=CODE  D  ;
  1.  . S R6247=$QS(NODE,4)
  1.  . S R624701=$QS(NODE,5)
  1.  . S X=$G(^LAB(62.47,R6247,1,R624701,0))
  1.  . S CS=$P(X,U,2)
  1.  . S:CS="" CS=" "
  1.  . S MSGCFG=$$GET1^DIQ(62.4701,R624701_","_R6247_",",2.2,"","LAMSG")
  1.  . S:MSGCFG="" MSGCFG=" "
  1.  . S ^TMP(TMPNM,$J,R6247,CODE,CS,MSGCFG,R624701)=""
  1.  ;
  1.  D P1DISP
  1.  K ^TMP("LA7VLCM4-P1",$J)
  1.  D CLEAN^LA7VLCM1
  1.  Q
  1.  ;
  1. P1DISP ;
  1.  ; Utility display function for P1 (above)
  1.  ; now go thru sorted codes for display
  1.  ; ^TMP("LA7VLCM2-P1",$J,R6247,MSGCFG,R6248,CODE,CODSET,R624701)=""
  1.  N NODE,R6247,R624701,LASTCONC
  1.  N TMPNM
  1.  S TMPNM="LA7VLCM4-P1"
  1.  S LASTCONC=0 ;Last Concept printed
  1.  S NODE="^TMP(TMPNM,$J)"
  1.  F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,2)'=$J  Q:$QS(NODE,1)'=TMPNM  D  Q:EXIT  ;
  1.  . S R6247=$QS(NODE,3)
  1.  . S R624701=$QS(NODE,7)
  1.  . Q:'R624701
  1.  . I LASTCONC'=R6247 D  ;
  1.  . . I LASTCONC'=0 W !
  1.  . . D RVID^LA7VLCM1(1)
  1.  . . W !,"CONCEPT:",$$GET1^DIQ(62.47,R6247_",",".01","E","","")
  1.  . . W "  (",$$GET1^DIQ(62.47,R6247_",",".02","I","",""),")"
  1.  . . I $E($G(IOST),1,2)="C-" W $$RJ^XLFSTR("",IOM-$X," ")
  1.  . . D RVID^LA7VLCM1(0)
  1.  . . S LASTCONC=R6247
  1.  . D SUB^LA7VLCM1(.DFL,R6247,,R624701)
  1.  . ;
  1.  K ^TMP(TMPNM,$J)
  1.  Q
  1.  ;
  1. FINDID(DATA) ;
  1.  ; Driver used with LOOKUP^LA7VLCM5 to emulate a DIC call
  1.  ; so users can select IDENTIFIERS from entire file.
  1.  ; Inputs
  1.  ;  DATA <byref>  See Outputs below
  1.  ;
  1.  ; Outputs
  1.  ;  Returns #62.47 IEN_"^"_#62.4701 IEN or "0^0" if no selection
  1.  ;  DATA(1) = Selection's text
  1.  ;  DATA(2) = Global node
  1.  ;
  1.  N IN,DIR,STOP,Y,LIST,SEL,NODE,FOUND
  1.  N GBL,OUT,USTAT,IDARR,SCRN
  1.  N R6247,R624701
  1.  K DATA
  1.  S FOUND=0
  1.  S (R6247,R624701)=0
  1.  S GBL="^LAB(62.47,""AH"","
  1.  S SCRN=""
  1.  S IDARR("NODE0")="^LAB(62.47,DA(1),1,DA,0)"
  1.  S IDARR("DA",0)=5
  1.  S IDARR("DA",1)=4
  1.  S STOP=0
  1.  ;
  1.  F  Q:STOP  Q:FOUND  D  ;
  1.  . S GBL="^LAB(62.47,""AH"","
  1.  . K IDARR
  1.  . S IDARR("NODE0")="^LAB(62.47,DA(1),1,DA,0)"
  1.  . S IDARR("DA",0)=5
  1.  . S IDARR("DA",1)=4
  1.  . W !,"Select IDENTIFIER: "
  1.  . R IN:$G(DTIME,300)
  1.  . I '$T S STOP=1 Q
  1.  . I IN']"" S STOP=1 Q
  1.  . I $E(IN,1,1)="^" S STOP=1 Q
  1.  . I IN=" " D  ;
  1.  . . ; space bar return
  1.  . . S X=$G(^TMP($J,"LA7VLCM4","SBR",DUZ))
  1.  . . I X'="" S IN=X W " ",X
  1.  . ;
  1.  . I IN="?" D  Q  ;
  1.  . . W !,"  Enter an IDENTIFIER to find"
  1.  . ;
  1.  . I $E(IN,1,2)="??" D  ;
  1.  . . S FOUND=$$LOOKUP^LA7VLCM5(GBL,"??",.OUT,.USTAT,SCRN,.IDARR)
  1.  . . I USTAT="^" S STOP=1
  1.  . . Q:'FOUND
  1.  . . S SEL=OUT
  1.  . . S NODE=OUT(1)
  1.  . . S R6247=$QS(NODE,4)
  1.  . . S R624701=$QS(NODE,5)
  1.  . ;
  1.  . I 'FOUND I $E(IN,1,2)'="??" D  ;
  1.  . . S FOUND=$$LOOKUP^LA7VLCM5(GBL,IN,.OUT,.USTAT,"",.IDARR)
  1.  . . S:USTAT="^" STOP=1
  1.  . . I 'FOUND I 'STOP D  Q:STOP  ;
  1.  . . . S GBL="^LAB(62.47,""AF"","""_IN_""""
  1.  . . . K IDARR
  1.  . . . S IDARR("NODE0")="^LAB(62.47,DA(1),1,DA,0)"
  1.  . . . S IDARR("DA",0)=6
  1.  . . . S IDARR("DA",1)=5
  1.  . . . S FOUND=$$LOOKUP^LA7VLCM5(GBL,"??",.OUT,.USTAT,"",.IDARR)
  1.  . . . S:USTAT="^" STOP="^"
  1.  . . I USTAT="^" S STOP=1
  1.  . . I 'FOUND D  Q  ;
  1.  . . . I 'STOP I USTAT<1 W $C(7)," ??"
  1.  . . ;
  1.  . . S SEL=OUT
  1.  . . S NODE=OUT(1)
  1.  . . S ^TMP($J,"LA7VLCM4","SBR",DUZ)=SEL ;space bar return
  1.  . . S R6247=$QS(NODE,4)
  1.  . . S R624701=$QS(NODE,5)
  1.  . ;
  1.  ;
  1.  I FOUND D  ;
  1.  . S DATA(1)=SEL
  1.  . S DATA(2)=NODE
  1.  Q R6247_"^"_R624701
  1.  ;