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

LA7VLCM6.m

Go to the documentation of this file. 
  1. LA7VLCM6 ;DALOI/JDB - LAB CODE MAPPING FILE UTILITIES ;03/07/12  15:51
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
  1.  ;
  1.  Q
  1.  ; Ex subs are the main entry points from menus, etc..
  1.  ; Px subs are the main workhorse (called from Ex)
  1. E0 ;
  1.  ; Individual CONCEPT from #62.47 file
  1.  N DIC,X,Y,ZTQUEUED,ZTSAVE
  1.  N R6247
  1.  W !
  1.  S DIC="^LAB(62.47,"
  1.  S DIC(0)="AEMQ"
  1.  D ^DIC
  1.  I Y<1 Q
  1.  S R6247=+Y
  1.  S X="SUB^LA7VLCM6("_R6247_")"
  1.  S ZTSAVE("R6247")=""
  1.  S X=$$QUE^LA7VLCM1(X,"Print CONCEPT from #62.47",.ZTSAVE)
  1.  I X=-1 Q
  1.  I X=0 D P0(R6247) Q
  1.  Q
  1.  ;
  1. E1 ;
  1.  ; Display CONCEPT SUSC MAPPINGS #7 & #21 from File #62.47
  1.  N X,Y,DIR,SHOW,MSGCFG,CODSET
  1.  N DTOUT,DUOUT,DIRUT,DIROUT
  1.  S SHOW="A"
  1.  S DIR(0)="SB^A:ALL;M:MAPPED;U:UNAMPPED"
  1.  S DIR("A")="Print (A)ll, (M)apped, (U)nmapped"
  1.  S DIR("B")="A"
  1.  S DIR("?")="Mapped/Unmapped refers to entries that have their RELATED ENTRY field either set or not set."
  1.  D ^DIR
  1.  I $E(Y,1,1)="^" Q
  1.  I "^A^M^U^"'[("^"_Y_"^") S Y="A"
  1.  S SHOW=Y
  1.  ; Select a Message Config
  1.  ; xref=^LAB(62.47,"AG",R6248,R6247,R624701)
  1.  ;
  1.  ; Select a Code Set
  1.  ; xref=^LAB(62.47,R6247,1,"C",Code Set,DA)
  1.  ;
  1.  S X="P1^LA7VLCM6("_SHOW_")"
  1.  S X=$$QUE^LA7VLCM1(X,"Print SUSC from #62.47")
  1.  I X=-1 Q
  1.  I X=0 D P1(SHOW)
  1.  Q
  1.  ;
  1. E2 ;
  1.  ; Display all LOCAL codes in File #62.47
  1.  N X
  1.  S X="P2^LA7VLCM6"
  1.  S X=$$QUE^LA7VLCM1(X,"Print LOCAL CODES from #62.47")
  1.  I X=-1 Q
  1.  I X=0 D P2 Q
  1.  Q
  1.  ;
  1. P0(R6247) ;
  1.  ; Display individual CONCEPT
  1.  N EXIT,LINE,LINE2,NOW,PAGE,EOP,TITLE
  1.  N DFL
  1.  D INIT^LA7VLCM1
  1.  S EOP=5 ;line padding at end of page
  1.  D DFL^LA7VLCM1(R6247,.DFL)
  1.  D HDR^LA7VLCM1(.DFL,"")
  1.  D SUB^LA7VLCM1(.DFL,R6247)
  1.  Q
  1.  ;
  1. P1(SHOW) ;
  1.  ; Display #7 and #21 Susceptibilities
  1.  ; Inputs
  1.  ;  SHOW :<opt> Show all or partial matches (entry has RELATED FILE?)
  1.  ;       : A=all<default> M=mapped  U=unmapped
  1.  ;
  1.  N EXIT,LINE,LINE2,NOW,PAGE,EOP,TITLE
  1.  N R6247,R624701,DFL,IORVOFF,IORVON,X,CODE,NODE
  1.  S SHOW=$G(SHOW,"A")
  1.  D INIT^LA7VLCM1
  1.  S X="IORVON;IORVOFF"
  1.  D  ;
  1.  . N %ZIS
  1.  . D ENDR^%ZISS
  1.  S TITLE="LAB CODE MAPPING -- SUSCEPTIBILITIES"
  1.  S EOP=5
  1.  ; get max field sizes
  1.  F R6247=7,21 D  ;
  1.  . D DFL^LA7VLCM1(R6247,.DFL)
  1.  D HDR^LA7VLCM1(.DFL,TITLE)
  1.  F R6247=7,21 D  Q:EXIT  ;
  1.  . I R6247'=7 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.  . I SHOW="A" D  Q  ;
  1.  . . D SUB^LA7VLCM1(.DFL,R6247)
  1.  . I SHOW'="A" D  Q  ;
  1.  . . S CODE=""
  1.  . . S R624701=0
  1.  . . S NODE="^LAB(62.47,R6247,1,""B"")"
  1.  . . F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,4)'="B"  Q:$QS(NODE,3)'=1  Q:$QS(NODE,2)'=R6247  Q:EXIT  D  ;
  1.  . . . S CODE=$QS(NODE,5)
  1.  . . . S R624701=$QS(NODE,6)
  1.  . . . Q:'R624701
  1.  . . . S X=$G(^LAB(62.47,R6247,1,R624701,2))
  1.  . . . S X=$P(X,U,1)
  1.  . . . I SHOW="M" Q:X=""  ;mapped
  1.  . . . I SHOW="U" Q:X'=""  ;unmapped
  1.  . . . D SUB^LA7VLCM1(.DFL,R6247,,R624701)
  1.  . . ;
  1.  . ;
  1.  D CLEAN^LA7VLCM1
  1.  Q
  1.  ;
  1. P2 ;
  1.  ; Display all Local Codes
  1.  N EXIT,LINE,LINE2,NOW,PAGE,EOP,START,TITLE
  1.  N R6247,R624701,DFL,IORVON,IORVOFF,X,CODE,CODSET
  1.  D INIT^LA7VLCM1
  1.  S EOP=5
  1.  S TITLE="LAB CODE MAPPING -- LOCAL CODES"
  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.  F  S R6247=$O(^LAB(62.47,R6247)) Q:'R6247  D  Q:EXIT  ;
  1.  . ; does this R6247 have any Local codes?
  1.  . I '$O(^LAB(62.47,R6247,1,"AC",0,0)) Q
  1.  . I 'START 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.  . K ^TMP("LA7VLCM6-P2",$J)
  1.  . S R624701=0
  1.  . ;create sort global
  1.  . F  S R624701=$O(^LAB(62.47,R6247,1,"AC",0,R624701)) Q:'R624701  D  ;
  1.  . . S X=$G(^LAB(62.47,R6247,1,R624701,0))
  1.  . . S CODE=$P(X,U,1)
  1.  . . S CODSET=$P(X,U,2)
  1.  . . S:CODE="" CODE="??" S:CODSET="" CODSET="??" S ^TMP("LA7VLCM6-P2",$J,CODE,CODSET,R624701)=""
  1.  . ;now go thru sorted codes for display
  1.  . S NODE="^TMP(""LA7VLCM6-P2"",$J)"
  1.  . F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,2)'=$J  Q:$QS(NODE,1)'="LA7VLCM6-P2"  D  Q:EXIT  ;
  1.  . . S R624701=$QS(NODE,5)
  1.  . . Q:'R624701
  1.  . . D SUB^LA7VLCM1(.DFL,R6247,,R624701)
  1.  . S START=0
  1.  . K ^TMP("LA7VLCM6-P2",$J)
  1.  . ;
  1.  D CLEAN^LA7VLCM1
  1.  Q