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

AMQQMGR8.m

Go to the documentation of this file. 
  1. AMQQMGR8 ; IHS/CMI/THL - MORE OVERFLOW FROM AMQQMGR6 ;
  1.  ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
  1.  ;-----
  1. SYN ;EP;
  1.  W !,"Print the UPDATED list of QMAN lab test names and synonyms now."
  1.  W !,"(If synonyms exist, they will be indented below the primary lab test name.)"
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Print QMAN lab tests now"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  Q:Y'=1
  1. SYN1 ;EP;
  1.  K ^TMP("AMQQ LAB TEST",$J)
  1.  D ^%ZIS
  1.  I POP S AMQQSTOP=1 Q
  1.  U IO D PRINT
  1.  D ^%ZISC
  1.  K ^TMP("AMQQ LAB TEST",$J),AMQQSTOP
  1.  Q
  1.  ; 
  1. PRINT ;
  1.  N AMQQLIEN,AMQQDA,X,Y,Z,%,AMQQTOT,AMQQSTOP
  1.  S AMQQTOT=0
  1.  S AMQQDA=999
  1.  F  S AMQQDA=$O(^AMQQ(5,AMQQDA)) Q:'AMQQDA  D
  1.  .I $P($G(^AMQQ(5,AMQQDA,4)),U,8) Q
  1.  .S AMQQLIEN=(AMQQDA\1)-1000
  1.  .S X=$P($G(^LAB(60,AMQQLIEN,0)),U)
  1.  .Q:X=""
  1.  .S ^TMP("AMQQ LAB TEST",$J,X)=""
  1.  .S Z=""
  1.  .F  S Z=$O(^AMQQ(5,AMQQDA,1,"B",Z)) Q:Z=""  D
  1.  ..S ^TMP("AMQQ LAB TEST",$J,X,Z)=""
  1.  Q:'$D(^TMP("AMQQ LAB TEST",$J))
  1.  N XX
  1.  S XX=""
  1.  F  S XX=$O(^TMP("AMQQ LAB TEST",$J,XX)) Q:XX=""!$G(AMQQSTOP)  D
  1.  .S Z="     "_XX
  1.  .D INC(Z)
  1.  .S Z=""
  1.  .F  S Z=$O(^TMP("AMQQ LAB TEST",$J,XX,Z)) Q:Z=""  D:Z'=XX
  1.  ..D INC("         "_Z)
  1.  Q
  1.  ;
  1. INC(XX) ;
  1.  N %
  1.  S AMQQTOT=AMQQTOT+1
  1.  W !
  1.  I $E($G(IOST),1,2)="C-",'(AMQQTOT#20) W "<>" R %:$G(DTIME,300) W $C(13),?79,$C(13) I %=U S AMQQSTOP=1 Q
  1.  W XX
  1.  Q
  1.  ; 
  1. PCO ; PRINT COMPANION TESTS
  1.  W !!,"Print the current list of companion lab tests now...."
  1.  W !,"Companion tests are indented below the primary test"
  1.  D ^%ZIS
  1.  I POP S AMQQSTOP=1 Q
  1.  U IO
  1.  D CPRINT
  1.  W !!!
  1.  D ^%ZISC
  1.  Q
  1.  ; 
  1. CPRINT ;
  1.  N AMQQLAB,AMQQCO,X,AMQQTOT
  1.  S AMQQTOT=0
  1.  S AMQQLAB=0
  1.  F  S AMQQLAB=$O(^AMQQ(5,"LC",AMQQLAB)) Q:'AMQQLAB  D
  1.  .S XX=""
  1.  .D INC(X)
  1.  .S XX=$P($G(^AMQQ(5,AMQQLAB,0)),U)
  1.  .D INC(XX)
  1.  .S AMQQCO=0
  1.  .F  S AMQQCO=$O(^AMQQ(5,"LC",AMQQLAB,AMQQCO)) Q:'AMQQCO  D
  1.  ..S XX="   "_$P($G(^LAB(60,AMQQCO,0)),U)
  1.  ..D INC(XX)
  1.  Q
  1.  ;
  1. GETAKA ;EP;
  1.  N X,Y,DIC,DA,%,AMQQSTG,AMQQLINE,AMQQLAB,AMQQI,AMQQDA
  1.  W !,"Updating lab test synonym list..."
  1.  S DIC("P")=$P(^DD(60,2,0),U,2)
  1.  F AMQQLINE=1:1 S AMQQSTG=$$GET^AMQQMGRX(AMQQLINE) Q:AMQQSTG["***"  Q:AMQQSTG=""  D
  1.  .K AMQQLAB,AMQQSYN
  1.  .S AMQQSTG=$P(AMQQSTG,"; ",2)
  1.  .S AMQQLAB=$P(AMQQSTG,U)
  1.  .S X=AMQQLAB
  1.  .S DIC="^LAB(60,"
  1.  .S DIC(0)=""
  1.  .D ^DIC
  1.  .Q:Y=-1
  1.  .S AMQQDA=+Y
  1.  .F AMQQI=2:1:$L(AMQQSTG,U) S X=$P(AMQQSTG,U,AMQQI) D
  1.  ..S DA(1)=AMQQDA,DIC="^LAB(60,"_DA(1)_",5,",DIC(0)="L"
  1.  ..Q:$D(^LAB(60,DA(1),5,"B",X))
  1.  ..D ^DIC
  1.  ..I $P(Y,U,3) W "."
  1.  Q