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