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

LA7VLCM2.m

Go to the documentation of this file. 
  1. LA7VLCM2 ;DALOI/JDB - LAB CODE MAPPING FILE UTILITIES ;03/07/12  10:45
  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 #62.47 entries based on Msg Config and Concept
  1.  N X,Y,CNT,QUE,DIR,R6248
  1.  S (X,CNT)=0
  1.  ; how many #62.48s in #62.47
  1.  F  S X=$O(^LAB(62.47,"AG",X)) Q:X=""  Q:CNT>1  S CNT=CNT+1
  1.  I CNT=0 W !,"No entries to display." Q
  1.  I CNT=1 D  ;
  1.  . S R6248=$O(^LAB(62.47,"AG",0))
  1.  ;
  1.  I CNT>1 D  ;
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="Print All Message Configurations? "
  1.  . S DIR("B")="N"
  1.  . S DIR("?")="Print all codes associated with all message configurations."
  1.  . D ^DIR
  1.  . S R6248=0
  1.  . I Y=0 D  Q:R6248'>0  ;
  1.  . . N DIC
  1.  . . S DIC=62.48
  1.  . . S DIC(0)="AENOQ"
  1.  . . S DIC("S")="I $D(^LAB(62.47,""AG"",+Y))"
  1.  . . D ^DIC
  1.  . . K DIC
  1.  . . S R6248=+Y
  1.  . ;
  1.  Q:R6248<0
  1.  S X="P1^LA7VLCM2("_R6248_")"
  1.  S QUE=$$QUE^LA7VLCM1(X,"Print Codes from #62.47")
  1.  I QUE=-1 Q
  1.  I 'QUE D P1(R6248)
  1.  Q
  1.  ;
  1. P1(R6248) ;
  1.  ; Print codes based on Message Config (R6248)
  1.  N EXIT,LINE,LINE2,NOW,PAGE,EOP,START,TITLE
  1.  N R6247,R624701,DFL,IORVON,IORVOFF,X,CODE,CODSET,CONCLAST
  1.  N TMPNM
  1.  S TMPNM="LA7VLCM2-P1A"
  1.  K ^TMP(TMPNM,$J)
  1.  D INIT^LA7VLCM1
  1.  S EOP=5
  1.  S TITLE="LAB CODE MAPPING (BY MSG CONFIG)"
  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.  I 'R6248 D  ;
  1.  . ;go thru Msg Configs in alpha order
  1.  . N MSGCFG
  1.  . S MSGCFG=""
  1.  . F  S MSGCFG=$O(^LAHM(62.48,"B",MSGCFG)) Q:MSGCFG=""  D  Q:EXIT  ;
  1.  . . S R6248=$O(^LAHM(62.48,"B",MSGCFG,0))
  1.  . . Q:'R6248
  1.  . . D P1A(R6248)
  1.  . ; 
  1.  . S R6248=0
  1.  ;
  1.  I R6248 D  ;
  1.  . D P1A(R6248)
  1.  ;
  1.  D P1DISP
  1.  K ^TMP("LA7VLCM2-P1A",$J)
  1.  D CLEAN^LA7VLCM1
  1.  Q
  1.  ;
  1. P1A(R6248) ;
  1.  ; Helper method for P1
  1.  ; Creates then steps through its ^TMP global and then
  1.  ; calls the display method
  1.  N R6247,R624701,NODE,X,CODE,CODSET,MSGCFG
  1.  N TMPNM
  1.  S TMPNM="LA7VLCM2-P1A"
  1.  S R6247=0
  1.  S NODE="^LAB(62.47,""AG"",R6248)"
  1.  F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,3)'=R6248  Q:$QS(NODE,2)'="AG"  Q:$QS(NODE,1)'=62.47  D  ;
  1.  . S R6247=$QS(NODE,4)
  1.  . S R624701=$QS(NODE,5)
  1.  . ;create sort global
  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="??"
  1.  . S X=$G(^LAHM(62.48,R6248,0))
  1.  . S MSGCFG=$P(X,U,1)
  1.  . S ^TMP(TMPNM,$J,R6247,MSGCFG,R6248,CODE,CODSET,R624701)=""
  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,R6248,R6247,R624701,LASTCONC
  1.  N TMPNM
  1.  S TMPNM="LA7VLCM2-P1A"
  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 R6248=$QS(NODE,5)
  1.  . S R6247=$QS(NODE,3)
  1.  . S R624701=$QS(NODE,8)
  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. E2 ;
  1.  ; Print #62.47 entries with bad IDENTIFIER/CODE SYSTEM mappings
  1.  N X,Y,CNT,QUE,DIR
  1.  S (X,CNT)=0
  1.  S X="P2^LA7VLCM2(1)"
  1.  S QUE=$$QUE^LA7VLCM1(X,"Code/Set mismatches in #62.47")
  1.  I QUE=-1 Q
  1.  I 'QUE D P2(0)
  1.  Q
  1.  ;
  1. P2(QUE) ;
  1.  ; Print entries with bad IDENTIFIER/CODE SYS mappings
  1.  ; Inputs
  1.  ;    QUE   1=was queued
  1.  N EXIT,LINE,LINE2,NOW,PAGE,EOP,START,TITLE
  1.  N R6247,R624701,DFL,IORVON,IORVOFF,X,TMPNM
  1.  N CODE,CS,CONCLAST,NODE,LADOT
  1.  N TMPNM
  1.  S QUE=+$G(QUE)
  1.  S TMPNM="LA7VLCM2-P2"
  1.  K ^TMP(TMPNM,$J)
  1.  D INIT^LA7VLCM1
  1.  S EOP=5
  1.  S TITLE="LAB CODE MAPPING (CODE/SET MISMATCHES)"
  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.  ; build list
  1.  I 'QUE D WAIT^DICD
  1.  S LADOT=$H
  1.  S NODE="^LAB(62.47,""AF"")"
  1.  F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,2)'="AF"  D  ;
  1.  . S CS=$QS(NODE,3)
  1.  . S CODE=$QS(NODE,4)
  1.  . S R6247=$QS(NODE,5)
  1.  . S R624701=$QS(NODE,6)
  1.  . I 'QUE D PROGRESS^LA7VLCM1(.LADOT)
  1.  . Q:$$CODSETOK^LA7VLCM3("","",CODE,CS,0)
  1.  . S ^TMP(TMPNM,$J,R6247,CODE,CS,R624701)=""
  1.  D HDR^LA7VLCM1(.DFL,TITLE)
  1.  S NODE="^TMP(TMPNM,$J)"
  1.  S CONCLAST=0
  1.  F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,1)'=TMPNM  Q:$QS(NODE,2)'=$J  D  Q:EXIT  ;
  1.  . I CONCLAST'=0 W !
  1.  . S R6247=$QS(NODE,3)
  1.  . S CODE=$QS(NODE,4)
  1.  . S CS=$QS(NODE,5)
  1.  . S R624701=$QS(NODE,6)
  1.  . S CONCLAST=R6247
  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.  . D SUB^LA7VLCM1(.DFL,R6247,,R624701)
  1.  I CONCLAST=0 W !!,"   No exceptions found."
  1.  ;
  1.  K ^TMP(TMPNM,$J)
  1.  D CLEAN^LA7VLCM1
  1.  Q