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

AMQQATAL.m

Go to the documentation of this file. 
  1. AMQQATAL ; IHS/CMI/THL - SETS TEMP METADICTIONARY ENTRY FOR LAB TESTS ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;-----
  1.  ; All hard sets in this routine are for temporary purposes only
  1. SETLAB ; ENTRY POINT
  1.  N X,%,Y,A
  1.  S %=$G(^AMQQ(5,+AMQQATN,4))
  1.  Q:%=""
  1.  S AMQQLTYP=$P(%,U)
  1.  S AMQQLDFN=$P(%,U,2)
  1.  S AMQQLSIT=$P(%,U,3)
  1.  S AMQQLHED=$P(%,U,4)
  1.  S AMQQLHDL=$P(%,U,5)
  1.  S AMQQLUNT=$P(%,U,6)
  1.  S AMQQLOUT=$P(%,U,7)
  1.  S AMQQLINK=AMQQATN
  1.  S AMQQNOL=""
  1.  S:'AMQQLSIT AMQQLSIT=+$O(^LAB(61,"B","UNKNOWN",0))
  1.  D OK
  1.  I $D(AMQQNOL) W:'$D(AMQQXX) !,"No results for this test are in the database.  Don't bother asking.",!,*7 G EXIT
  1.  D MSG
  1.  I $D(AMQQNOL) Q
  1.  S AMQQLINK=AMQQLINK+($J/100000)
  1.  S %=AMQQLTYP
  1.  S AMQQLNNA=$S(%=9:1,%=12:2,%=11:3,%=15:4,%=6:6,1:"")
  1.  S %="^2^9000010.09^.04^9^^1^1^^AUPNVLAB^^3.7^AC^^^^"
  1.  S $P(%,U,1)="PATIENT;"_AMQQATNM
  1.  S $P(%,U,5)=AMQQLTYP
  1.  S $P(%,U,9)=AMQQATNM
  1.  S $P(%,U,11)=AMQQLDFN
  1.  S $P(%,U,15)=AMQQLDFN
  1.  S ^AMQQ(1,AMQQLINK,0)=%
  1.  S %=^AMQQ(1,9,1)
  1.  S %=$P(%,"XXX")_AMQQLDFN_$P(%,"XXX",2)
  1.  S ^AMQQ(1,AMQQLINK,1)=%
  1.  S ^AMQQ(1,AMQQLINK,1.1)=^AMQQ(1,9,1.1)
  1.  D STG
  1.  S %=^AMQQ(1,9,1.2)
  1.  S %=$P(%,"XXX")_X_$P(%,"XXX",2)
  1.  S %=$P(%,"YYY")_AMQQLNNA_$P(%,"YYY",2)
  1.  S ^AMQQ(1,AMQQLINK,1.2)=%
  1.  S %=^AMQQ(1,9,2)
  1.  S %=$P(%,"XXX")_X_$P(%,"XXX",2)
  1.  S %=$P(%,"YYY")_AMQQLNNA_$P(%,"YYY",2)
  1.  S ^AMQQ(1,AMQQLINK,2)=%
  1.  S ^AMQQ(1,AMQQLINK,4,0)="^9009071,01^2^2"
  1.  S ^AMQQ(1,AMQQLINK,4,1,0)=AMQQLHED_U_9000010.09_U_.04_U_AMQQLHED_U_AMQQLHDL_U_AMQQLHDL_U_AMQQLUNT I AMQQLOUT'="" S ^(1)=AMQQLOUT
  1.  S ^AMQQ(1,AMQQLINK,4,2,0)=AMQQLHED_" DATE"_U_9000010_U_.01_U_AMQQLHED_" DATE"_U_12_U_12,^(1)="S Y=X X ^DD(""DD"") S X=Y"
  1.  S ^AMQQ(1,AMQQLINK,9)=AMQQATNM_" RESULTS^RESULTS^EXPANDED LAB REPORT"
  1. EXIT K AMQQLDFN,AMQQLTYP,AMQQLSIT,AMQQLHED,AMQQLHDL,AMQQLUNT,AMQQLOUT,AMQQLUNT,AMQQLNNA,I,J,X,Y,Z,%,B,N,A
  1.  Q
  1.  ;
  1. EN1 ; ENTRY POINT FROM AMQQSQA0
  1.  N AMQQLINK,AMQQ,AMQQATNM S AMQQATN=+Y,AMQQATNM=$P(Y,U,2) N X,Y,%
  1.  D SETLAB
  1.  Q
  1.  ;
  1. OKATTRIB(AMQQATN) ;EP;
  1.  S %=^AMQQ(5,AMQQATN,4)
  1.  S AMQQLTYP=$P(%,U)
  1.  S AMQQLDFN=$P(%,U,2)
  1.  S AMQQLSIT=$P(%,U,3)
  1.  S AMQQLHED=$P(%,U,4)
  1.  S AMQQLHDL=$P(%,U,5)
  1.  S AMQQLUNT=$P(%,U,6)
  1.  S AMQQLOUT=$P(%,U,7)
  1.  S AMQQLINK=AMQQATN
  1.  S AMQQNOL=""
  1.  S:'AMQQLSIT AMQQLSIT=+$O(^LAB(61,"B","UNKNOWN",0))
  1.  S AMQQNOL=""
  1.  D:AMQQLDFN OK
  1.  I '$D(AMQQNOL)
  1.  Q
  1. OK N AMQQLX,AMQQLI,X,Y,%
  1.  I $D(^AUPNVLAB("B",AMQQLDFN)) K AMQQNOL S AMQQLENO=AMQQLDFN_"."_AMQQLSIT
  1.  I $G(AMQQLSIT)=44 S AMQQLDFN(AMQQLENO)="" Q
  1.  I AMQQLSIT'=72 D  Q
  1.  .F %=0:0 S %=$O(^AMQQ(5,"LC",AMQQLINK\1,%)) Q:'%  I $D(^AUPNVLAB("B",%)) K AMQQNOL S AMQQLDFN(%,".",AMQQLSIT)="",AMQQLDFN(AMQQLDFN_"."_AMQQLSIT)=""
  1.  S AMQQLX=AMQQLDFN_U
  1.  F %=0:0 S %=$O(^AMQQ(5,"LC",AMQQLINK,%)) Q:'%  S AMQQLX=AMQQLX_%_U
  1.  F AMQQLI=1:1 S X=$P(AMQQLX,U,AMQQLI) Q:'X  I $D(^AUPNVLAB("B",X)) K AMQQNOL D
  1.  .F Y=72,70,73 I $D(^LAB(60,X,1,Y)) S AMQQLDFN(X_"."_Y)=""
  1.  Q
  1. MSG I $D(AMQQXX) Q
  1.  W !
  1.  I $D(AMQQLCOF) D SEL Q
  1.  I $D(AMQQLDFN)<9 S X=AMQQLDFN D LINE Q
  1.  S %=$O(AMQQLDFN(0))
  1.  I % S %=$O(AMQQLDFN(%)) I % W !,"The following tests will be included in the query =>",!
  1.  E  Q
  1.  S AMQQLI=0
  1.  F  S AMQQLI=$O(AMQQLDFN(AMQQLI)) Q:'AMQQLI  S X=AMQQLI D LINE
  1.  K AMQQLI
  1.  Q
  1.  ;
  1. LINE W !,?2
  1.  I $D(AMQQLCOF) W J,") "
  1.  I AMQQLSIT=72 S %=+$P(X,".",2) S %=$S(%=7:"BLOOD ",%=70:"BLOOD ",%=72:"SERUM ",%=73:"PLASMA ",1:"") W %
  1.  W $P(^LAB(60,X\1,0),U)
  1.  S Y=AMQQLSIT
  1.  I %'="" S Y=+$P(X,".",2)
  1.  S %=$G(^LAB(60,X\1,1,Y,0))
  1.  I %'="" W:$P(%,U,2) "   ",$P(%,U,2)," - ",$P(%,U,3)," ",$P(%,U,7) I $P(%,U,4)*$P(%,U,5) W "  [critical: <",$P(%,U,4)," and >",$P(%,U,5),"]"
  1.  Q
  1.  ;
  1. SEL ;
  1.  I $D(AMQQLDFN)=0 G SELEXIT
  1.  I $D(AMQQLDFN)=1 S X=AMQQLDFN_"."_AMQQLSIT D LINE G SELEXIT
  1.  S (N,J)=0
  1.  S I=0
  1.  F  S I=$O(AMQQLDFN(I)) Q:'I  S N=N+1
  1.  I N=1 S X=$O(AMQQLFDN(0)),X=AMQQLDFN(X) D LINE G SELEXIT
  1.  S X=0
  1.  F  S X=$O(AMQQLDFN(X)) Q:'X  S J=J+1,AMQQLCOF(X)=J D LINE
  1. SELR R !!,?2,"Your choice: ",X:DTIME E  S X=U
  1.  I X?1."?" W !,"Enter a number from 1 to ",N," or string numbers together with commas; e.g. 1,",N G SELR
  1.  I "^"[$E(X) S AMQQNOL="" W !!,"ATTRIBUTE CANCELLED...",!!,*7 G SELEXIT
  1.  S Z=U
  1.  F I=1:1 S Y=$P(X,",",I) Q:Y=""  S:(('Y)!(Y>N)) Y="" W:Y'?1N "  ??",*7 G:Y'?1N SELR S Z=Z_Y_U
  1.  S I=0
  1.  F  S I=$O(AMQQLDFN(I)) Q:'I  S N=+$G(AMQQLCOF(I)) I Z'[(U_N_U) K AMQQLDFN(I)
  1. SELEXIT K AMQQLCOF
  1.  Q
  1.  ;
  1. STG ;
  1.  I $D(AMQQLDFN)=1 S X=AMQQLDFN D STG1 Q
  1.  S X=""
  1.  S %=$O(AMQQLDFN(0))
  1.  Q:'%  D  S:X'="" X=X_":" S X=X_A
  1.  .S Y=(%\1)-.0000001,A="",%=Y+1
  1.  .S Z=Y F  S Z=$O(AMQQLDFN(Z)) Q:'Z  Q:Z>(Y+1)  D
  1.  ..S B=Z
  1.  ..I B=(B\1) S B=B_".00"
  1.  ..I A="" S A=B Q
  1.  ..S A=A_"."_+$P(B,".",2)
  1.  Q
  1. STG1 ;
  1.  N %,N S N=0
  1.  F %=70:1:79 I $D(^LAB(60,AMQQLDFN,1,%)) D
  1.  .I ((%=70)!(%=73)),$D(^LAB(60,AMQQLDFN,1,72)) Q
  1.  .S N=N+1
  1.  .I N=2 S %=99
  1.  I N=2 S X=X_"."_AMQQLSIT
  1.  Q
  1.  ;