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

AMQQATA.m

Go to the documentation of this file. 
  1. AMQQATA ;IHS/CMI/THL - GETS ATTRIBUTE ;
  1.  ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1.  ;-----
  1. EN ; - ENTRY POINT -
  1. ATTRIB I '$D(AMQQCNAM) S AMQQQUIT="" Q
  1.  I $D(AMQQRSAF) G AUTO
  1.  K ^UTILITY("AMQQ REFUSAL",$J)
  1.  K AMQQNATF,AMQQLCOF,AMQQCHRT
  1.  W !
  1.  W:$D(AMQQKONG) "[OR#",AMQQKGNO,"] "
  1.  W "Attribute of ",AMQQCNAM,": "
  1.  R X:DTIME E  S AMQQQUIT="" Q
  1. CKX I $E(X)=U S AMQQQUIT="" Q
  1.  I $E(X)="\" S X=$E(X,2,999),AMQQLCOF=""
  1.  I X="",'$D(AMQQGTX),AMQQUATN=1,'$D(AMQQKONG),'$D(AMQQRAND) G ATTRIB
  1.  I X="",'$D(AMQQGTX),AMQQUATN=1,$D(AMQQRAND),'$D(^UTILITY("AMQQ",$J,"Q")) S AMQQUATN=2,^UTILITY("AMQQ",$J,"WEIGHT",1,1)="",^UTILITY("AMQQ",$J,"Q",1)="3^NAME^F^^^^^'=^;;;EXISTS^^0.00^W ?6,""NAME""^^1^'=;;;;EXISTS;;" Q:AMQQCCLS="P"
  1.  I $T,AMQQCCLS="V" S ^UTILITY("AMQQ",$J,"Q",1)="133^DATE OF VISIT^D^^^^^^^^^^^^0;999999999;" Q
  1.  I X="" Q
  1.  I X?3."?",AMQQCCLS="P" D ITEM^AMQQHELP G ATTRIB
  1.  I X="??"!(X?3."?"&(AMQQCCLS="V")) S X="AF^"_$S(AMQQCCLS="H":16,AMQQCCLS="V":17,1:11) D RUN^AMQQHELP W:AMQQCCLS'="H"&(AMQQCCLS'="V") !,"Type ""???"" to see a complete list of attributes",!! G ATTRIB
  1.  I X?1."?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQATTRIBUTE","")) D EN1^XQH G ATTRIB
  1. AUTO ; ENTRY POINT FROM AMQQQ
  1.  I $D(AMQQRSAF) K AMQQRSAF S X="`"_$S(AMQQCCLS="P":109,1:220)
  1.  I $E(X)="[" S AMQQCHRT=X,X="COHORT",AMQQ("BP COHORT FLG")=""
  1.  S %=$E(X,1,3)
  1.  I %="DPT"!(%="DTP")!(%="DTa")!(%="OPV")!(%="IPV")!(%="MMR") S AMQQIMMS=X,X=% G ADIC
  1.  S %=$E(X,1,2)
  1.  I %="DT"!(%="TD")!(%="TT")!(%="Td")!(%="MR") S AMQQIMMS=X,X=%
  1. ADIC S DIC="^AMQQ(5,"
  1.  S DIC(0)="ES"
  1.  ;PATCH XXX
  1.  ;S DIC("S")="I '$P($G(^(4)),U,8),$P(^(0),U,2)=AMQQCCLS,+Y<466!(+Y>499) D:+Y>1000 OKATTRIB^AMQQATAL(+Y) K AMQQLDFN"
  1.  S DIC("S")="I '$P($G(^(4)),U,8),$P(^(0),U,2)=AMQQCCLS D:+Y>1000 OKATTRIB^AMQQATAL(+Y) K AMQQLDFN"
  1.  S D="C"
  1.  I X="COHORT"!($D(AMQQNECO)) S DIC(0)=""
  1.  D IX^DIC
  1.  K DIC
  1.  I Y=-1,"^"[$E(X) S:$E(X)=U AMQQQUIT="" Q
  1.  I $D(AMQQXX) Q
  1. EN1 ; ENTRY POINT FROM AMQQQ2
  1. SECURITY I +Y'=-1 D ^AMQQSEC
  1.  I Y=-1 W "  ??",*7 G ATTRIB
  1.  D IMM
  1.  I $D(AMQQSGFL) K AMQQSGFL
  1.  E  K AMQQMULT
  1.  I Y="TAX" S X="" Q
  1.  I $P($G(^AMQQ(5,+Y,0)),U,4)=5 D MSR ;IHS/CIM/THL PATH 19 ALIGN MEASUREMENT IENS
  1.  I +Y=265,$D(AMQQKONG) W !!,"Sorry, a double KONGLOMERATOR is a no-no!  Try another attribute.",!!,*7 S Y=-1 G ATTRIB
  1.  I +Y=368,$P($G(^AMQQ(8,DUZ(2),0)),U,2)="" W !,"Sorry, your site manager has not identified any secondary facilities...",*7,! G ATTRIB
  1.  I +Y=315 S AMQQVPF="" D ^AMQQSQP Q
  1.  I +Y=227 D GENERIC Q:$D(AMQQQUIT)  W !! G ATTRIB
  1.  I $P(^AMQQ(5,+Y,0),U,4)=99 W !,"Enter the specific name of the ",$P($P(Y,U,2),",")," or type '???' to see choices",!! G ATTRIB
  1. EN2 ; 
  1.  I $D(^AMQQ(5,+Y,2)) S AMQQATN=+Y,Z=0,X=^(2,1,0) D SCR1^AMQQ1 S X="",AMQQSCPF="" Q
  1.  S %=^AMQQ(5,+Y,0)
  1.  S AMQQATNM=$P(Y,U,2)
  1.  S AMQQLINK=$P(%,U,5)
  1.  S AMQQATN=+Y
  1.  S AMQQSBCT=$P(%,U,20)
  1.  I $P(^AMQQ(1,AMQQLINK,0),U,10)="AUPNVXAM"!($P(^(0),U,10)="AUPNVNTS") S %=$P(^(0),U,11) I %,'$D(^AUPNVXAM("B",%))&'$D(^AUPNVNTS("B",%)) S AMQQNOL="" W:'$D(AMQQXX) !,"No results for this exam are in the database.  Don't bother asking.",! G ATTRIB
  1.  I $P($G(^AMQQ(5,+Y,0)),U,4)=22 D EXAM
  1.  I AMQQLINK=9 D ^AMQQATAL I $D(AMQQNOL) K AMQQNOL S Y=-1 G ATTRIB
  1.  I $D(AMQQNATF) G SETAT
  1.  I $G(AMQQSBCT)="" S AMQQSBCT=$P(^AMQQ(1,AMQQLINK,0),U,5)
  1.  I $D(AMQQKONG),$P(^AMQQ(1,AMQQLINK,0),U,7) D NOKONG G ATTRIB
  1.  S Z=$P(^AMQQ(1,AMQQLINK,0),U,5)
  1.  S Z=$P(^AMQQ(4,Z,0),U)
  1.  I Z="C" D COHORT^AMQQAT1 Q:$D(AMQQQUIT)  G:'$D(AMQQCHRT) ATTRIB G SETAT
  1.  I Z="R" D ^AMQQAT1 G:'($D(AMQQRAND)+$D(AMQQQUIT)) ATTRIB Q
  1.  I Z="L"!(Z="G") S AMQQTNAR=$P(%,U,15),AMQQTDIC=U_$P(%,U,16),AMQQTLOK=U_$P(%,U,18),AMQQTTX="" S:$D(^AMQQ(5,+Y,3)) AMQQTTX=^(3) D ^AMQQTX Q:$D(AMQQQUIT)  I '$D(AMQQTAX) G ATTRIB
  1. SETAT S %=^AMQQ(1,AMQQLINK,0)
  1.  S AMQQCTXS=$P(%,U,7)
  1.  S AMQQVCL=$P(%,U,6)
  1.  S AMQQFTYP=$P(^AMQQ(4,$P(%,U,5),0),U)
  1.  S AMQQCCHK=""
  1.  I $D(^AMQQ(1,AMQQLINK,6)) S AMQQCCHK=^(6)
  1.  Q
  1.  ;
  1. NOKONG W *7
  1.  N %A,%B
  1.  S XQH=$O(^DIC(9.2,"B","AMQQKONG",""))
  1.  D EN1^XQH
  1.  Q
  1.  ;
  1. GENERIC I $D(^UTILITY("AMQQ",$J,"SQ",0)) W !!,"Sorry...you have already defined the generic visit conditions.",!,"They cannot be changed after they are entered.",!,"Type '^' at the next prompt if you want to start over.",!!,*7 Q
  1.  N AMQQUSQN,AMQQUATN,AMQQILIN,AMQQMULX,AMQQQ
  1.  S AMQQUSQN=-1
  1.  S AMQQUATN=99
  1.  S AMQQILIN=99
  1.  S AMQQGVF=""
  1.  S Y="226^VISIT"
  1.  D EN2
  1.  I $D(AMQQQUIT) G GEXIT
  1.  D CTXS^AMQQAT,EXIT^AMQQAT
  1.  I $D(AMQQQUIT) G GEXIT
  1.  I $D(AMQQXSQF) K AMQQXSQF D LIST^AMQQ
  1.  D ^AMQQATL
  1.  D ^AMQQATS
  1. GEXIT K AMQQGVF
  1.  Q
  1.  ;
  1. NATL ; NATURAL LANGUAGE CHECKER
  1.  D ^AMQQN2
  1.  W $C(13),?79,$C(13),"Attribute of ",AMQQCNAM,": ",X
  1.  I $G(AMQQCTXS)+$D(AMQQFAIL) Q
  1.  S AMQQNATF=AMQQNCND_";"_AMQQNVAL,Y=AMQQNATT
  1.  Q
  1.  ;
  1. IMM ;IF LOOKUP OF IMMUNIZATION CHECK IMMUNIZATION VERSION AND CONVERT TO
  1.  ;NEW IMMUNIZATION TERMS IS USING NEW IMMUNIZATION VERSION
  1.  ;PATCH XXX
  1.  Q:"^269^270^271^272^273^274^275^276^277^278^279^280^281^282^283^284^285^286^403^404^424^425^426^427^460^462^463^464^465^"'[(U_+Y_U)
  1.  Q:'$D(^AUTTIMM(101,0))
  1.  I +Y=269 S $P(Y,U)=466 Q
  1.  I +Y=271 S $P(Y,U)=488 Q
  1.  ;I +Y=272 S $P(Y,U)=467 Q
  1.  I +Y=273 S $P(Y,U)=468 Q
  1.  I +Y=274 S $P(Y,U)=469 Q
  1.  I +Y=275 S $P(Y,U)=489 Q
  1.  I +Y=276 S $P(Y,U)=470 Q
  1.  ;I +Y=277 S $P(Y,U)=471 Q
  1.  I +Y=278 S $P(Y,U)=490 Q
  1.  I +Y=279 S $P(Y,U)=472 Q
  1.  ;I +Y=280 S $P(Y,U)=473 Q
  1.  I +Y=281 S $P(Y,U)=491 Q
  1.  ;I +Y=282 S $P(Y,U)=474 Q
  1.  ;I +Y=283 S $P(Y,U)=475 Q
  1.  ;I +Y=284 S $P(Y,U)=476 Q
  1.  ;I +Y=285 S $P(Y,U)=477 Q
  1.  ;I +Y=286 S $P(Y,U)=478 Q
  1.  ;I +Y=403 S $P(Y,U)=479 Q
  1.  ;I +Y=404 S $P(Y,U)=480 Q
  1.  ;I +Y=424 S $P(Y,U)=481 Q
  1.  ;I +Y=425 S $P(Y,U)=482 Q
  1.  ;I +Y=426 S $P(Y,U)=483 Q
  1.  I +Y=427 S $P(Y,U)=492 Q
  1.  ;I +Y=460 S $P(Y,U)=484 Q
  1.  I +Y=462 S $P(Y,U)=485 Q
  1.  ;I +Y=463 S $P(Y,U)=486 Q
  1.  I +Y=464 S $P(Y,U)=488 Q
  1.  Q
  1. MSR ;ALIGN MEASUREMENT TYPE IEN'S
  1.  N X,XX,YY,ZZ
  1.  S XX=$P(Y,U,2)
  1.  S Z=$O(^AUTTMSR("B",XX,0))
  1.  Q:'Z
  1.  S ZZ=$P(^AUTTMSR(Z,0),U,3)
  1.  S $P(^AMQQ(5,+Y,0),U,12)="MSR;"_ZZ
  1.  S XX=$P(^AMQQ(5,+Y,0),U,5)
  1.  S $P(^AMQQ(1,XX,0),U,11)=Z
  1.  S X=^AMQQ(1,XX,1)
  1.  S X=$P(X,"AUPNVMSR;")_"AUPNVMSR;"_Z_";"_$P($P(X,"AUPNVMSR;",2),";",2,999)
  1.  S ^AMQQ(1,XX,1)=X
  1.  S X=^AMQQ(1,XX,2)
  1.  S X=$P(X,"AUPNVMSR;")_"AUPNVMSR;"_Z_";"_$P($P(X,"AUPNVMSR;",2),";",2,999)
  1.  S ^AMQQ(1,XX,2)=X
  1.  Q
  1. EXAM ;ALIGN EXAM TYPE IEN'S
  1.  I AMQQLINK=441 S AMQQVXAM="ALL" Q
  1.  N X,XX,YY,ZZ
  1.  S XX=$P(Y,U,2)
  1.  S Z=$O(^AUTTEXAM("B",XX,0))
  1.  I 'Z D
  1.  .S Z=$P($P($G(^AMQQ(5,+Y,0)),U,12),";",2)
  1.  .Q:'Z
  1.  .S Z=$O(^AUTTEXAM("C",Z,0))
  1.  Q:'Z
  1.  S XX=$P(^AMQQ(5,+Y,0),U,5)
  1.  S $P(^AMQQ(1,XX,0),U,11)=Z
  1.  S $P(^AMQQ(1,XX,0),U,15)=Z
  1.  S X=^AMQQ(1,XX,1)
  1.  S X=$P(X,"AUPNVXAM;")_"AUPNVXAM;"_Z_";"_$P($P(X,"AUPNVXAM;",2),";",2,999)
  1.  S ^AMQQ(1,XX,1)=X
  1.  S X=^AMQQ(1,XX,2)
  1.  S X=$P(X,"AUPNVXAM;")_"AUPNVXAM;"_Z_";"_$P($P(X,"AUPNVXAM;",2),";",2,999)
  1.  S ^AMQQ(1,XX,2)=X
  1.  N X,Y
  1.  K DIR
  1.  S DIR(0)="SO^"_$P(^DD(9000010.13,.04,0),U,3)_"ALL:All Results"
  1.  S DIR("A")="Which results"
  1.  S DIR("B")="ALL"
  1.  D ^DIR
  1.  K DIR
  1.  S AMQQVXAM=$S(Y'[U:Y,1:"ALL")
  1.  Q