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

AMQQMGR9.m

Go to the documentation of this file. 
  1. AMQQMGR9 ;IHS/CMI/THL - AMQQMGR CONTINUED ;
  1.  ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1.  ;-----
  1. EN ;EP;TO ADD LABS TO THE QMAN DICTIONARY OF TERM
  1.  D EN1
  1. EXIT K AMQQ,AMQQQUIT
  1.  K ^TMP("AMQQ",$J)
  1.  Q
  1. EN1 S AMQQLDFN=0
  1.  F  S AMQQLDFN=$O(^LAB(60,AMQQLDFN)) Q:'AMQQLDFN  D
  1.  .D LCHK
  1.  .S AMQQLSDA=0
  1.  .F  S AMQQLSDA=$O(^LAB(60,AMQQLDFN,1,AMQQLSDA)) Q:'AMQQLSDA  D
  1.  ..D LSCHK
  1.  Q
  1. LCHK ;CHECK TO SEE IF LAB ALREADY IN METADICTIONARY
  1.  ;ADD IF NOT
  1.  S AMQQLIEN=AMQQLDFN+1000
  1.  Q:$D(^AMQQ(5,AMQQLIEN,0))
  1.  S X=AMQQLDFN
  1.  S DINUM=AMQQLIEN
  1.  S DIC="^AMQQ(5,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")=""
  1.  D FILE^DICN
  1.  K DIC,DA,DR,DINUM
  1.  D LTYPE
  1.  W !,"LAB TEST: ",AMQQLIEN
  1.  Q
  1. LSCHK ;CHECK TO SEE IF LAB TEST SITE/SPECIMEN ALREADY IN METADICTIONARY
  1.  ;ADD IF NOT
  1.  S AMQQLSEN=AMQQLDFN+1000+(AMQQLSDA/100)
  1.  Q:$D(^AMQQ(5,AMQQLSEN,0))
  1.  S X=AMQQLDFN
  1.  S DINUM=AMQQLSEN
  1.  S DIC="^AMQQ(5,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")=""
  1.  D FILE^DICN
  1.  K DIC,DA,DR,DINUM
  1.  D LTYPE
  1.  W !,"SITE/SPECIMEN: ",AMQQLSEN
  1.  Q
  1. LTYPE I $O(^LAB(60,AMQQLDFN,200,0)) S AMQQLTYP="" Q
  1.  S %=$P(^LAB(60,AMQQLDFN,0),U,12)
  1.  I %="" G TF
  1.  S %=U_%_"0)"
  1.  I '$D(@%) G TF
  1.  I $P(@%,U,3)[";Trace:" S AMQQLTYP=12 Q
  1.  I ($P(@%,U,5,6)["Q9=")+($G(^(3))[" NUMBER ") S AMQQLTYP=9 Q
  1.  I $P(@%,U,5,6)[" NUMBER " S AMQQLTYP=9 Q
  1.  I $P(@%,U,3)[";Pos.:" S AMQQLTYP=11 Q
  1.  I $G(AMQQLSTG)["TITRE"!($P(@%,U,5)["""""titre""""")!($G(^(3))["1:") S AMQQLTYP=15 Q
  1.  I $P(@%,U,2)="S" S AMQQLTYP=6 Q
  1. TF S AMQQLTYP=2
  1.  Q
  1. IMM ;EP;TO ADD NEW IMMUNIZATIONS TO QMAN DICTIONARIES OF LINKS AND TERMS
  1.  N XX,X,Y,Z
  1.  S J=849
  1.  S XX=0
  1.  F  S XX=$O(^AUTTIMM(XX)) Q:'XX  D:'$D(^AMQQ(1,"IMM",XX))
  1.  .F DA=850:1 Q:DA>999!'$D(^AMQQ(1,DA,0))
  1.  .Q:DA>999!'DA
  1.  .S X=$G(^AUTTIMM(XX,0))
  1.  .Q:X=""
  1.  .S J=J+1
  1.  .S NAME=$P(X,U)
  1.  .S SNAME=$P(X,U,2)
  1.  .S CODE=$P(X,U,3)
  1.  .M ^AMQQ(1,DA)=^AMQQ(1,472)
  1.  .M ^AMQQ(5,DA)=^AMQQ(5,472)
  1.  .S $P(^AMQQ(5,DA,0),U)=NAME
  1.  .S $P(^AMQQ(5,DA,0),U,5)=DA
  1.  .S $P(^AMQQ(5,DA,0),U,12)="IMM;"_CODE
  1.  .K ^AMQQ(5,DA,1)
  1.  .S ^AMQQ(5,DA,1,0)="^9009075.01^2^2"
  1.  .S ^AMQQ(5,DA,1,1,0)=NAME
  1.  .S ^AMQQ(5,DA,1,2,0)=SNAME
  1.  .S ^AMQQ(5,DA,1,"B",NAME,1)=""
  1.  .S ^AMQQ(5,DA,1,"B",SNAME,2)=""
  1.  .S $P(^AMQQ(1,DA,0),U,11)=XX
  1.  .S $P(^AMQQ(1,DA,0),U,15)=XX
  1.  .S $P(^AMQQ(1,DA,0),U)="PATIENT;"_NAME
  1.  .S $P(^AMQQ(1,DA,1),";",2)=XX
  1.  .S $P(^AMQQ(1,DA,2),";",2)=XX
  1.  .S DIK="^AMQQ(1,"
  1.  .D IX1^DIK
  1.  .S DIK="^AMQQ(5,"
  1.  .D IX1^DIK
  1.  Q
  1. MSR ;EP;TO ADD NEW MEASUREMENTS TO QMAN DICTIONARIES OF LINKS AND TERMS
  1.  ;PATCH XXX
  1.  K ^TMP($J,"AMQQ MSR")
  1.  S XX=0
  1.  F  S XX=$O(^AMQQ(1,"MSR",XX)) Q:'XX  I $P($G(^AUTTMSR(XX,0)),U)]"" S ^TMP($J,"AMQQ MSR",$P(^(0),U))=""
  1.  N XX,X,Y,Z
  1.  S XX=0
  1.  F  S XX=$O(^AUTTMSR(XX)) Q:'XX  D:'$D(^AMQQ(1,"MSR",XX))
  1.  .F DA=1:1 Q:DA>999!('$D(^AMQQ(1,DA,0))&'$D(^AMQQ(5,DA,0)))
  1.  .Q:DA>999!'DA
  1.  .S X=$G(^AUTTMSR(XX,0))
  1.  .Q:X=""
  1.  .S SNAME=$P(X,U)
  1.  .S NAME=$P(X,U,2)
  1.  .S CODE=$P(X,U,3)
  1.  .Q:$D(^TMP($J,"AMQQ MSR",SNAME))
  1.  .S ^TMP($J,"AMQQ MSR",SNAME)=""
  1.  .W:'$D(ZTQUEUED) !,DA,?10,XX,?20,NAME,?50,SNAME,?60,CODE
  1.  .M ^AMQQ(1,DA)=^AMQQ(1,751)
  1.  .M ^AMQQ(5,DA)=^AMQQ(5,751)
  1.  .S $P(^AMQQ(5,DA,0),U)=NAME
  1.  .S $P(^AMQQ(5,DA,0),U,5)=DA
  1.  .S $P(^AMQQ(5,DA,0),U,12)="MSR;"_CODE
  1.  .K ^AMQQ(5,DA,1)
  1.  .S ^AMQQ(5,DA,1,0)="^9009075.01^2^2"
  1.  .S ^AMQQ(5,DA,1,1,0)=NAME
  1.  .S ^AMQQ(5,DA,1,2,0)=SNAME
  1.  .S ^AMQQ(5,DA,1,"B",NAME,1)=""
  1.  .S ^AMQQ(5,DA,1,"B",SNAME,2)=""
  1.  .S $P(^AMQQ(1,DA,0),U,9)=CODE
  1.  .S $P(^AMQQ(1,DA,0),U,11)=XX
  1.  .S $P(^AMQQ(1,DA,0),U,15)=XX
  1.  .S $P(^AMQQ(1,DA,0),U)="PATIENT;"_NAME
  1.  .S $P(^AMQQ(1,DA,1),";",2)=XX
  1.  .S $P(^AMQQ(1,DA,2),";",2)=XX
  1.  .S X=^AMQQ(1,DA,1)
  1.  .S X=$P(X,"$D(^(AMQP(0),")_"$D(^(AMQP(0),"_XX_")) S AMQQX="_$P(X,")) S AMQQX=",2)
  1.  .K ^AMQQ(1,DA,4,"B")
  1.  .S $P(^AMQQ(1,DA,4,1,0),U)=SNAME
  1.  .S $P(^AMQQ(1,DA,4,1,0),U,4)=$E(NAME,1,7)
  1.  .S $P(^AMQQ(1,DA,4,2,0),U)="DATE OF "_SNAME
  1.  .S $P(^AMQQ(1,DA,4,2,0),U,4)="DATE OF "_SNAME
  1.  .S DIK="^AMQQ(1,"
  1.  .D IX1^DIK
  1.  .S DIK="^AMQQ(5,"
  1.  .D IX1^DIK
  1.  K ^TMP($J,"AMQQ MSR")
  1.  Q
  1. EXAM ;EP;TO ADD NEW EXAMS TO QMAN DICTIONARIES OF LINKS AND TERMS
  1.  ;PATCH XXX
  1.  K ^TMP($J,"AMQQ EXAM")
  1.  S XX=0
  1.  F  S XX=$O(^AMQQ(1,"EXAM",XX)) Q:'XX  I $P($G(^AUTTEXAM(XX,0)),U,2)]"" S ^TMP($J,"AMQQ EXAM",$P(^(0),U,2))=""
  1.  N XX,X,Y,Z
  1.  S XX=0
  1.  F  S XX=$O(^AUTTEXAM(XX)) Q:'XX  D:'$D(^AMQQ(1,"XAM",XX))
  1.  .F DA=1:1 Q:DA>999!('$D(^AMQQ(1,DA,0))&'$D(^AMQQ(5,DA,0)))
  1.  .Q:DA>999!'DA
  1.  .S X=$G(^AUTTEXAM(XX,0))
  1.  .Q:X=""
  1.  .S NAME=$P(X,U)
  1.  .S CODE=$P(X,U,2)
  1.  .Q:$D(^TMP($J,"AMQQ EXAM",CODE))
  1.  .S ^TMP($J,"AMQQ EXAM",CODE)=""
  1.  .M ^AMQQ(1,DA)=^AMQQ(1,751)
  1.  .M ^AMQQ(5,DA)=^AMQQ(5,751)
  1.  .S $P(^AMQQ(5,DA,0),U)=NAME
  1.  .S $P(^AMQQ(5,DA,0),U,5)=DA
  1.  .S $P(^AMQQ(5,DA,0),U,12)="EXAM;"_CODE
  1.  .K ^AMQQ(5,DA,1)
  1.  .S ^AMQQ(5,DA,1,0)="^9009075.01^2^2"
  1.  .S ^AMQQ(5,DA,1,1,0)=NAME
  1.  .S ^AMQQ(5,DA,1,"B",NAME,1)=""
  1.  .S $P(^AMQQ(1,DA,0),U,9)=CODE
  1.  .S $P(^AMQQ(1,DA,0),U,11)=XX
  1.  .S $P(^AMQQ(1,DA,0),U,15)=XX
  1.  .S $P(^AMQQ(1,DA,0),U)="PATIENT;"_NAME
  1.  .S $P(^AMQQ(1,DA,1),";",2)=XX
  1.  .S $P(^AMQQ(1,DA,2),";",2)=XX
  1.  .K ^AMQQ(1,DA,4,"B")
  1.  .S $P(^AMQQ(1,DA,4,1,0),U)=SNAME
  1.  .S $P(^AMQQ(1,DA,4,1,0),U,4)=$E(NAME,1,7)
  1.  .S $P(^AMQQ(1,DA,4,2,0),U)="DATE OF "_SNAME
  1.  .S $P(^AMQQ(1,DA,4,2,0),U,4)="DATE OF "_SNAME
  1.  .S DIK="^AMQQ(1,"
  1.  .D IX1^DIK
  1.  .S DIK="^AMQQ(5,"
  1.  .D IX1^DIK
  1.  K ^TMP($J,"AMQQ EXAM")
  1.  Q
  1. IEN ;EP;TO RESET EXAM AND MEASUREMENT IEN'S ; PATCH XXX
  1.  F DA=1:1 Q:DA>999  S X=$G(^AMQQ(1,DA,1)) D:X["AUPNVMSR"!(X["AUPNVXAM")
  1.  .S XX=$P(X,";",2)
  1.  .S X=$P(X,"$D(^(AMQP(0),")_"$D(^(AMQP(0),"_XX_")) S AMQQX="_$P(X,")) S AMQQX=",2)
  1.  .S ^AMQQ(1,DA,1)=X
  1.  Q