5:11 PM  17-MAY-00
QMAN v2.0 routines through patch 16
AMQ1I001
AMQ1I001 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 Q:'DIFQ(9009078)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(9009078,0,"GL")
 ;;=^AMQQ(8,
 ;;^DIC("B","QMAN SITE PARAMETERS",9009078)
 ;;=
 ;;^DIC(9009078,"%",0)
 ;;=^1.005^1^1
 ;;^DIC(9009078,"%",1,0)
 ;;=AMQ
 ;;^DIC(9009078,"%","B","AMQ",1)
 ;;=
 ;;^DIC(9009078,"%D",0)
 ;;=^^6^6^2930408^^^^
 ;;^DIC(9009078,"%D",1,0)
 ;;=THIS FILE CONTAINS INFROMATION REQUIRED FOR LOCAL CONFIGURATION OF Q-MAN.
 ;;^DIC(9009078,"%D",2,0)
 ;;=WHEN A NEW VERSION OF Q-MAN IS INSTALLED, THE DD DEFINITION MAY BE 
 ;;^DIC(9009078,"%D",3,0)
 ;;=UPGRADED BUT NO DATA WILL BE LOST.
 ;;^DIC(9009078,"%D",4,0)
 ;;= 
 ;;^DIC(9009078,"%D",5,0)
 ;;=SPECIFICALLY, THIS FILE CONTAINS THE Q-MAN USAGE LOG, NEIGHBORING HEALTH
 ;;^DIC(9009078,"%D",6,0)
 ;;=CARE SITES, SECURE DEVICE LIST.
 ;;^DD(9009078,0)
 ;;=FIELD^^40^13
 ;;^DD(9009078,0,"DDA")
 ;;=N
 ;;^DD(9009078,0,"DT")
 ;;=2930821
 ;;^DD(9009078,0,"IX","B",9009078,.01)
 ;;=
 ;;^DD(9009078,0,"NM","QMAN SITE PARAMETERS")
 ;;=
 ;;^DD(9009078,.01,0)
 ;;=PRIMARY FACILITY^RP9999999.06'X^AUTTLOC(^0;1^S:$D(X) DINUM=X Q
 ;;^DD(9009078,.01,1,0)
 ;;=^.1
 ;;^DD(9009078,.01,1,1,0)
 ;;=9009078^B
 ;;^DD(9009078,.01,1,1,1)
 ;;=S ^AMQQ(8,"B",$E(X,1,30),DA)=""
 ;;^DD(9009078,.01,1,1,2)
 ;;=K ^AMQQ(8,"B",$E(X,1,30),DA)
 ;;^DD(9009078,.01,3)
 ;;=
 ;;^DD(9009078,.01,"DT")
 ;;=2910302
 ;;^DD(9009078,.02,0)
 ;;=FACILITY 2^P9999999.06'^AUTTLOC(^0;2^Q
 ;;^DD(9009078,.02,"DT")
 ;;=2910301
 ;;^DD(9009078,.03,0)
 ;;=FACILITY 3^P9999999.06'^AUTTLOC(^0;3^Q
 ;;^DD(9009078,.03,"DT")
 ;;=2910301
 ;;^DD(9009078,.04,0)
 ;;=FACILITY 4^P9999999.06'^AUTTLOC(^0;4^Q
 ;;^DD(9009078,.04,"DT")
 ;;=2910301
 ;;^DD(9009078,.06,0)
 ;;=FILE 200 CONVERSION COMPLETED^S^1:YES;0:NO;^0;6^Q
 ;;^DD(9009078,.06,"DT")
 ;;=2930821
 ;;^DD(9009078,.07,0)
 ;;=LOG STATUS^S^1:ACTIVE;0:INACTIVE;^0;7^Q
 ;;^DD(9009078,.07,"DT")
 ;;=2910420
 ;;^DD(9009078,.09,0)
 ;;=SECURE DEVICE TYPE^S^A:ALL DEVICES;P:PRINTERS ONLY;^0;9^Q
 ;;^DD(9009078,.09,"DT")
 ;;=2910301
 ;;^DD(9009078,.1,0)
 ;;=SECURE DEVICE PLAN^S^I:INCLUSIONARY;E:EXCLUSIONARY;^0;10^Q
 ;;^DD(9009078,.1,"DT")
 ;;=2910301
 ;;^DD(9009078,.11,0)
 ;;=DEVICE^9009078.01P^^1;0
 ;;^DD(9009078,1,0)
 ;;=SECURE DEVICES^9009078.01P^^1;0
 ;;^DD(9009078,20,0)
 ;;=LABEL PRINTING DEVICE^9009078.02P^^2;0
 ;;^DD(9009078,30,0)
 ;;=CURRENT AGE BUCKETS^F^^3;E1,244^K:$L(X)>240!($L(X)<1) X
 ;;^DD(9009078,30,3)
 ;;=Answer must be 1-240 characters in length.
 ;;^DD(9009078,30,"DT")
 ;;=2910320
 ;;^DD(9009078,40,0)
 ;;=QUERY LOG^9009078.04D^^4;0
 ;;^DD(9009078,40,"DT")
 ;;=2910423
 ;;^DD(9009078.01,0)
 ;;=DEVICE SUB-FIELD^^.01^1
 ;;^DD(9009078.01,0,"DT")
 ;;=2910301
 ;;^DD(9009078.01,0,"IX","B",9009078.01,.01)
 ;;=
 ;;^DD(9009078.01,0,"NM","DEVICE")
 ;;=
 ;;^DD(9009078.01,0,"NM","SECURE DEVICE")
 ;;=
 ;;^DD(9009078.01,0,"NM","SECURE DEVICES")
 ;;=
 ;;^DD(9009078.01,0,"UP")
 ;;=9009078
 ;;^DD(9009078.01,.01,0)
 ;;=DEVICE^MP3.5'^%ZIS(1,^0;1^Q
 ;;^DD(9009078.01,.01,1,0)
 ;;=^.1
 ;;^DD(9009078.01,.01,1,1,0)
 ;;=9009078.01^B
 ;;^DD(9009078.01,.01,1,1,1)
 ;;=S ^AMQQ(8,DA(1),1,"B",$E(X,1,30),DA)=""
 ;;^DD(9009078.01,.01,1,1,2)
 ;;=K ^AMQQ(8,DA(1),1,"B",$E(X,1,30),DA)
 ;;^DD(9009078.01,.01,"DT")
 ;;=2910301
 ;;^DD(9009078.02,0)
 ;;=LABEL PRINTING DEVICE SUB-FIELD^^.05^5
 ;;^DD(9009078.02,0,"IX","B",9009078.02,.01)
 ;;=
 ;;^DD(9009078.02,0,"NM","LABEL PRINTING DEVICE")
 ;;=
 ;;^DD(9009078.02,0,"UP")
 ;;=9009078
 ;;^DD(9009078.02,.01,0)
 ;;=LABEL PRINTING DEVICE^P3.5'^%ZIS(1,^0;1^Q
 ;;^DD(9009078.02,.01,1,0)
 ;;=^.1
 ;;^DD(9009078.02,.01,1,1,0)
 ;;=9009078.02^B
 ;;^DD(9009078.02,.01,1,1,1)
 ;;=S ^AMQQ(8,DA(1),2,"B",$E(X,1,30),DA)=""
 ;;^DD(9009078.02,.01,1,1,2)
 ;;=K ^AMQQ(8,DA(1),2,"B",$E(X,1,30),DA)

AMQ1I002
AMQ1I002 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 Q:'DIFQ(9009078)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(9009078.02,.01,4)
 ;;=
 ;;^DD(9009078.02,.01,22)
 ;;=AMQQLABEL
 ;;^DD(9009078.02,.01,"DT")
 ;;=2910316
 ;;^DD(9009078.02,.02,0)
 ;;=HORIZONTAL OFFSET^NJ2,0^^0;2^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X
 ;;^DD(9009078.02,.02,3)
 ;;=Type a Number between 1 and 99, 0 Decimal Digits
 ;;^DD(9009078.02,.02,4)
 ;;=S X="AMQQRML" X ^%ZOSF("TEST") I  D HELP^AMQQRML
 ;;^DD(9009078.02,.02,22)
 ;;=
 ;;^DD(9009078.02,.02,"DT")
 ;;=2910316
 ;;^DD(9009078.02,.03,0)
 ;;=COLUMN WIDTH^NJ2,0^^0;3^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X
 ;;^DD(9009078.02,.03,3)
 ;;=Type a Number between 1 and 99, 0 Decimal Digits
 ;;^DD(9009078.02,.03,4)
 ;;=S X="AMQQRML" X ^%ZOSF("TEST") I  D HELP^AMQQRML
 ;;^DD(9009078.02,.03,22)
 ;;=
 ;;^DD(9009078.02,.03,"DT")
 ;;=2910316
 ;;^DD(9009078.02,.04,0)
 ;;=ROW HEIGHT^NJ2,0^^0;4^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X
 ;;^DD(9009078.02,.04,3)
 ;;=Type a Number between 1 and 99, 0 Decimal Digits
 ;;^DD(9009078.02,.04,4)
 ;;=S X="AMQQRML" X ^%ZOSF("TEST") I  D HELP^AMQQRML
 ;;^DD(9009078.02,.04,22)
 ;;=
 ;;^DD(9009078.02,.04,"DT")
 ;;=2910316
 ;;^DD(9009078.02,.05,0)
 ;;=NUMBER OF LABELS PER ROW^NJ2,0^^0;5^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X
 ;;^DD(9009078.02,.05,3)
 ;;=Type a Number between 1 and 99, 0 Decimal Digits
 ;;^DD(9009078.02,.05,4)
 ;;=S X="AMQQRML" X ^%ZOSF("TEST") I  D HELP^AMQQRML
 ;;^DD(9009078.02,.05,22)
 ;;=
 ;;^DD(9009078.02,.05,"DT")
 ;;=2910316
 ;;^DD(9009078.04,0)
 ;;=QUERY LOG SUB-FIELD^^.08^8
 ;;^DD(9009078.04,0,"DT")
 ;;=2910423
 ;;^DD(9009078.04,0,"IX","B",9009078.04,.01)
 ;;=
 ;;^DD(9009078.04,0,"NM","LOG")
 ;;=
 ;;^DD(9009078.04,0,"NM","QUERY LOG")
 ;;=
 ;;^DD(9009078.04,0,"UP")
 ;;=9009078
 ;;^DD(9009078.04,.01,0)
 ;;=QUERY TIMESTAMP^D^^0;1^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X
 ;;^DD(9009078.04,.01,1,0)
 ;;=^.1
 ;;^DD(9009078.04,.01,1,1,0)
 ;;=9009078.04^B
 ;;^DD(9009078.04,.01,1,1,1)
 ;;=S ^AMQQ(8,DA(1),4,"B",$E(X,1,30),DA)=""
 ;;^DD(9009078.04,.01,1,1,2)
 ;;=K ^AMQQ(8,DA(1),4,"B",$E(X,1,30),DA)
 ;;^DD(9009078.04,.01,1,1,"DT")
 ;;=2910422
 ;;^DD(9009078.04,.01,"DT")
 ;;=2910423
 ;;^DD(9009078.04,.02,0)
 ;;=USER^P3'^DIC(3,^0;2^Q
 ;;^DD(9009078.04,.02,"DT")
 ;;=2910421
 ;;^DD(9009078.04,.03,0)
 ;;=SECURITY LEVEL^S^C:CLINICAL ACCESS;D:DEMOGRAPHIC ACCESS;^0;3^Q
 ;;^DD(9009078.04,.03,"DT")
 ;;=2910421
 ;;^DD(9009078.04,.04,0)
 ;;=OUTPUT DEVICE^P3.5'^%ZIS(1,^0;4^Q
 ;;^DD(9009078.04,.04,"DT")
 ;;=2910423
 ;;^DD(9009078.04,.05,0)
 ;;=SESSION DURATION (SECONDS)^NJ7,0^^0;5^K:+X'=X!(X>9999999)!(X<0)!(X?.E1"."1N.N) X
 ;;^DD(9009078.04,.05,3)
 ;;=Type a Number between 0 and 9999999, 0 Decimal Digits
 ;;^DD(9009078.04,.05,"DT")
 ;;=2910423
 ;;^DD(9009078.04,.06,0)
 ;;=PRINTABLE SESSION DURATION^F^^0;6^K:$L(X)>10!($L(X)<1) X
 ;;^DD(9009078.04,.06,3)
 ;;=Answer must be 1-10 characters in length.
 ;;^DD(9009078.04,.06,"DT")
 ;;=2910423
 ;;^DD(9009078.04,.07,0)
 ;;=SUBJECT AND ATTRIBUTES^F^^0;7^K:$L(X)>190!($L(X)<1) X
 ;;^DD(9009078.04,.07,3)
 ;;=Answer must be 1-190 characters in length.
 ;;^DD(9009078.04,.07,"DT")
 ;;=2910423
 ;;^DD(9009078.04,.08,0)
 ;;=ATTRIBUTES^F^^0;8^K:$L(X)>190!($L(X)<1) X
 ;;^DD(9009078.04,.08,3)
 ;;=Answer must be 1-190 characters in length.
 ;;^DD(9009078.04,.08,"DT")
 ;;=2910421

AMQ1I003
AMQ1I003 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 Q:'DIFQ(9009078.1)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(9009078.1,0,"GL")
 ;;=^AMQQ(8.1,
 ;;^DIC("B","QMAN FILE 200 CONVERSION",9009078.1)
 ;;=
 ;;^DD(9009078.1,0)
 ;;=FIELD^^1^2
 ;;^DD(9009078.1,0,"DT")
 ;;=2930821
 ;;^DD(9009078.1,0,"IX","B",9009078.1,.01)
 ;;=
 ;;^DD(9009078.1,0,"NM","QMAN FILE 200 CONVERSION")
 ;;=
 ;;^DD(9009078.1,.01,0)
 ;;=GLOBAL REF^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
 ;;^DD(9009078.1,.01,1,0)
 ;;=^.1
 ;;^DD(9009078.1,.01,1,1,0)
 ;;=9009078.1^B
 ;;^DD(9009078.1,.01,1,1,1)
 ;;=S ^AMQQ(8.1,"B",$E(X,1,30),DA)=""
 ;;^DD(9009078.1,.01,1,1,2)
 ;;=K ^AMQQ(8.1,"B",$E(X,1,30),DA)
 ;;^DD(9009078.1,.01,3)
 ;;=NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION
 ;;^DD(9009078.1,1,0)
 ;;=METADICTIONARY PROTOCODE^F^^1;E1,245^K:$L(X)>245!($L(X)<1) X
 ;;^DD(9009078.1,1,3)
 ;;=Answer must be 1-245 characters in length.
 ;;^DD(9009078.1,1,"DT")
 ;;=2930821

AMQ1I004
AMQ1I004 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"DIPT",1761,0)
 ;;=AMQQ LOG^2910423.1306^^9009078^^^^
 ;;^UTILITY(U,$J,"DIPT",1761,"F",2)
 ;;=40,.01;C1;L20~40,.02;C22;L16~40,.06;"DURATION";C39;L10~40,.07;C50;W28~
 ;;^UTILITY(U,$J,"DIPT",1761,"H")
 ;;=QMAN LOG
 ;;^UTILITY(U,$J,"SBF",9009078,9009078)
 ;;=
 ;;^UTILITY(U,$J,"SBF",9009078,9009078.01)
 ;;=
 ;;^UTILITY(U,$J,"SBF",9009078,9009078.02)
 ;;=
 ;;^UTILITY(U,$J,"SBF",9009078,9009078.04)
 ;;=
 ;;^UTILITY(U,$J,"SBF",9009078.1,9009078.1)
 ;;=

AMQ1INI1
AMQ1INI1 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 ; LOADS AND INDEXES DD'S
 ;
 K DIF,DIK,D,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DFR,DTN,DIX,DZ D DT^DICRW S %=1,U="^",DSEC=1
 S NO=$P("I 0^I $D(@X)#2,X[U",U,%) I %<1 K DIFQ Q
ASK I %=1,$D(DIFQ(0)) W !,"SHALL I WRITE OVER FILE SECURITY CODES" S %=2 D YN^DICN S DSEC=%=1 I %<1 K DIFQ Q
 F X="DIP" D W Q:'$D(DIFQ)
 Q:'$D(DIFQ)  S %=2 W !!,"ARE YOU SURE EVERYTHING'S OK" D YN^DICN I %-1 K DIFQ Q
 I $D(DIFKEP) F DIDIU=0:0 S DIDIU=$N(DIFKEP(DIDIU)) Q:DIDIU'>0  S DIU=DIDIU,DIU(0)=DIFKEP(DIDIU) D EN^DIU2
 D DT^DICRW K ^UTILITY(U,$J),^UTILITY("DIK",$J) D WAIT^DICD
 S DN="^AMQ1I" F R=1001:1:1004 D ROU W "."
 F  S D=$O(^UTILITY(U,$J,"SBF","")) Q:D'>0  K:'DIFQ(D) ^(D) S D=$O(^(D,"")) I D>0  K ^(D) D IX
DATA W "." S (D,DDF(1),DDT(0))=$N(^UTILITY(U,$J,0)) Q:D'>0
 I DIFQR(D) S DTO=0,DMRG=1,DTO(0)=^(D),Z=^(D)_"0)",D0=^(D,0),@Z=D0,DFR(1)="^UTILITY(U,$J,DDF(1),D0,",DKP=DIFQR(D)'=2 F D0=0:0 S D0=$N(^UTILITY(U,$J,DDF(1),D0)) Q:'$D(^(D0,0))  S Z=^(0) D I^DITR
 K ^UTILITY(U,$J,DDF(1)),DDF,DDT,DTO,DFR,DFN,DTN G DATA
 ;
W S Y=$P($T(@X),";",2) W !,"NOTE: This package also contains "_Y_"S",! Q:'$D(DIFQ(0))
 S %=1 W ?6,"SHALL I WRITE OVER EXISTING "_Y_"S OF THE SAME NAME" D YN^DICN I '% W !?6,"Answer YES to replace the current "_Y_"S with the incoming ones." G W
 S:%=2 DIFQ(X)=0 K:%<0 DIFQ
 Q
 ;
OPT ;OPTION
RTN ;ROUTINE DOCUMENTATION NOTE
FUN ;FUNCTION
BUL ;BULLETIN
KEY ;SECURITY KEY
HEL ;HELP FRAME
DIP ;PRINT TEMPLATE
DIE ;INPUT TEMPLATE
DIB ;SORT TEMPLATE
DIS ;SCREEN TEMPLATE
 ;
SBF ;FILE AND SUB FILE NUMBERS
IX W "." S DIK="A" F %=0:0 S DIK=$N(^DD(D,DIK)) Q:DIK<0  K ^(DIK)
 S DA(1)=D,DIK="^DD("_D_"," D IXALL^DIK
 I $D(^DIC(D,"%",0)) S DIK="^DIC(D,""%""," G IXALL^DIK
 Q
ROU I R<2000 D @(DN_$E(R,2,4)) Q
 I R=2000 S R=2028
 S %C=R#52+65,%B=R-2028\52+65 S:%B>90 %B=%B+6 S:%C>90 %C=%C+6
 D @(DN_$C(48,%B,%C))
 Q
MSG ;
 I $P(^XMB(3.9,XMZ,0),U,7)'="X" Q
 S X=$S($D(^XMB(3.9,XMZ,2,XCN,0)):^(0),1:"") Q:X=""
M0 D M1 Q:$P(X,"$END MESSAGE")=""  D SAVE,NT G M0
NT S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:XCN'?1.N  S X=^(XCN,0) Q
SAVE D NT Q:$E(X)="$"  S Y=X D NT Q:$E(X)="$"
 I $A(X)=126 S A0=X D NT S X=A0_$E(X,2,999) K A0
 S:% @Y=$E(X,2,999) G SAVE
 Q
M1 S Y=$E(X,2,4),%=0 I Y="DDD" S D=+$P(X,"(#",2),%=DIFQ(D) Q:D  S:$P(X,"(#",2)["FILE SECURITY" %=DSEC Q
 Q:Y="END"
 I Y="DTA" S %=DIFQR(D) Q
 I (Y="OR ")!(Y="PKG") S %=1 Q
 I $T(@Y)]"" S %=1 Q
 Q

AMQ1INI2
AMQ1INI2 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 ;
 ;
 K ^UTILITY("DIFROM",$J),DIC S DIDUZ=0 S:$D(DUZ)#2 DIDUZ=DUZ S DUZ=.5
 I $D(^DIC(9.2,0))#2,^(0)?1"HEL".E S (DIC,DLAYGO)=9.2,N="HEL",DIC(0)="LX" G ADD
 Q
 ;
ADD F R=0:0 S R=$N(^UTILITY(U,$J,N,R)) Q:R<0  S X=$P(^(R,0),U,1) W "." K DA D ^DIC I Y>0,'$D(DIFQ(N))!$P(Y,U,3) S ^UTILITY("DIFROM",$J,N,X)=+Y K ^DIC(9.2,+Y,1),^(2),^(3),^(10) S %X="^UTILITY(U,$J,N,R,",%Y=DIC_"+Y,",DA=+Y D %XY^%RCR
 S DIK=DIC
HELP S R=$N(^UTILITY("DIFROM",$J,N,R)) Q:R<0  W !,"'"_R_"' Help Frame filed." S DA=^(R)
 F X=0:0 S X=$O(^DIC(9.2,DA,2,X)) Q:'X  S I=$S($D(^(X,0)):^(0),1:0),Y=$P(I,U,2) S:Y]"" Y=$N(^DIC(9.2,"B",Y,0)) S ^(0)=$P(^DIC(9.2,DA,2,X,0),U,1)_U_$S(Y>0:Y,1:"")_U_$P(^(0),U,3,99)
 S I=0 F X=0:0 S X=$O(^DIC(9.2,DA,10,X)) Q:'X  I $D(^(X,0)) S Y=$P(^(0),U),Y=$S(Y]"":$O(^MAG("B",Y,0)),1:0) S:Y $P(^DIC(9.2,DA,10,X,0),U)=Y,I=I+1,%=X I 'Y K ^DIC(9.2,DA,10,X,0)
 I I S $P(^DIC(9.2,DA,10,0),U,3,4)=%_U_I
IX D IX1^DIK G HELP
 ;
U I $D(DIRUT) S DIFQ=1
 W ! Q
REP S DIR(0)="Y",DIR("A")="Shall I change the NAME of the file to "_DIF
 S DIR("??")="^D REP^DIFROMH1",DIR("B")="NO" D ^DIR G U:$D(DIRUT)
 I Y S DIE=1,DIFQ=0,DA=N,DR=".01////"_DIF D ^DIE Q
 S DIR("A")="Shall I replace your file with mine"
 S DIR("??")="^D AG^DIFROMH1" D ^DIR G U:$D(DIRUT)!'Y
 S DIU(0)="E",DIR("A")="Do you want to keep the Data"
 S DIR("??")="^D CHG^DIFROMH1" D ^DIR G U:$D(DIRUT)
 S:'Y DIU(0)=DIU(0)_"D"
 S DIR("A")="Do you want to keep the Templates"
 S DIR("??")="^D TEMP^DIFROMH1" D ^DIR G U:$D(DIRUT) S:'Y DIU(0)=DIU(0)_"T"
 S DIFQ(N)=1,DIFKEP(N)=DIU(0) W !?15," (",DIF,") " Q

AMQ1INI3
AMQ1INI3 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 ;
 ;
 K ^UTILITY("DIFROM",$J) S DIC(0)="LX",(DIC,DLAYGO)=3.6,N="BUL" D ADD:$D(^XMB(3.6,0))
 S X=0 F R=0:0 S X=$N(^UTILITY("DIFROM",$J,N,X)) Q:X<0  W !,"'",X,"' BULLETIN FILED -- Remember to add mail groups for new bulletins."
 I $D(^DIC(9.4,0))#2,^(0)?1"PACK".E S N="PKG",(DIC,DLAYGO)=9.4 D ADD
 G NP:'$D(DA) S %=+$O(^DIC(9.4,DA,22,"B",DIFROM,0)) I $D(^DIC(9.4,DA,22,%,0)) S $P(^(0),U,3)=DT
 I $D(^DIC(9.4,DA,0))#2 S %=$P(^(0),U,4) I %]"" S %=$N(^DIC(9.2,"B",%,0)) S:%]"" $P(^DIC(9.4,DA,0),U,4)=%
OR I $D(^ORD(100.99))&$O(^UTILITY(U,$J,"OR","")) D EN^AMQ1INI4
NP K DIC,^UTILITY("DIFROM",$J) S DIC(0)="LX" I $D(^DIC(19,0))#2,^(0)?1"OPTION".E S (DIC,DLAYGO)=19,N="OPT" D ADD,OP
 I $D(^DIC(19.1,0))#2,($P(^(0),U)?1"SECUR".E)!($P(^(0),U)="KEY") S (DIC,DLAYGO)=19.1,N="KEY" D ADD K ^UTILITY("DIFROM",$J)
 I $D(^DIC(9.8,0))#2,^(0)?1"ROUTINE^".E S (DIC,DLAYGO)=9.8,N="RTN" D ADD
 S DIC=.5,DLAYGO=0,N="FUN" D ADD
 S DIC("S")="I $P(^(0),U,4)=DIFL" F N="DIPT","DIBT","DIE" S DIC=U_N_"(" D ADD
 K DIC("S") S N="DIST(.404,",DIC=U_N,DLAYGO=.404 D ADD
 S DIC("S")="I $P(^(0),U,8)=DIFL",N="DIST(.403,",DIC=U_N,DLAYGO=.403 D ADD
 K ^UTILITY(U,$J),DIC,DLAYGO F DIFR="DIE","DIPT" D DIEZ
 K ^UTILITY("DIFROM",$J) Q
DIEZ I ^DD("VERSION")>17.4,'$D(DISYS) D OS^DII
 E  S DISYS=^DD("OS")
 Q:'$D(^DD("OS",DISYS,"ZS"))
 S DIFR1=""
DZ1 S DIFR1=$O(^UTILITY("DIFROM",$J,DIFR,DIFR1)) Q:DIFR1=""
 F DIFR2=0:0 S DIFR2=$O(^UTILITY("DIFROM",$J,DIFR,DIFR1,DIFR2)) Q:'DIFR2  S Y=DIFR2 I $D(@(U_DIFR_"(Y,""ROU"")")) K ^("ROU") I $D(^("ROUOLD")) S X=^("ROUOLD"),DMAX=^DD("ROU") D:X]"" @("EN^DI"_$E(DIFR,3)_"Z")
 G DZ1
 ;
OP S R=$O(^UTILITY("DIFROM",$J,N,R)) I R="" K ^UTILITY("DIFROM",$J) G Q
 W !,"'"_R_"' Option Filed" S DA=+^UTILITY("DIFROM",$J,N,R) G:$P(^(R),U,2,3)="XUCORE^"!($P(^(R),U,2,3)="XUCOMMAND^") OP
 I $D(^DIC(19,DA,220)) S %=$P(^(220),U) S:%]"" %=$O(^XMB(3.6,"B",%,0)) S $P(^DIC(19,DA,220),U)=%,%=$P(^(220),U,3) S:%]"" %=$O(^XMB(3.8,"B",%,0)) S $P(^DIC(19,DA,220),U,3)=%
 S %=$P(^DIC(19,DA,0),U,12) S:%]"" %=$O(^DIC(9.4,"B",%,0))
 S $P(^DIC(19,DA,0),U,12)=%,%=$P(^(0),U,7),(DZ,DIX)=0
 S:%]"" %=$O(^DIC(9.2,"B",%,0)) S $P(^DIC(19,DA,0),U,7)=%,%=$P(^(0),U,4),%="MOQXL"[% K ^(10,"B"),^("C")
 F X=0:0 S X=$O(^DIC(19,DA,10,X)) Q:'X  S I=$S($D(^(X,0)):^(0),1:0),Y=$S($D(^(U)):^(U),1:"") K ^DIC(19,DA,10,X),^DIC(19,"AD",+I,DA,X) I Y]"",% S D=$O(^DIC(19,"B",Y,0)) I D S ^DIC(19,DA,10,X,0)=D_U_$P(I,U,2,9),DZ=DZ+1,DIX=X
 S:% ^DIC(19,DA,10,0)="^19.01PI^"_DIX_U_DZ D IX1^DIK G OP
 ;
ADD F R=0:0 S R=$O(^UTILITY(U,$J,N,R)) Q:R=""  S X=$P(^(R,0),U),DIFL=$S(N="DIST(.403,":$P(^(0),U,8),N="DIST(.404,":$P(^(0),U,2),1:$P(^(0),U,4)) W "." K DA D ^DIC I Y>0,'$D(DIFQ($E(N,1,3)))!$P(Y,U,3) S Y=Y_U D A
Q Q
A I N="BUL" K % S %(0)=$G(@(DIC_"+Y,2,0)")) F %=0:0 S %=$O(@(DIC_"+Y,2,%)")) Q:'%  S %(%)=$G(^(%,0))
 K:N'="KEY"&(N'="OPT") @(DIC_"+Y)") S ^UTILITY("DIFROM",$J,N,X)=Y S:$E(N,1,2)="DI" ^(X,+Y)="" S:N="PKG" DIFROM(0)=+Y Q:$P(Y,U,2,3)="XUCORE^"!($P(Y,U,2,3)="XUCOMMAND^")
 I N="BUL",%(0)]"" S @(DIC_"+Y,2,0)")=%(0) F %=0:0 S %=$O(%(%)) Q:'%  S @(DIC_"+Y,2,%,0)")=%(%)
 I $E(N,1,2)="DI",('DIFL)!('$D(^DD(+DIFL))) W !,"**WARNING--"_$S(N="DIE":"INPUT",N="DIPT":"PRINT",N="DIBT":"SORT",1:"FORM or BLOCK")_" template "_$P(Y,U,2)_" has been installed,",!,"but associated file "_DIFL_" not on your system!"
 I N="OPT" S:$P(^DIC(19,+Y,0),U,6)]"" DIOPT=$P(^(0),U,6) I $O(^UTILITY(U,$J,N,R,1,0)) K ^DIC(19,+Y,1)
 I N="DIST(.403," D BLK
 S %X="^UTILITY(U,$J,N,R,",%Y=DIC_"+Y,",DA=+Y,DIK=DIC D %XY^%RCR
 D IX1^DIK:N'="OPT" I N="OPT",$D(DIOPT) S:$P(^DIC(19,DA,0),U,6)="" $P(^(0),U,6)=DIOPT K DIOPT
 Q
BLK F J=0:0 S J=$O(^UTILITY(U,$J,N,R,40,J)) Q:'J  I $D(^(J,0)) S %=$P(^(0),U,2) S:%]"" %=$O(^DIST(.404,"B",%,0)) S:% $P(^UTILITY(U,$J,N,R,40,J,0),U,2)=% D B1
 K A0,A1,A2,J,L Q
B1 F L=0:0 S L=$O(^UTILITY(U,$J,N,R,40,J,40,L)) Q:'L  S A0=$G(^(L,0)),%=$P(A0,U) I %]"" S %=$O(^DIST(.404,"B",%,0)) I % S $P(A0,U)=%,^UTILITY(U,$J,N,R,40,J,"BLK",%,0)=A0
 S A0=$G(^UTILITY(U,$J,N,R,40,J,40,0)) Q:A0=""  K ^UTILITY(U,$J,N,R,40,J,40) S (A1,A2)=0
 F L=0:0 S L=$O(^UTILITY(U,$J,N,R,40,J,"BLK",L)) Q:'L  S ^UTILITY(U,$J,N,R,40,J,40,L,0)=^(L,0),A1=L,A2=A2+1
 S $P(A0,U,3,4)=A1_U_A2,^UTILITY(U,$J,N,R,40,J,40,0)=A0 K ^UTILITY(U,$J,N,R,40,J,"BLK")
 Q

AMQ1INI4
AMQ1INI4 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 ;
 ;
EN S DA(1)=1,DIK="^ORD(100.99,1,5," I $D(^ORD(100.99,1,5,DA)) D ^DIK
 S %X="^UTILITY(U,$J,""OR"","_$O(^UTILITY(U,$J,"OR",""))_",",%Y=DIK_DA_","
 S:'$D(^ORD(100.99,1,5,0)) ^(0)="^100.995P^^" S $P(^(0),U,3,4)=DA_U_($P(^(0),U,4)+1)
 D %XY^%RCR S $P(^ORD(100.99,1,5,DA,0),U)=DA,%=$P(^(0),U,4)
 I %]"" S %=$N(^ORD(100.98,"B",%,0)) I %>0 S $P(^ORD(100.99,1,5,DA,0),U,4)=%
 D OR
 S DA(1)=1 D IX1^DIK
 Q
OR S (N,I)=0,X=""
 F  S N=$O(^ORD(100.99,1,5,DA,1,N)) Q:'N  S X=$P(^(N,0),U) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% ^ORD(100.99,1,5,DA,1,N,0)=% S X=N,I=I+1,(R,J)=0,Y="" D OR1
 S:I $P(^ORD(100.99,1,5,DA,1,0),U,3,4)=X_U_I S (N,I)=0,X=""
 F  S N=$O(^ORD(100.99,1,5,DA,5,N)) Q:'N  S X=$P(^(N,0),U,3) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% $P(^ORD(100.99,1,5,DA,5,N,0),U,3)=% S X=N,I=I+1
 S:I $P(^ORD(100.99,1,5,DA,5,0),U,3,4)=X_U_I K N,R,X,Y,I,J
 Q
OR1 N X F  S R=$O(^ORD(100.99,1,5,DA,1,N,1,R)) Q:'R  S X=$P(^(R,0),U) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% ^ORD(100.99,1,5,DA,1,N,1,R,0)=% S Y=R,J=J+1
 S:J $P(^ORD(100.99,1,5,DA,1,N,1,0),U,3,4)=Y_U_J
 Q
ADDP N I,J,N,R,DA,DLAYGO S %=""
 S DIC="^ORD(101,",DIC(0)="LX",DLAYGO=101 D FILE^DICN K DIC Q:Y=-1  S %=+Y Q

AMQ1INI5
AMQ1INI5 ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 K ^UTILITY("DIF",$J) S DIFRDIFI=1 F I=1:1:4 S ^UTILITY("DIF",$J,DIFRDIFI)=$T(IXF+I),DIFRDIFI=DIFRDIFI+1
 Q
IXF ;;
 ;;9009078P;QMAN SITE PARAMETERS;^AMQQ(8,;0;y;y;;;;;n
 ;;
 ;;9009078.1;QMAN FILE 200 CONVERSION;^AMQQ(8.1,;0;y;y;;;;;n
 ;;

AMQ1INIT
AMQ1INIT ; IHS/OHPRD/JCM - FILEMAN INIT ROUTINE 31-JAN-1994 ; [ 05/31/95 11:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;AMQQ;;JAN 31, 1994
 ;
 K DIF,DIFQ,DIFQR,DIFQN,DIK,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DIFROM,DFR,DTN,DIX,DZ,DIRUT,DTOUT,DUOUT
 S U="^",DIFQ=0,DIFROM="2" W !,"This version (#2) of 'AMQ1INIT' was created on 31-JAN-1994"
 W !?9,"(at TUCSON DEVELOPMENT ALTOS, by VA FileMan V.19.0)",!
 I $D(^DD("VERSION")),^("VERSION")'<19 G GO:$N(^("VERSION","19.0"))<0 W !,"BUT I'M OBSOLETE!!" G Q
 W !,"FIRST, I'LL FRESHEN UP YOUR VA FILEMAN...." D N^DINIT
 I ^DD("VERSION")<19 W !,"BUT I NEED VERSION 19 OF THE VA FILEMAN!" G Q
GO ;
EN ; ENTER HERE TO BYPASS THE PRE-INIT PROGRAM
 S DIFQ=0 K DIRUT,DTOUT,DUOUT
 F DIFRIR=1:1:1 S DIFRRTN="^AMQ1INI"_$E("5",DIFRIR) D @DIFRRTN
 W:1 !,"I AM GOING TO SET UP THE FOLLOWING FILES:" F I=1:2:4 S DIF(I)=^UTILITY("DIF",$J,I) D 1 G Q:DIFQ!$D(DIRUT) K DIF(I)
 S DIFROM="2" D PKG:'$D(DIFROM(0)),^AMQ1INI1 G Q:'$D(DIFQ) S DIK(0)="AB"
 F DIF=1:2:4 S %=^UTILITY("DIF",$J,DIF),DIK=$P(%,";",5),N=$P(%,";",3),D=$P(%,";",4)_U_N D D K DIFQ(N)
 K DIFQR D ^AMQ1INI2,^AMQ1INI3
 D ^AMQ1POST
 L  S DUZ=DIDUZ W:1 !,*7,"OK, I'M DONE.",!,"NO"_$P("TE THAT FILE",U,DSEC)_" SECURITY-CODE PROTECTION HAS BEEN MADE"
 I DIFROM F DIF=1:2:4 S %=^UTILITY("DIF",$J,DIF),N=+$P(%,";",3) I N,$P(%,";",8)="y" S ^DD(N,0,"VR")=DIFROM
 I DIFROM(0)>0 F %="PRE","INI","INIT" S:$D(DIFROM(%)) $P(^DIC(9.4,DIFROM(0),%),U,2)=DIFROM(%)
 I $G(DIFQN) S $P(^(0),U,3,4)=$P(DIFQN,U,2)_U_($P(^DIC(0),U,4)+DIFQN) K DIFQN
 S:DIFROM(0)>0 ^DIC(9.4,DIFROM(0),"VERSION")=DIFROM G Q^DIFROM0
D S:$D(^DIC(+N,0))[0 ^(0)=D S X=$D(@(DIK_"0)")),^(0)=D_U_$S(X#2:$P(^(0),U,3,9),1:U)
 S DIFQR=DIFQR(+N) I ^DD("VERSION")>17.5,$D(^DD(+N,0,"DIK"))#2 S X=^("DIK"),Y=+N,DMAX=^DD("ROU") D EN^DIKZ
 I DIFQR D IXALL^DIK:$O(@(DIK_"0)")) W "."
 Q
R G REP^AMQ1INI2
 ;
1 S N=+$P(DIF(I),";",3),DIF=$P(DIF(I),";",4),S=$P(DIF(I),";",5)
 W !!?3,N,?13,DIF,$P("  (Partial Definition)",U,$P(DIF(I),";",6)),$P("  (including data)",U,$P(DIF(I),";",13)="y") S Z=$S($D(^DIC(N,0))#2:^(0),1:"")
 I Z="" S DIFQ(N)=1,DIFQN=$G(DIFQN)+1_U_N G S
 I $L($P(Z,DIF)) W *7,!,"*BUT YOU ALREADY HAVE '",$P(Z,U),"' AS FILE #",N,"!" D R Q:DIFQ  G S:$D(DIFKEP(N)),1
 S DIFQ(N)=$P(DIF(I),";",7)'="n"
 I $L(Z) W *7,!,"Note:  You already have the '",$P(Z,U),"' File." S DIFQ(0)=1
 S %=$E(^UTILITY("DIF",$J,I+1),4,245) I %]"" X % S DIFQ(N)=$T W:'$T !,"Screen on this Data Dictionary did not pass--DD will not be installed!" G S
 I $L(Z),$P(DIF(I),";",10)="y" S DIR("A")="Shall I write over the existing Data Definition",DIR("??")="^D DD^DIFROMH1",DIR("B")="YES",DIR(0)="Y" D ^DIR S DIFQ(N)=Y
S S DIFQR(N)=0 Q:$P(DIF(I),";",13)'="y"!$D(DIRUT)
 I $P(DIF(I),";",15)="y",$O(@(S_"0)"))>0 S DIF=$P(DIF(I),";",14)="o",DIR("A")="Want my data "_$P("merged with^to overwrite",U,DIF+1)_" yours",DIR("??")="^D DTA^DIFROMH1",DIR(0)="Y" D ^DIR S DIFQR(N)=$S('Y:Y,1:Y+DIF) Q
 S %=$P(DIF(I),";",14)="o" W !,*7,"I will ",$P("MERGE^OVERWRITE",U,%+1)," your data with mine." S DIFQR(N)=%+1
 Q
Q W *7,!!,"NO UPDATING HAS OCCURRED!" G Q^DIFROM0
 ;
PKG S X=$P($T(IXF),";",3),DIC="^DIC(9.4,",DIC(0)="",DIC("S")="I $P(^(0),U,2)="""_$P(X,U,2)_"""",X=$P(X,U) D ^DIC S DIFROM(0)=+Y K DIC
 Q
 ;
IXF ;;;25
ERX W *7,!!,"This INIT was built as a Network Mail Message and can ONLY be installed",!,"within the Mail system!!" G Q

AMQ1POST
AMQ1POST ; IHS/OHPRD/JCM - AMQ1 POSTINIT ; [ 03/17/94 9:19 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;;JUN 10, 1993
 ;
 N DA,DIK,DO,D0,DIE,DR
 I $P($G(^AMQQ(5,1176,0)),U)="DIABETIC FOOT CHECK" S DIK="^AMQQ(5,",DA=1176 D ^DIK K DA,DIK
 I $P($G(^AMQQ(5,1177,0)),U)="DIABETIC FOOT EXAM, COMPLETE" S DIK="^AMQQ(5,",DA=1176 D ^DIK K DA,DIK
 S DIE="^AMQQ(5,",DA=239,DR="1///@;3///@" D ^DIE K DIE,DA,DR
 Q

AMQQ
AMQQ ; IHS/OHPRD/JCM - QUERY UTILITY ENTRY ROUTINE ; [ 10/05/95 2:12 PM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4,6,8**;OCT 5, 1993
 ; THIS IS THE 'DEVELOPMENT' ENTRY POINT FOR Q-MAN.  THE 'PRODUCTION' ENTRY POINT IS EN^AMQQ
 N AMQQADAM
 S AMQQADAM=""
START D TRAP I $D(^%ZOSF("BRK")) X ^("BRK") S:'$D(AMQQNOET) X="ERR^AMQQ",@^%ZOSF("TRAP") D VAR ; IHS/OHPRD/TMJ 10/5/95
AGAIN I $D(AMQQEN3) S AMQQEN31=AMQQEN3,AMQQEN3=-1 S AMQQOPT="SEARCH" G LOOP
 D ^AMQQOPT I $D(AMQQQUIT)!('$D(AMQQOPT)) G EXIT
LOOP F  D EXIT1^AMQQKILL,TRAP^AMQQ S:'$D(AMQQNOET) X="ERR^AMQQ",@^%ZOSF("TRAP") D @AMQQOPT I $D(AMQQQUIT)!($D(AMQQEN3))!('$D(AMQQOPT)) Q
 I $D(AMQQQUIT) K AMQQQUIT S AMQQAGIN=1 G AGAIN
EXIT ; ENTRY POINT FROM AMQQCMPL
 D EXIT1^AMQQKILL
 I $D(^%ZOSF("NBRK")) X ^("NBRK")
 I '$D(AMQQXX),'$D(AMQQYY),$D(IOF) W @IOF
 D EXIT^AMQQKILL
 Q
 ;
FAST ; ENTRY POINT FOR FAST FACTS
SEARCH ; ENTRY POINT FROM AMQQQE
 I '$D(AMQQXX) W @IOF I $G(AMQQOPT)="SEARCH" W ?20,"*****  SEARCH CRITERIA  *****",!!!
INIT S (AMQQUSQL,AMQQUATN)=1,(AMQQUNBC,AMQQUSQN,AMQQURGN,AMQQUQQN)=0,U="^" ; ALL THE AMQQU* VARIABLES ARE COUNTERS WHICH MUST EXIST IN ALL ROUTINES AT ALL LEVELS AND MUST NEVER BE NEWED
RUN I '$D(AMQQXX) D ^AMQQ1,^AMQQQ:$D(AMQQXX) K AMQQXX I $D(AMQQQUIT) K:'AMQQQUIT AMQQQUIT Q
 I $D(AMQQXX) D EN^AMQQQ Q
 I $D(AMQQEN3),$G(AMQQCCLS)'="P" W !!!,"Sorry...the subject of your search must be a patient.",!!!,*7 H 3 Q
AT D ^AMQQAT
 I $D(AMQQXSQF) K AMQQXSQF D LIST G AT
 I $D(AMQQQUIT),AMQQUATN=1,AMQQQ="" Q
 I $D(AMQQQUIT) K AMQQQUIT Q
 I '$D(AMQQNOET) S X="ERROR^AMQQ",@^%ZOSF("TRAP")
 I $D(AMQQSCPF) K AMQQSCPF G AT
 I AMQQUATN=1,AMQQQ="" Q
 I AMQQQ="" D ^AMQQCMPL K AMQQQUIT Q
 I $D(AMQQANYF) K AMQQANYF D LIST G AT
 I $D(AMQQTXMT) K AMQQTXMT G SET
 I $D(AMQQONE),'$D(AMQQMULT) D LIST G AT
 I $D(AMQQSVFL) K AMQQSVFL D LIST G AT
SET D ^AMQQATR,^AMQQATL,^AMQQATS,LIST
 S AMQQUATN=AMQQUATN+1
 I '$D(AMQQNULL) S AMQQUNBC=AMQQUNBC+1
 K AMQQNULL
 G AT
 ;
SAVE D ^AMQQQE
 Q
 ;
VIEW D VIEW^AMQQOPT1
 Q
 ;
TRAP K AMQQNOET
 I '$D(^DD("OS")) S AMQQNOET="" Q
 S %=^DD("OS"),%=$P(^DD("OS",%,0),U) I %'["MSM",%'["MICRONETICS",%'["DSM(V" S AMQQNOET="" Q
 I '$D(^%ZOSF("TRAP"))!($D(AMQQADAM)) S AMQQNOET=""
 ;I '$D(AMQQNOET)!($D(AMQQADAM)),$D(^%ZOSF("BRK")) X ^("BRK") ; IHS/OHPRD/TMJ 10/5/95
 Q
 ;
VAR S X=$T(AMQQ+1) S AMQQVER=$P(X,";",3)
 S X=$P(^AMQQ(8,DUZ(2),0),U,6) F %=3,6,16 S AMQQ200(%)=$S(X:"^VA(200)",1:("^DIC("_%_")")) ;IHS/OHPRD/JCM 1/31/94
 I '$D(AMQQXX) S IOP="0;79" D ^%ZIS
 I $D(AMQQRV),$D(AMQQNV) Q
 I '$D(AMQQXX) S X=$G(^%ZIS(2,IOST(0),5)),AMQQRV=$P(X,U,4),AMQQNV=$P(X,U,5)
 E  S AMQQRV=""
 I AMQQRV="" S (AMQQRV,AMQQNV)="AMQQXV",AMQQXV=""
 ;
LIST ; ENTRY POINT FROM AMQQAT1
 I $D(AMQQXX) Q
 W !! F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"LIST",%)) Q:'%  W ! X ^(%)
 W !!
 Q
 ;
 ; 
 ; 
ERROR I '$D(AMQQNOET) X "I $P($ZE,"">"")=""<INRPT""" I  W !!,"Session terminated...",!! H 2 S AMQQQUIT="" G EXIT
 D EMSG H 4 D AT G EXIT
 ;
EMSG W !!,"WHOOPS!!!!!!!!!!!!!",!,"Something just happened which caused me to come to a grinding halt.",!,"Try to enter the ATTRIBUTE again, but if this problem persists you must",!,"take a different approach.",!!!,*7
 Q
 ;
ERR ; The following line contains vendor specific $Z for DSM and MSM - an
 ; an exemption to SAC 6.1.2.3 has been granted for version 2 only per
 ; memo dated 5/5/93 from J. MacArthur - This needs to be changed in
 ; the next release. **BRJ/IHS ** 6/7/93
 I $P($ZE,">")="<INRPT" W !!,"Session terminated...",!! H 2 S AMQQQUIT="" G EXIT
 W !!,"ERROR DETECTED...Try again...If problem persists try a different approach",!!,*7 H 4 G LOOP:$D(AMQQOPT),EXIT
 ;
 ; 
 ; 
EN ; ENTRY POINT ; PRIMARY ENTRY POINT FOR QMAN FROM THE KERNEL MENU SYSTEM
 D ^AMQQDFN
 ;N (DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED,AMQQEN3,AMQQRV,AMQQNV)
 D START
 Q
 ;
EN1 ; PROGRAMMER ENTRY POINT ; SCRIPT INTERFACE
 D ^AMQQDFN
 I '$D(AMQQXX) S AMQQFAIL=1 Q
 I '$D(AMQQYY) S AMQQFAIL=2 Q
 S X=$S($E(AMQQXX)'="^":$P(AMQQXX,"("),1:"")
 S Y=$S($E(AMQQYY)'="^":$P(AMQQYY,"("),1:"")
 S %="DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED,AMQQXX,AMQQYY,AMQQFAIL,AMQQADAM,AMQQSURV,AMQQARRY" S:X]"" %=%_","_X S:Y]"" %=%_","_Y
 S %="N ("_%_") D INDER" X % Q
INDER ; Special Entry Point For Call From Above Execute
 S %=$E(AMQQYY,$L(AMQQYY)) I %="("!(%=",") S X=$E(AMQQYY,1,$L(AMQQYY)-1),Y=X_$S(%="(":"",1:")") K @Y
 I '$D(AMQQYY(0)) S AMQQYY(0)=""
 D EXIT1^AMQQKILL,TRAP S:'$D(AMQQNOET) X="ERR^AMQQ",@^%ZOSF("TRAP") D VAR,SEARCH,EXIT
 Q
 ;
EN2 ; PROGRAMMER ENTRY POINT FOR NATL LANGUAGE INTERFACE
 ; USED BY PHARMACY PKG AND OTHERS.  SET AUPNPAT = PT DFN
 I '$D(AUPNPAT) Q
 D ^AMQQDFN
 ;N (DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED,AUPNPAT,AMQQADAM)
 S AMQQFEN2="",AMQQOPT="FAST",AMQQSAUT="^DPT^"_AUPNPAT_U_$P(^DPT(AUPNPAT,0),U)
 D TRAP S:'$D(AMQQNOET) X="ERR^AMQQ",@^%ZOSF("TRAP") D VAR,LOOP,EXIT
 K AMQQFEN2
 Q
 ;
EN3 ; PROGRAMMER ENTRY POINT FOR SEARCH TEMPLATE SUBSTITUTION.  INPUT AMQQEN3 CONTAINS THE DIBT ENTRY NUMBER AND OUTPUT RETURNS THE TOTAL NUMBER OF ENTRIES IN THE NEW TEMPLATE
 ; IF AMQQND=0, HITS NOT DISPLAYED, AMQQND=1 DOTS WILL BE DISPLAYED FOR EACH HIT ;IHS/OHPRD/JCM 10/6/94
 I '$D(AMQQEN3) S AMQQEN3=-1 Q
 I AMQQEN3 S %=$P($G(^DIBT(AMQQEN3,0)),U,4) I %'=2,%'=9000001 K % S AMQQEN3=-1 Q
 D EN
 K AMQQND ;IHS/OHPRD/JCM 10/6/94
 Q
 ;

AMQQ1
AMQQ1 ; OHPRD/DG - AMQQ SUBROUTINE...GETS GOAL OF QUERY ; [ 07/04/99  10:32 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - added ability to choose a CMS register
GOAL I '$D(AMQQOPT) S AMQQOPT="SEARCH"
 I $D(AMQQEN31),AMQQEN31=+AMQQEN31 D SWAP Q
G1 W !,$S(AMQQOPT="FAST":"Tell me what you want: ",1:"What is the subject of your search?  LIVING PATIENTS // ") R X:DTIME E  S AMQQQUIT=1 Q
 I X["  " W "  ??",*7 G GOAL
 I $L(X," ")>4 S AMQQQSTG=X D ^AMQQN S AMQQQUIT="" K AMQQXX G EXIT
 I $G(AMQQOPT)="FAST",$E(X)'="?" S:"^"[X AMQQQUIT=1 G:"^"[X EXIT S AMQQQSTG=X D ^AMQQN S AMQQQUIT="" K AMQQXX G EXIT
 I X="",AMQQOPT="QUICK" S X=U
 I X="HELP" S X="?"
 I X="??" D LISTG^AMQQHELP G GOAL
 I $E(X)=U S AMQQQUIT=1 G EXIT
 I X?1."?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQSUBJECT","")) D EN1^XQH G GOAL
 I X="" S X="LIVING PATIENTS"
 I $E(X)'?1U W "  ??",*7 G GOAL
 D AUTO I Y'=-1 D NEW Q
 D ^AMQQ2
AUTO1 ; ENTRY POINT FOR DFN SUBJECT
 N X
 I $D(AMQQFAIL) K AMQQFAIL G GOAL
 D PERSON
 Q
 ;
EXIT K X,%,I
 Q
 ;
AUTO ; ENTRY POINT FROM AMQQQ
 S DIC(0)="E",DIC="^AMQQ(5,",DIC("S")="I $P(^(0),U,9)'=""""",D="C"
 I $D(AMQQNECO) S DIC(0)=""
 E  I $D(AMQQXX) S DIC(0)="ES"
 D IX^DIC K DIC
 Q
 ;
LISTG S DIC="^AMQQ(5,",DIC(0)="E",D="GOAL",DZ="??"
 D DQ^DICQ K DIC,DZ,D,DIX,DIY,DD,%H,%,DO,X,Y
 Q
 ;
PERSON ; ENTRY POINT FROM AMQQN1 THE NATURAL LANGUAGE ROUTINE
 S X=$P(Y,U,3),Y=$P(Y,U,4),Y=$P(Y,",",2)_" "_$P(Y,",")
 S AMQQQ="8^NAME^L^^9^1^EQUAL TO^=^"_X_"^^100^W ?6,""NAME = "","""_Y_"""^1^0^=;"_X_";"
 S ^UTILITY("AMQQ",$J,"Q",1)=AMQQQ,AMQQUATN=2,AMQQUNBC=1
 I '$D(AMQQXX) S ^UTILITY("AMQQ",$J,"LIST",2)="W ?6,""NAME = "_Y_""",""     [SER = 100]"""
 S ^UTILITY("AMQQ",$J,"WEIGHT",-99,1)="",AMQQONE=Y
 S Y="1^PATIENT" D NEW
 I $D(AMQQXX) Q
 S AMQQILIN=2
 D LIST^AMQQ
 Q
 ;
NEW ; ENTRY POINT FROM AMQQN1
 I $D(^AMQQ(5,+Y,2)) S AMQQATN=+Y,AMQQCCLS=$P(^AMQQ(5,+Y,0),U,9) D SCRIPT Q
N1 S AMQQCNAM=$P(Y,U,2),(X,AMQQCCLS)=$P(^AMQQ(5,+Y,0),U,9)
 I AMQQCNAM["RANDOM" S AMQQRSAF=""
 I $D(AMQQXX) Q
 I AMQQCNAM="REGISTER" D ^AMQQREG Q  ;IHS/CMI/LAB - register add
 S AMQQILIN=1
 S X=$S(X="P":"PATIENTS",X="H":"PROVIDER",X="V":"VISIT",1:"CLINICAL DATA")
 I $D(AMQQONE),AMQQONE'="" S X=AMQQONE
 S %="W ?3"
 S %=%_",@AMQQRV,""Subject of search: "_X_""",@AMQQNV" G SETNG
 S %=%_","""_X_""""
SETNG S ^UTILITY("AMQQ",$J,"LIST",.1)=%
 Q
 ;
SCRIPT ; ENTRY POINT FROM AMQQATA
 S Z=0
 I ^AMQQ(5,AMQQATN,2,1,0)?1U S X=^(0),Z=1 D N1
SCR1 ; ENTRY POINT FROM AMQQATA
 S AMQQI=Z F  S AMQQI=$O(^AMQQ(5,AMQQATN,2,AMQQI)) Q:'AMQQI  S AMQQQ=^(AMQQI,0) D:$P(AMQQQ,U,3)="D" SCRDT D ^AMQQATR,^AMQQATL,^AMQQATS S AMQQUATN=AMQQUATN+1,AMQQUNBC=AMQQUNBC+1
 K AMQQATN,Z,AMQQI
 D LIST^AMQQ
 Q
 ;
SCRDT N %,X,Y,Z,A,B S %=$P(AMQQQ,U,9)
 I %["NULL"!(%["ANY")!(%["ALL")!(%["EXIST") Q
 S Y=$P(%,";"),Z=$P(%,";",2)
 D SCRDT1
 I B'="" S A=A_";"_B
 S $P(AMQQQ,U,9)=A
 Q
 ;
SCRDT1 S A=Y,B=Z
 I 'Y S X=Y D ^%DT S A=Y
 I Z=""!(+Z) Q
 S X=Z D ^%DT S B=Y
 Q
 ;
SWAP S AMQQCCLS="P",AMQQCNAM="PATIENTS",AMQQUATN=2,AMQQILIN=0
 S ^UTILITY("AMQQ",$J,"LIST",.1)="W ?3,@AMQQRV,""Subject of search: PATIENTS in the COHORT"",@AMQQNV"
 S ^UTILITY("AMQQ",$J,"WEIGHT",-99,1)=""
 S %=AMQQEN31,^UTILITY("AMQQ",$J,"Q",1)="40^COHORT^C^0^238^1^^^"_%_"^^99^^^0^"_%_";;^0"
 W !!,"You will now enter criteria for conducting a search on a preexisting cohort",!,"of patients.",!!
 Q
 ;

AMQQ2
AMQQ2 ; IHS/OHPRD/JCM - QUERY NAME LOOKUP ; [ 01/31/94 9:22 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
START S AMQQTXT=X I AMQQTXT["," S AMQQNAME=AMQQTXT G RUN
 I AMQQTXT'[" " S AMQQNAME=AMQQTXT G RUN
 S (AMQQNAME,AMQQTXT)=$P(X," ",$L(X," "))_","_$P(X," ",1,$L(X," ")-1)
RUN S AMQQDIC="^DPT(" D LOOKUP S AMQQPTL=Z
 S AMQQPRL=0 ; S AMQQDIC="^DIC(16," D LOOKUP S AMQQPRL=Z
 I '(AMQQPRL+AMQQPTL) G UNK
 I '(AMQQPRL*AMQQPTL) S AMQQPTYP=$S(AMQQPRL:"PRO",1:"PT") D ONE G EXIT
 W !,"Is ",AMQQNAME," a patient" S %=1 D YN^DICN I $D(DTOUT) K DTOUT S %Y=U
 I $E(%Y)=U S AMQQQUIT="" G EXIT
 I %Y="" S %Y="Y"
 I "Yy"[$E(%Y) S AMQQPTYP="PT" D ONE G EXIT
 W !,"Well then, is ",AMQQNAME," a provider" S %=1 D YN^DICN I $D(DTOUT) S %Y=U
 I $E(%Y)=U S AMQQQUIT="" Q
 I %Y="" S %Y="Y"
 I "Yy"[$E(X) S AMQQPTYP="PRO" D ONE G EXIT
UNK I '$D(AMQQXX) W !!,*7,"I have NO idea who or what "_AMQQNAME_" is." S AMQQFAIL=""
EXIT ; 
 K AMQQDIC,AMQQNAME,AMQQPRL,AMQQPTL,AMQQPTYP,AMQQTXT,%,X1,X2,A,B,N,Z
 Q
 ;
ONE S (AMQQDIC,DIC)=$S(AMQQPTYP="PRO":($E(AMQQ200(16),1,$L(AMQQ200)-1)_","),1:"^DPT("),DIC(0)="I",X=AMQQTXT ;VA/SLC ISC/GIS 11/24/93
 I @$S(AMQQPTYP="PRO":"AMQQPRL",1:"AMQQPTL")=2 W !!,"Select one of the following "_$S(AMQQPTYP="PRO":"providers",1:"patients")_":",! S DIC(0)="IEQ"
 D ^DIC
 I Y=-1,Z'=1 S DIC(0)="E" D ^DIC K DIC G GO
 S X="`"_+Y,DIC(0)="E" W ! D ^DIC K DIC
GO I Y=-1 S AMQQFAIL="" Q
 S Y=AMQQDIC_U_Y
 Q
 ;
LOOKUP S AMQQ=AMQQDIC_"""B"")",Z=0,Y=AMQQNAME
 S A=$E(Y,1,$L(Y)-1),B=$E(Y,$L(Y)),B=$A(B),B=B-1,B=$C(B),B=B_"|||",Y=A_B
 F  S Y=$O(@AMQQ@(Y)) Q:$E(Y,1,$L(AMQQNAME))'=AMQQNAME  F N=0:0 S N=$O(@AMQQ@(Y,N)) Q:N=""  S Z=Z+1 I Z=2 G QL
QL K N,Y,AMQQ
 Q
 ;

AMQQ200
AMQQ200 ; IHS/OHPRD/JCM - SLC ISC/GIS - CONVERSION TO FILE #200 ; [ 02/22/94 6:23 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;21-AUG-93
NEW N X,Y,Z,%,DIRUT,DIROUT,DTOUT,DUOUT
 I $P(^AMQQ(8,DUZ(2),0),U,6) Q  ; CONVERSION WAS DONE PREVIOUSLY
 I '$O(^VA(200,0)) Q  ; FILE #200 NOT PRESENT
 I '$P($G(^AUTTSITE(1,0)),U,22) Q  ; PCC FILE CONVERSION NOT COMPLETE
 W !!!,*7,"Hmmm, it appears that you have not upgraded Q-Man to recognize file #200, the",!,"***  NEW PERSON FILE  ***",!!
 S DIR(0)="Y",DIR("A")="Let's do the upgrade now, OK",DIR("B")="YES" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I Y D DIE,META
EXIT ;
 Q
 ;
DIE S DIE="^AMQQ(8,",DA=DUZ(2),DR=".06///1" D ^DIE K DIE,DR,DA,DIC ; SET FLAG IN Q-MAN SITE PARAM FILE TO INDICATE FILE #200 CONVERSION
 Q
 ;
STUFF ; DEVELOPERS UTILITY TO STUFF ENTRIES INTO THE QMAN FILE 200 CONVERSION FILE
 N X,Y,Z,%,I S I=0
 S X="^AMQQ(0)" F  S X=$Q(@X) Q:X'?1"^AMQQ(".E  Q:+$P(X,"(",2)>5  D
 . S %=@X I %'["DIC(16,",%'["DIC(6,",%'["DIC(3," Q
 . S Z=$P(X,U,2),I=I+1
 . W !,X,!,%,!
 . S ^AMQQ(8.1,I,0)=Z,^AMQQ(8.1,"B",Z,I)="",^AMQQ(8.1,I,1)=%
 . Q
 S $P(^AMQQ(8.1,0),U,3,4)=(I_U_I)
 Q
 ;
META ; METADICTIONARY CONVERSION
 F X=0:0 S X=$O(^AMQQ(8.1,X)) Q:'X  S Y=U_^(X,0),Z=^(1) S @Y=Z
 Q
 ;

AMQQAC
AMQQAC ; IHS/OHPRD/JCM - GETS CONDITIONS ; [ 07/24/1999  3:32 PM ]
 ;;2;PCC QUERY UTILITY;*8,15*;OCT 1, 1995
CONDP I $D(AMQQONE) D ^AMQQAC1 S AMQQUATN=AMQQUATN+1 Q
 I AMQQATNM="ALIVE" S AMQQCOND=7,AMQQNOT="",AMQQSYMB="<",AMQQNOCO=1,AMQQCONM="BEFORE" Q
 I AMQQATNM="COHORT" S AMQQCOND=238,AMQQSYMB="=",AMQQNOCO=1,AMQQCONM="IS A MEMBER OF" Q
 I AMQQATNM="FILE ENTRY" S AMQQCOND=264,AMQQSYMB="=",AMQQNOCO=1,AMQQCONM="IS ENTERED IN" Q
COND K AMQQSVAL D GETCOND
 I $E($G(X))=U K Y Q
Y I Y=-1 D SPEC I '$D(Y) Q
 I Y=-1 W "  ??",*7 G COND
 I $D(AMQQLINK) S %=^AMQQ(1,AMQQLINK,0) I $P(%,U,5)=13,$D(AMQQNOT),+Y>106,+Y<109 S Y=-1 W "  ??",*7 G COND
EN1 ; ENTRY POINT FROM AMQQQ2
 S AMQQCOND=+Y,AMQQNOCO=$P(^AMQQ(5,+Y,0),U,8),AMQQCONM=$P(Y,U,2),AMQQSYMB=$P(^AMQQ(5,+Y,0),U,6)
 Q
 ;
GETCOND ; ENTRY POINT FORM AMQQSQA1
 I AMQQATN=368!(AMQQATN=415)!(AMQQATN=454) S X="ALL" G AUTO ; IHS/OHPRD/TMJ 10/1/95
 I $D(AMQQNATF),$P(AMQQNATF,";")'="" S Y=$P(AMQQNATF,";") Q
 S %=AMQQATN I "^59^316^317^318^"[(U_%_U) S %=$S(%=316:"AFTER",%=317:"BEFORE",1:"BETWEEN") G CONDIC
 I AMQQFTYP="S" D SET G CONDIC
 I AMQQFTYP="F",'$D(AMQQFIFL),'$D(AMQQSQTP) S AMQQDICB="ANY" ;IHS/CMI/THL - PATCH 15
 I "Q"[AMQQFTYP,$D(AMQQFIFL) S AMQQDICB="IS"
 K AMQQNOT
 W !,"Condition: " W:$D(AMQQDICB) AMQQDICB,"// " R X:DTIME E  S X=U
 I $E(X)=U S AMQQQUIT="" Q
 I X="",$D(AMQQDICB) S X=AMQQDICB
 K AMQQDICB,AMQQFIFL
 I X="" D ACA Q:X=4  I X="~~~COND"[X G GETCOND
 I X="" W !! K AMQQCOND Q
 I X="??" S X="AD^"_$O(^AMQQ(4,"B",AMQQFTYP,"")) D ^AMQQHELP G GETCOND
 I X?1."?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQCONDITION","")) D EN1^XQH G GETCOND
 I X[" ",$E(X,$L(X))?1N S AMQQSVAL=$P(X," ",$L(X," ")),X=$P(X," ",1,$L(X," ")-1)
AUTO ; ENTRY POINT FROM AMQQQ
 I X["NOT"!(X["'") D NOT
CONDIC ; ENTRY POINT FROM AMQQ1
 S DIC="^AMQQ(5,",DIC(0)="ES",DIC("S")="I $P(^(0),U,3)="_$O(^AMQQ(4,"B",AMQQFTYP,"")),D="C"
 I AMQQFTYP="S"!($D(AMQQXX)) S DIC(0)=""
 I $D(AMQQSQRD) S DIC("S")=DIC("S")_"!(Y=363)"
 D IX^DIC K DIC
 I +Y'=363 K AMQQSQRD
 Q
 ;
SPEC I X="*" S X="ALL" W "  (List all values)"
 S Z="ANY;SAVE;ALL;EXISTS;BLANK;EMPTY;NULL;@" F I=1:1 S %=$P(Z,";",I) Q:%=""  I X=$E(%,1,$L(X)) W $E(%,$L(X)+1,99) S X=% D S1 Q
 Q
 ;
S1 I $D(AMQQMULT) Q
 I I>2,$D(AMQQNOT) S I=$S(I>4:4,1:5) K AMQQNOT
 S X=$S(I>4:"NULL",I>2:"EXISTS",I=1:"ANY",1:"SAVE"),AMQQCOMP=X
 I I>2 S AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^'=^;;;"_X_"^^^^^1",AMQQEXST="" K Y Q
 I I=2 S AMQQSVFL="" D ^AMQQAC1 S AMQQUATN=AMQQUATN+1 K Y Q
ANY ; ENTRY POINT FROM AMQQAV0
 S Y=" (ANY VALUE INCLUDING 'NULL')"
 S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?6,"""_AMQQATNM_Y_""""
 S ^UTILITY("AMQQ",$J,"WEIGHT",9,AMQQUATN)=""
 S AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^=^;;;ANY^^9^W ?6,"""_AMQQATNM_"""^1^1^1"
 S ^UTILITY("AMQQ",$J,"Q",AMQQUATN)=AMQQQ,AMQQUATN=AMQQUATN+1,AMQQANYF=""
 K Y
 Q
 ;
ACA ; ENTRY POINT FROM AMQQAV0 AND THE AMQQTAX* ROUTINES
 I $D(AMQQSQTP) S X="" Q
 I '$D(AMQQATNM) S X="" Q
 I "^DX^RX^PROC^"[(U_AMQQATNM_U),'$D(AMQQONE) S X="" Q
 W !!,"Since you did not specify a condition, select one of the following =>",!
 W !,?5,"1) Whoops...Let me try again"
 W !,?5,"2) List every ",AMQQATNM
 W !,?5,"3) List any ",AMQQATNM," including 'NULL'"
 W !,?5,"4) Exit",!
ACAR R !,"YOUR CHOICE (1-4): 1// ",X:DTIME E  S X=U
 I X=U S AMQQQUIT="",X="" Q
 I X=4 S AMQQQUIT="" Q
 I X?1."?" W !!,"Enter a number from 1 to 4 or '^' to exit",!! G ACAR
 I X="" S X=1 W "  (1)"
 I X,X<4 G ACAA
 W "  ??",*7 G ACAR
ACAA S X=$P("^ALL^ANY",U,X)
 Q
 ;
SET N A,Y,Z,%,I S X=$P(^AMQQ(1,AMQQLINK,0),U,6),Y=+X,Z=$P(X,",",2),%=";"_$P(^DD(Y,Z,0),U,3)
 W !,"CHOOSE FROM: " F I=2:1 S A=$P(%,";",I) Q:A=""  W !,?7,$P(A,":"),?15,$P(A,":",2)
 S X="IS"
 Q
 ;
NOT S Y="AMQQNOT" G NOTX
DNOT S Y="AMQQDNOT"
NOTX I $E(X,1,4)="NOT " S X=$E(X,5,99),@Y="" Q
 I $E(X)="'" S X=$E(X,2,99),@Y="" Q
 S %=$L(X) I $E(X,%-3,%)=" NOT" S X=$E(X,1,%-4),@Y=""
 Q
 ;

AMQQAT
AMQQAT ; IHS/OHPRD/JCM - GETS ATTRIBUTE ; [ 05/16/94 2:06 PM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
VAR D EXIT S AMQQQ="" K AMQQMULT
 I '$D(AMQQNOET) S X="ATERR^AMQQAT",@^%ZOSF("TRAP")
RUN D GET
EXIT ; ENTRY POINT FROM MULTIPLE ROUTINES
 K AMQQLINK,AMQQATNM,AMQQFTYP,AMQQCOMP,AMQQCOND,AMQQCONM,AMQQCTXS,AMQQNOCO,AMQQSYMB,AMQQVCL,I,X,Y,Z,%,Q,AMQQSQRC,AMQQNATF,AMQQLCOF
 K AMQQATN,AMQQNAR,AMQQSBCT,AMQQSQFR,AMQQCCHK,AMQQNOT,AMQQDNOT,AMQQTAX,AMQQSNOT,AMQQDICB,AMQQPRST,AMQQNVAR,AMQQFRED
 Q
 ;
GET D ^AMQQATA I $D(AMQQQUIT) Q
 I $D(AMQQVPF) K AMQQVPF D SET Q
 I $G(AMQQCTXS) D CTXS Q
 I $D(AMQQSCPF) W !! Q
 I $D(AMQQRNDF) K AMQQRNDF W !! G GET
 I $D(AMQQTAX) D SETTAX Q
 I X="",$D(AMQQKONG) D KONGCK G GET
 I X="" Q
 I AMQQATNM="KONGLOMERATOR" S AMQQCOND=265,AMQQSYMB="=" S:'$D(AMQQKGNO) AMQQKGNO=0 S AMQQKGNO=AMQQKGNO+1,AMQQKONG="" W !!,"OK, I'll collect queries for OR GROUP #",AMQQKGNO,! G GET
CND K AMQQCOND D ^AMQQAC I $D(AMQQQUIT) Q
 I ($D(AMQQNULL)+$D(AMQQANYF)+$D(AMQQEXST)+$D(AMQQSVFL)) K AMQQEXST Q
 I $D(AMQQONE),'$D(AMQQMULT) Q
 I '$D(AMQQCOND) G CND
 K AMQQCOMP D ^AMQQAV I $D(AMQQQUIT) Q
 I '$D(AMQQCOMP) G CND
 D SET
 Q
 ;
CTXS ; ENTRY POINT FROM AMQQATG
 S AMQQSQAA=AMQQUATN,AMQQSQAN=AMQQATNM,AMQQSQSN=AMQQATN,AMQQSQST=AMQQFTYP
 D ^AMQQSQ
 I '$D(AMQQQUIT),'$D(AMQQXSQF) D SET
 Q
 ;
SET ; ENTRY POINT FROM AMQQSQA1 AND OTHERS
 I AMQQCTXS S:'$D(AMQQMULX) AMQQMULX="" S AMQQMULX=AMQQMULX_AMQQUATN_U
 S Y=0 F Z=0:0 S Z=$O(^AMQQ(1,AMQQLINK,4,Z)) Q:Z'=+Z  S Y=Y+1
 S AMQQNVAR=Y
 I $D(AMQQTAX) S %=$P($G(AMQQNATF),";",2) S:% AMQQCOMP=";;;"_% S %=$P(AMQQCOMP,";",5) I %="NULL"!(%="EXISTS") S AMQQNVAR=1
 E  I $G(AMQQSQFR)>4 S AMQQNVAR=1
 I AMQQCOMP[";NULL" S AMQQNVAR=1 ;IHS/OHPRD/GIS 5/14/94
 I $D(AMQQNOT),'$G(AMQQCTXS) S AMQQSYMB="'"_AMQQSYMB,AMQQCONM=$S(AMQQCONM="IS":"IS NOT",1:("NOT "_AMQQCONM))
 S AMQQSNOT=$D(AMQQNOT)+(2*$D(AMQQDNOT))
 S %="",X="LINK^ATNM^FTYP^CTXS^COND^NOCO^CONM^SYMB^COMP^VCL^SER^ORTX^FRED^NVAR^FILT^SNOT^TAX"
 F I=1:1:17 S Y="AMQQ"_$P(X,U,I) I $D(@Y) S $P(%,U,I)=@Y
DEBUG S AMQQQ=% ;IHS/OHPRD/JCM 1/18/94
 I $D(AMQQKONG) S ^UTILITY("AMQQ OR",$J,1,AMQQKGNO,AMQQUATN)=""
 Q
 ;
SETTAX S (AMQQSYMB,AMQQCONM)=""
 D SET
 I $D(AMQQONE),'AMQQCTXS D ^AMQQAC
 I AMQQCTXS S:'$D(AMQQMULX) AMQQMULX="" S AMQQMULX=AMQQMULX_AMQQUATN_U
 I $D(AMQQONE),'$D(AMQQPRST) S AMQQTXMT=""
 Q
 ;
ATERR I '$D(AMQQNOET) X "I $P($ZE,"">"")=""<INRPT""!($ZE[""-CTRAP"")" I  W !!,"Session terminated...",!! H 2 S AMQQQUIT="" G EXIT ;IHS/OHPRD/JCM 4/20/94 TVA SPECIFIC
 W !!,"WHOOPS!!!!!!!!!!!!!",!,"Something just happened which caused me to come to a grinding halt.",!,"Try to enter the ATTRIBUTE again, but if this problem persists you must",!,"take a different approach.",!!!,*7
 D EXIT G VAR
 ;
KONGCK S I=0 F X=0:0 S X=$O(^UTILITY("AMQQ OR",$J,1,AMQQKGNO,X)) Q:'X  I X S I=I+1 Q:I=2
 K AMQQKONG I I>1 Q
 K ^UTILITY("AMQQ OR",$J,1,AMQQKGNO)
 S AMQQKGNO=AMQQKGNO-1
 I 'I W !,"OR GROUP #",(AMQQKGNO+1)," Cancelled",*7,! Q
 W !,"Since the OR GROUP has only 1 member, I will treat it as an ordinary attribute.",*7,!
 S %=^UTILITY("AMQQ",$J,"LIST",AMQQILIN),X="[OR #"_(AMQQKGNO+1)_"] ",%=$P(%,X)_$P(%,X,2),^(AMQQILIN)=%
 Q
 ;
VIEW ; DEBUGGING UTILITY ;IHS/OHPRD/JCM 1/18/94
 N X,Y,Z,I,%
 S X="LINK^ATNM^FTYP^CTXS^COND^NOCO^CONM^SYMB^COMP^VCL^SER^ORTX^FRED^NVAR^FILT^SNOT^TAX"
 S Y="LINK IEN^ATTRIBUTE NAME^DATA TYPE^SUBQUERY^CONDITION (TERM) IEN^NO. OF CONDITIONS^CONDITION NAME^BOOLEAN SYMBOL^COMPARISON VALUE^VALIDITY CODE LOCATION^SEARCH EFFICIENCY^XXX^SINGULARITY^NO. OF VARIABLES^YYY^INVERTED SUBQUERY FLAG^TAXONOMY"
 F I=1:1 S %=$P(X,U,I) Q:%=""  S Z="AMQQ"_% I $G(@Z)]"" W !,I,?4,$P(Y,U,I),": ",$S(((I=4)!(I=16)):$S(@Z:"YES",1:"NO"),1:@Z)
 Q

AMQQATA
AMQQATA ; IHS/OHPRD/JCM - GETS ATTRIBUTE ; [ 03/02/2000  8:33 PM ]
 ;;2;PCC QUERY UTILITY;**5,15,16**;JUN 10, 1993
EN ; - ENTRY POINT -
ATTRIB I '$D(AMQQCNAM) S AMQQQUIT="" Q
 I $D(AMQQRSAF) G AUTO
 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")="" ;IHS/OHPRD/JCM 7/15/94
 S %=$E(X,1,3) I %="DPT"!(%="DTP")!(%="DTa")!(%="OPV")!(%="IPV")!(%="MMR") S AMQQIMMS=X,X=% G ADIC ;IHS/CMI/THL - PATCH 15 AND PATCH 16
 S %=$E(X,1,2) I %="DT"!(%="TD")!(%="TT")!(%="Td")!(%="MR") S AMQQIMMS=X,X=% ;IHS/CMI/THL - PATCH 15
ADIC S DIC="^AMQQ(5,",DIC(0)="ES",DIC("S")="I $P(^(0),U,2)=AMQQCCLS,+Y<466!(+Y>499)",D="C" ;IHS/CMI/THL - PATCH 15
 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 ;IHS/CMI/THL - PATCH 15
 I $D(AMQQSGFL) K AMQQSGFL
 E  K AMQQMULT
 I Y="TAX" S X="" Q
 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),AMQQATNM=$P(Y,U,2),AMQQLINK=$P(%,U,5),AMQQATN=+Y,AMQQSBCT=$P(%,U,20)
 I $P(^AMQQ(1,AMQQLINK,0),U,10)="AUPNVXAM" S %=$P(^(0),U,11) I %,'$D(^AUPNVXAM("B",%)) S AMQQNOL="" W:'$D(AMQQXX) !,"No results for this exam are in the database.  Don't bother asking.",!,*7 G ATTRIB
 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),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),AMQQCTXS=$P(%,U,7),AMQQVCL=$P(%,U,6),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,AMQQUATN=99,AMQQILIN=99
 S AMQQGVF="",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,^AMQQATS
GEXIT K AMQQGVF
 Q
 ;
NATL ; NATURAL LANGUAGE CHECKER
 ;N (DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED,X,Y,AMQQNATF,AMQQURGN,AMQQTAX,AMQQCNAM,AMQQATN,AMQQATNM) S AMQQXX=""
 D ^AMQQN2
 W *13,?79,*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 15
 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=270 S $P(Y,U)=487 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
 ;I +Y=465 S $P(Y,U)=487 Q  ;IHS/CMI/THL - PATCH 16
 Q

AMQQATAL
AMQQATAL ; IHS/OHPRD/JCM - SETS TEMP METADICTIONARY ENTRY FOR LAB TESTS ; [ 02/26/00  11:28 AM ]
 ;;2;PCC QUERY UTILITY;**6**;JUN 10, 1993
 ; All hard sets in this routine are for temporary purposes only
SETLAB ; ENTRY POINT
 N X,%,Y,A
 S %=^AMQQ(5,AMQQATN,4),AMQQLTYP=$P(%,U),AMQQLDFN=$P(%,U,2),AMQQLSIT=$P(%,U,3),AMQQLHED=$P(%,U,4),AMQQLHDL=$P(%,U,5),AMQQLUNT=$P(%,U,6),AMQQLOUT=$P(%,U,7),AMQQLINK=AMQQATN,AMQQNOL=""
 D OK I $D(AMQQNOL) W:'$D(AMQQXX) !,"No results for this test are in the database.  Don't bother asking.",!,*7 G EXIT
 D MSG I $D(AMQQNOL) Q
 S AMQQLINK=AMQQLINK+($J/100000)
 S %=AMQQLTYP,AMQQLNNA=$S(%=9:1,%=12:2,%=11:3,%=15:4,%=6:6,1:"")
 S %="^2^9000010.09^.04^9^^1^1^^AUPNVLAB^^3.7^AC^^^^"
 S $P(%,U,1)="PATIENT;"_AMQQATNM
 S $P(%,U,5)=AMQQLTYP,$P(%,U,9)=AMQQATNM,$P(%,U,11)=AMQQLDFN,$P(%,U,15)=AMQQLDFN
 S ^AMQQ(1,AMQQLINK,0)=%
 S %=^AMQQ(1,9,1),%=$P(%,"XXX")_AMQQLDFN_$P(%,"XXX",2),^AMQQ(1,AMQQLINK,1)=%
 S ^AMQQ(1,AMQQLINK,1.1)=^AMQQ(1,9,1.1)
 D STG
 S %=^AMQQ(1,9,1.2),%=$P(%,"XXX")_X_$P(%,"XXX",2),%=$P(%,"YYY")_AMQQLNNA_$P(%,"YYY",2),^AMQQ(1,AMQQLINK,1.2)=%
 S %=^AMQQ(1,9,2),%=$P(%,"XXX")_X_$P(%,"XXX",2),%=$P(%,"YYY")_AMQQLNNA_$P(%,"YYY",2),^AMQQ(1,AMQQLINK,2)=%
 S ^AMQQ(1,AMQQLINK,4,0)="^9009071,01^2^2"
 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
 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"
 S ^AMQQ(1,AMQQLINK,9)=AMQQATNM_" RESULTS^RESULTS^EXPANDED LAB REPORT"
EXIT K AMQQLDFN,AMQQLTYP,AMQQLSIT,AMQQLHED,AMQQLHDL,AMQQLUNT,AMQQLOUT,AMQQLUNT,AMQQLNNA,I,J,X,Y,Z,%,B,N,A
 Q
 ;
EN1 ; ENTRY POINT FROM AMQQSQA0
 N AMQQLINK,AMQQ,AMQQATNM S AMQQATN=+Y,AMQQATNM=$P(Y,U,2) N X,Y,%
 D SETLAB
 Q
 ;
OK N AMQQLX,AMQQLI,X,Y,%
 I $D(^AUPNVLAB("B",AMQQLDFN)) K AMQQNOL S AMQQLENO=AMQQLDFN_"."_AMQQLSIT
 I $G(AMQQLSIT)=44 S AMQQLDFN(AMQQLENO)="" Q  ; GIS/ILC 2/1/00 ; ENABLES LOOKUP OF UNKONWN SITE/SPECIMEN
 I AMQQLSIT'=72 D  Q
 .F %=0:0 S %=$O(^AMQQ(5,"LC",AMQQLINK\1,%)) Q:'%  I $D(^AUPNVLAB("B",%)) K AMQQNOL S AMQQLDFN(%,".",AMQQLSIT)="",AMQQLDFN(AMQQLDFN_"."_AMQQLSIT)=""
 .Q
 S AMQQLX=AMQQLDFN_U
 F %=0:0 S %=$O(^AMQQ(5,"LC",AMQQLINK,%)) Q:'%  S AMQQLX=AMQQLX_%_U
 F AMQQLI=1:1 S X=$P(AMQQLX,U,AMQQLI) Q:'X  I $D(^AUPNVLAB("B",X)) K AMQQNOL D
 .F Y=72,70,73 I $D(^LAB(60,X,1,Y)) S AMQQLDFN(X_"."_Y)=""
 .Q
 Q
MSG I $D(AMQQXX) Q
 W !
 I $D(AMQQLCOF) D SEL Q
 I $D(AMQQLDFN)<9 S X=AMQQLDFN D LINE Q
 S %=$O(AMQQLDFN(0)) I % S %=$O(AMQQLDFN(%)) I % W !,"The following tests will be included in the query =>",! ;IHS/OHPRD/JCM 8/20/94
 E  Q
 S AMQQLI=0 F  S AMQQLI=$O(AMQQLDFN(AMQQLI)) Q:'AMQQLI  S X=AMQQLI D LINE
 K AMQQLI
 Q
 ;
LINE W !,?2
 I $D(AMQQLCOF) W J,") "
 I AMQQLSIT=72 S %=+$P(X,".",2) S %=$S(%=7:"BLOOD ",%=70:"BLOOD ",%=72:"SERUM ",%=73:"PLASMA ",1:"") W %
 W $P(^LAB(60,X\1,0),U) S Y=AMQQLSIT I %'="" S Y=+$P(X,".",2)
 S %=$G(^LAB(60,X\1,1,Y,0)) 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),"]"
 Q
 ;
SEL ;
 I $D(AMQQLDFN)=0 G SELEXIT
 I $D(AMQQLDFN)=1 S X=AMQQLDFN_"."_AMQQLSIT D LINE G SELEXIT
 S (N,J)=0 S I=0 F  S I=$O(AMQQLDFN(I)) Q:'I  S N=N+1
 I N=1 S X=$O(AMQQLFDN(0)),X=AMQQLDFN(X) D LINE G SELEXIT
 S X=0 F  S X=$O(AMQQLDFN(X)) Q:'X  S J=J+1,AMQQLCOF(X)=J D LINE
SELR R !!,?2,"Your choice: ",X:DTIME E  S X=U
 I X?1."?" W !,"Enter a number from 1 to ",N," or string numbers together with commas; e.g. 1,",N G SELR
 I "^"[$E(X) S AMQQNOL="" W !!,"ATTRIBUTE CANCELLED...",!!,*7 G SELEXIT
 S Z=U 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
 S I=0 F  S I=$O(AMQQLDFN(I)) Q:'I  S N=+$G(AMQQLCOF(I)) I Z'[(U_N_U) K AMQQLDFN(I)
SELEXIT K AMQQLCOF
 Q
 ;
STG ;
 I $D(AMQQLDFN)=1 S X=AMQQLDFN D STG1 Q
 S X="" S %=$O(AMQQLDFN(0)) Q:'%  D  S:X'="" X=X_":" S X=X_A
 .S Y=(%\1)-.0000001,A="",%=Y+1
 .S Z=Y F  S Z=$O(AMQQLDFN(Z)) Q:'Z  Q:Z>(Y+1)  D
 ..S B=Z
 ..I B=(B\1) S B=B_".00"
 ..I A="" S A=B Q
 ..S A=A_"."_+$P(B,".",2)
 ..Q
 .Q
 Q
STG1 ;
 N %,N S N=0
 F %=70:1:79 I $D(^LAB(60,AMQQLDFN,1,%)) D
 .I ((%=70)!(%=73)),$D(^LAB(60,AMQQLDFN,1,72)) Q
 .S N=N+1
 .I N=2 S %=99
 .Q
 I N=2 S X=X_"."_AMQQLSIT
 Q
 ;

AMQQATL
AMQQATL ; OHPRD/DG - ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**8,14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 for WH interface
 I $D(AMQQXX) Q
 S Q=AMQQQ
 I +Q=33,Q[";;;NULL" D STD Q
 I +Q=256 S ^UTILITY("AMQQ",$J,"LIST",200)="W !,?6,""Secondary chart numbers will be displayed if they exist""" Q
 I +Q=454 S ^UTILITY("AMQQ",$J,"LIST",200)="W !,?6,""Only CURRENT Private Insurers will be displayed if they EXIST""" Q  ; IHS/OHPRD/TMJ 10/1/95
 I $P(Q,U,9)["NULL" S Z=": NONE EXIST" D NULL G EXIT
 I $P(Q,U,9)["EXIST"!($P(Q,U,9)[";ALL") S Z=" EXISTS" D NULL I '$P(Q,U,4) G EXIT
 I $P(Q,U,9)[";ANY" S Z=" ANY VALUE INCLUDING NULL" D NULL Q
 S %=$P(AMQQQ,U,9),%=$P(%,";",4) I %[">:-888"!(%["'<:NEG")!(%["|||") S Z=" ALL VALUES" D NULL Q
 I $P(Q,U,4) D SQ G EXIT
 I $P(Q,U,17)'="" D TATT G EXIT
 D LATT
EXIT I $D(^UTILITY("AMQQ",$J,"LIST",AMQQILIN)),$D(AMQQKONG) S %=^(AMQQILIN) I %[",""" S %=$P(%,",""")_",""[OR #"_AMQQKGNO_"] "_$P(%,",""",2,99),^(AMQQILIN)=%
 K AMQQFTYP,AMQQVCL,Q,%,X,Y,Z
 Q
 ;
LATT I $P(Q,U,2)="ALIVE" D ALIVE,L1 Q
 I $P(Q,U,2)="COHORT" D COHORT,L1 Q
 I $P(Q,U,2)="FILE ENTRY" D FILE,L1 Q
 S %="W ?6"
 I $P(Q,U,7)="EQUAL TO" S $P(Q,U,7)="="
 S %=%_",""" I $P(Q,U,2)'=$E($P(Q,U,7),1,$L($P(Q,U,2))) D  ; IHS/CMI/GIS 3/5/98
 . S %=%_$P(Q,U,2)
 . I $P(Q,U,3)="S",$P(Q,U,7)="IS" S %=%_": """ Q
 . S %=%_" "
 . Q
 I $P(Q,U,3)'="S"!($P(Q,U,7)'="IS") S %=%_$P(Q,U,7)_" """ ; IHS/CMI/GIS 3/5/98
 S AMQQFTYP=$P(Q,U,3),AMQQVCL=$P(Q,U,10)
 I AMQQFTYP="Y" S %="W ?6,""PROVIDER ATTRIBUTES AS SPECIFIED""" G LSER
 I $P(Q,U,3)="B" D BLOOD G LSER
 S X=$P(Q,U,9),Y=$P(X,";") D TRANS
 I X[";",$P(X,";")'=$P(X,";",2) S %=%_","" and """,Y=$P(X,";",2) D TRANS
LSER S $P(AMQQQ,U,12)=%
 I $P(Q,U,11)'="" S %=%_",""     [SER = "_+$P(Q,U,11)_"]"""
L1 S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)=%
 Q
 ;
TRANS I AMQQFTYP="D" X ^DD("DD") G SETA
 I AMQQFTYP="B" S Y=X
 I AMQQFTYP="F",$P(Q,U,8)="<>" S Y=$S(Y=" ":"FIRST ENTRY",Y="|||||":"LAST ENTRY",1:Y) G SETA
 I AMQQFTYP="L" D LOOK G SETA
 I AMQQFTYP="S" S Z=$P(^DD($P(AMQQVCL,","),$P(AMQQVCL,",",2),0),U,3),Z=";"_Z,Y=$F(Z,(";"_X_":")),Y=$E(Z,Y,99),Y=$P(Y,";")
SETA S %=%_","""_Y_""""
 Q
 ;
LOOK ;N (DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED,Q,Y)
 S (Z,DIC)=$P(^AMQQ(1,+Q,0),U,3),DIC(0)="",X="`"_$P(Q,U,9)
 D ^DIC K DIC
 S Y=$P(Y,U,2)
 I Y'["," Q
 I Z'=2,Z'=6,Z'=16,Z'=9000001 Q
 S Y=$P(Y,",",2)_" "_$P(Y,",")
 Q
 ;
TATT S %="W ?6,"""_$P(Q,U,2)
 S X=$P(Q,U,9),X=$P(X,";",4)
 S Z=" AS SPECIFIED" D ZSET^AMQQATL1 ; IHS/CMI/GIS 11/19/98
 S %=%_$S($D(AMQQONE):"",X="NULL":" IS 'NULL'",X="EXISTS":" EXISTS",1:Z)
 S %=%_""""
 D TT1,L1
 Q
 ;
TT1 S $P(AMQQQ,U,12)=%
 I $P(Q,U,11)[":"!($P(Q,U,17)'="") S %=%_",""   [SER = "_+$P(Q,U,11)_"]"""
 Q
 ;
SQ D SQ^AMQQATSQ
 Q
 ;
SQ1 ; - EP -
 N %,X F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"SQL",AMQQLSQF,%)) Q:'%  S AMQQILIN=AMQQILIN+1,X=^(%),^UTILITY("AMQQ",$J,"LIST",AMQQILIN)=X I $D(^UTILITY("AMQQ",$J,"SQXL",AMQQLSQF,%)) S AMQQSQLN=$O(^(%,"")) D SQ2
 Q
 ;
SQ2 N AMQQLSQF S AMQQLSQF=AMQQSQLN
 D SQ1
 Q
 ;
NULL I $P(Q,U,4),'$D(AMQQGVF),"GL"[$P(Q,U,3) Q
 S AMQQATNM=$P(Q,U,2)
 S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?6,"""_AMQQATNM_Z_"   [SER = "_+$P(Q,U,11)_"]"""
 S $P(AMQQQ,U,12)="W ?6,"""_AMQQATNM_""""
 Q
 ;
STD S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?6,""ALIVE TODAY   [SER = "_+$P(Q,U,11)_"]"""
 Q
 ;
ALIVE S Y=$P(Q,U,9) X ^DD("DD")
 S %="W ?6,""ALIVE AS OF "_Y_"   [SER = "_$P(Q,U,11)_"]"""
 Q
 ;
COHORT S Y=+$P(Q,U,9),Y=$P(^DIBT(Y,0),U)
 S %="W ?6,"""_$S(((+Q=151)!(+Q=85)):"NOT A MEMBER",((+Q=166)!(+Q=86)):"RANDOM SAMPLE",1:"MEMBER")_" OF '"_Y_"' COHORT   [SER = "_$P(Q,U,11)_"]"""
 Q
 ;
FILE S %=$P(Q,U,9),Y=$P(%,";"),Y=@(U_Y_"0)"),Y=$P(Y,U)
 I +Q=176,Y="BW PATIENT" S %="W ?6,""REGISTERED IN THE WOMEN'S HEALTH DATABASE   [SER = "_$P(Q,U,11)_"]""" Q  ; IHS/CMI/GIS  3/1/98
 S %="W ?6,"""_$S(+Q=176:"ENTERED",+Q=177:"NOT ENTERED",1:"RANDOM SAMPLE OF PATIENTS")_" IN THE '"_Y_"' FILE   [SER = "_$P(Q,U,11)_"]"""
 Q
 ;
BLOOD N Y,X
 S Y=$P(Q,U,9) S X=$P(Y,";") D TRANS^AMQQAVB S X(1)=X
 S X=$P(Y,";",2) D:X'="" TRANS^AMQQAVB S X(2)=X
 S $P(AMQQQ,U,9)=X(1)_";"_X(2)
 S %=%_","""_$P(Y,";")_"""" I $P(Y,";",2)'="" S %=%_","" and "_$P(Y,";",2) S %=%_""""
 Q

AMQQATL1
AMQQATL1 ; OHPRD/DG - OVERFLOW FROM AMQQATL ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
ZSET ; ENTRY POINT FROM AMQQSQL
 I '$D(AMQQQ) Q
 I AMQQQ[";INVERSE^" S Z="(INVERSE SET)" Q
 I $G(AMQQSQNM)="RESULT/DIAGNOSIS" D  I $G(Z)]"" Q  ; IHS/CMI/GIS 11/19/98 ; ARGUMENTLESS DO LINES ADDED
 . I AMQQQ[";ALL^" S Z=" (ALL)" Q
 . I AMQQQ[";ANY^" S Z=" (ANY)" Q
 . I AMQQQ[";EXISTS^" S Z=" (EXISTS)" Q
 . Q
 N AMQQZT,X,Y,N,J,I,%
 S N=$P(AMQQQ,U,9),N=$P(N,";",4)
 S (X,%)="" F I=1:1:3 S X=$O(^UTILITY("AMQQ TAX",$J,N,X)) Q:X=""  I X'?1.P S AMQQZT=X D ZTRANS S %=%_AMQQZT_U
 I %="" Q
 S Y=" (" F J=1,2 S X=$P(%,U,J) Q:X=""  S:J=2 Y=Y_"/" S Y=Y_X
 I $P(%,U,3)'="" S Z=Y_"...)" Q
 S Z=Y_")"
 Q
 ;
ZTRANS N X,Y,N,J,I,% S X=AMQQZT
 I +AMQQQ=266 S X=$P(^ICD9(X,0),U) S AMQQZT=X
 E  I +AMQQQ=302 S X=$P(^AUTTHF(X,0),U) S AMQQZT=X
 E  I $D(^AMQQ(1,+AMQQQ,4,1,1)) X ^(1) S AMQQZT=X
 S AMQQZT=$P(AMQQZT,",")
 S AMQQZT=$E(AMQQZT,1,12)
 Q
 ;

AMQQATR
AMQQATR ; IHS/OHPRD/JCM - AMQQAT SUBROUTINE...COMPUTES DYNAMIC SEARCH RATING ; [ 01/31/94 9:26 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
RUN N AMQQHIDE I +AMQQQ=33,AMQQQ[";;;NULL" S AMQQHIDE=""
 I $D(AMQQXX) S AMQQHIDE=""
 I $D(AMQQONE),AMQQONE'="" S $P(AMQQQ,U,11)=-.1 Q
 I +AMQQQ=3,$P(AMQQQ,U,8)="=" S $P(AMQQQ,U,11)=99 Q
CHECK I $P(^AMQQ(1,+AMQQQ,0),U,7),AMQQQ'[";ANY^",AMQQQ'[";NULL^",$P(AMQQQ,U,17)="" D ^AMQQATR1 G EXIT
 I '$D(^AMQQ(1,+AMQQQ,3)) S $P(AMQQQ,U,11)=-.1 Q
 S %=$P(AMQQQ,U,2) I %="DIAGNOSIS"!(%="RX") D DX Q
 I $P(AMQQQ,U,17)'=""!(+AMQQQ=212) D ^AMQQATR2 G EXIT
 I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
 S Q=AMQQQ
 I $P(Q,U,2)="FILE ENTRY" D FILE S AMQQECPR=% D SAMPLE G EXIT
 S AMQQEXCD=^AMQQ(1,+Q,3),AMQQENCO=$P(Q,U,6),AMQQECPR=$P(Q,U,9),AMQQESBL=$P(Q,U,8),AMQQEVAL=""
 I $P(AMQQECPR,";",4)["EXIST"!($P(AMQQECPR,";",4)["NULL") S AMQQECMP="I AMQQEVAL'=""""" D SAMPLE G EXIT
 D @("FILTER"_$P(Q,U,3)_"^AMQQATR0"),SAMPLE
EXIT K %,Q,AMQQSER,X,Y,Z,AMQQY,AMQQEVAL,AMQQECMP,AMQQENUM,AMQQEDEN,AMQQEINC,AMQQESBL,AMQQEXCD,AMQQECNT,AMQQECPR,AMQQENCO,AMQQHIDE
 Q
 ;
SAMPLE D @("SAMPLE"_AMQQCCLS)
 S X=AMQQENUM/AMQQEDEN I 'X S X=.01
 I AMQQECPR["NULL" G SETSER
 S X=(1-X)/$S($D(AMQQKONG):1,$P(^AMQQ(1,+Q,0),U,8):X,+Q=40:X,+Q=176:X,1:1)
SETSER S AMQQSER=$J(X,1,2)
 S %=$P(^AMQQ(1,+AMQQQ,0),U,15) I %'="" S AMQQSER=AMQQSER_":"_%
 S $P(AMQQQ,U,11)=AMQQSER
 Q
 ;
SAMPLEH S %=1,AMQQENUM=0,X=$P(@AMQQ200(16)@(0),U,4) ;VA/SLC ISC/GIS 11/24/93
 S AMQQEINC=$S(X<50:0,1:(X\50)),AMQQECNT=0
 F AMQQEDEN=0:1 S %=$O(@AMQQ200(16)@(%)) Q:%'=+%  X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q  ;VA/SLC ISC/GIS 11/24/93
 Q
 ;
SAMPLEP S %=1,AMQQENUM=0,X=$P(^DPT(0),U,4)
 S AMQQEINC=$S(X<50:0,1:(X\50)),AMQQECNT=0
 F AMQQEDEN=0:1 S %=$O(^DPT(%)) Q:%'=+%  X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
 Q
 ;
SAMPLEV S %=1,AMQQENUM=0,X=$P(^AUPNVSIT(0),U,4)
 S AMQQEINC=$S(X<50:0,1:(X\50)),AMQQECNT=0
 F AMQQEDEN=0:1 S %=$O(^AUPNVSIT(%)) Q:%'=+%  X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
 Q
 ;
SAMPLED S %=1,AMQQENUM=0,X=$P(^AUPNVPOV(0),U,4)
 S AMQQEINC=$S(X<50:0,1:(X\50)),AMQQECNT=0
 F AMQQEDEN=0:1 S %=$O(^AUPNVPOV(%)) Q:%'=+%  X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
 Q
 ;
DX I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) S $P(AMQQQ,U,11)=-1 Q
 I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
 S %=0 F I=0:1 S %=$O(^UTILITY("AMQQ TAX",$J,AMQQURGN,%)) Q:'%  W:'$D(AMQQHIDE) "."
 S %=.99/((.01)*(4+(I/16))),%=$J(%,1,2),$P(AMQQQ,U,11)=%
 I $G(AMQQUSQN),'$D(^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,"NULL")) S $P(AMQQQ,U,11)=%_":"_20
 Q
 ;
FILE I +Q<178 S %=$P(Q,U,9),AMQQEXCD="I "_$S(+Q=177:"'",1:"")_"$D(^"_$P(%,";")_""""_$P(%,";",2)_""",%))" Q
 S %=$P(Q,U,9),AMQQEXCD="I $D(^UTILITY(""AMQQ FRAND"","_$P(%,";",3)_","_$P(%,";",6)_",%))"
 Q
 ;
KONG ; ENTRY POINT FROM AMQQCMPK
 I $D(AMQQXX) S AMQQHIDE=""
 D @("SAMPLE"_AMQQCCLS)
 S X=AMQQENUM/AMQQEDEN I 'X S X=.01
 S X=1-X,X=$J(X,1,2)
 K AMQQHIDE
 Q
 ;

AMQQATR0
AMQQATR0 ; IHS/OHPRD/JCM - MAKES CODE FOR DYNAMIC SEARCH OPTIMIZATION ; [ 10/25/93 1:46 PM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**2**;JUN 10, 1993
FILTERB ; ENTRY POINT FROM AMQQATR
 I $P(AMQQECPR,";",2)'="" G FB2
 S Z=$P(AMQQECPR,";") D FBT
 S AMQQECMP="I AMQQEVAL"_AMQQESBL_Z
 Q
 ;
FBT S Z=$S(Z?1.N1"/"1.N:(+Z/$P(Z,"/",2)),$E(Z)="N":0,$E(Z)="F":1,1:-1)
 Q
 ;
FB2 S Z=$P(AMQQECPR,";") D FBT S X(1)=Z,Z=$P(AMQQECPR,";",2) D FBT S X(2)=Z
 I AMQQESBL="><" S X(3)=.0000000001,X(1)=X(1)-X(3),X(2)=X(2)+X(3),AMQQECMP="I AMQQEVAL>"_X(1)_",AMQQEVAL<"_X(2) Q
 S AMQQECMP="I AMQQEVAL<"_X(1)_"!(AMQQEVAL>"_X(2)_")"
 Q
 ;
FILTERD ; ENTRY POINT FROM AMQQATR
FILTERN ; ENTRY POINT FROM AMQQATR
 I $P(AMQQECPR,";",2)="" S AMQQECMP="I AMQQEVAL"_AMQQESBL_+AMQQECPR Q
 S X(1)=+AMQQECPR,X(2)=$P(AMQQECPR,";",2)
 S AMQQECMP="I AMQQEVAL<"_X(1)_"!(AMQQEVAL>"_X(2)_")"
 I AMQQESBL="><"!(AMQQESBL="=") S X(3)=.0000001,X(1)=X(1)-X(3),X(2)=X(2)+X(3),AMQQECMP="I AMQQEVAL>"_X(1)_",AMQQEVAL<"_X(2) Q  ;IHS/OHPRD/JCM 10/25/93
 Q
 ;
DATE S AMQQECMP="I 1",X=$P(AMQQESBL,";"),AMQQEVAL=0
 I X'="<",X'="'>" S AMQQEVAL=$P(AMQQECPR,";")-.0000001
 I AMQQENCO=2 S AMQQECMP="I AMQQEVAL>"_$P(AMQQECPR,";",2)
 Q
 ;
FILTERS ; ENTRY POINT FROM AMQQATR
 S AMQQECMP="I AMQQEVAL"_AMQQESBL_""""_$P(AMQQECPR,":")_""""
 Q
 ;
FILTERF ; ENTRY POINT FROM AMQQATR
 I AMQQECPR[";" S AMQQECMP="I AMQQEVAL]"""_$P(AMQQECPR,";")_""",AMQQEVAL']"""_$P(AMQQECPR,";",2)_""",AMQQEVAL"_"'=""""" Q
 I AMQQESBL="$" S AMQQECMP="I $E(AMQQEVAL,1,"_$L(AMQQECPR)_")="""_AMQQECPR_"""" Q
 I AMQQESBL="#" S AMQQECMP="I $E(AMQQEVAL,"_($L(AMQQEVAL)-$L(AMQQECPR)+1)_",99)="""_AMQQECPR_"""" Q
 S AMQQECMP="I AMQQEVAL"_AMQQESBL_""""_AMQQECPR_""""
 Q
 ;
FILTERA ; ENTRY POINT FROM AMQQATR
 N % S %DT="",X="T+1" D ^%DT S X(3)=Y
 S X(1)=+AMQQECPR,X(2)=$P(AMQQECPR,";",2)
 I AMQQESBL="'<" S X(1)=X(1)-1,AMQQESBL=">" G FAG
 I AMQQESBL="'>" S X(1)=X(1)+1,AMQQESBL="<" G FAL
FAG I AMQQESBL=">" S Z(1)=0,Z(2)=X(3)-((X(1)+1)*10000),AMQQESBL="><" G FSET
FAL I AMQQESBL="<" S Z(2)=99999999,Z(1)=DT-(X(1)*10000),AMQQESBL="><" G FSET
 I AMQQESBL="=" S Z(1)=DT-((X(1)+1)*10000),Z(2)=X(3)-(X(1)*10000),AMQQESBL="><" G FSET
 I AMQQESBL="'=" S Z(1)=DT-(X(1)*10000),Z(2)=X(3)-((X(1)+1)*10000),AMQQESBL="'><" G FSET
 I AMQQESBL="><" S Z(1)=DT-(X(2)*10000),Z(2)=X(3)-(X(1)*10000) G FSET
 S Z(1)=DT-(X(1)*10000),Z(2)=X(3)-(X(2)*10000)
FSET I AMQQESBL="><" S AMQQECMP="I AMQQEVAL>"_Z(1)_",AMQQEVAL<"_Z(2) Q
 S AMQQECMP="I AMQQEVAL>"_Z(1)_"!(AMQQEVAL<"_Z(2)_")"
 Q
 ;
FILTERC Q
 ;

AMQQATR2
AMQQATR2 ; IHS/OHPRD/JCM - DSO FOR TAX ; [ 01/31/94 9:27 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
 I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
 S Q=AMQQQ,S=^AMQQ(1,+Q,3) K AMQQOK
 S %=$P(Q,U,9) I $P(%,";",5)="ANY" S AMQQSER=-1 G EXIT
 S AMQQSERF="^AUPNPAT",AMQQDSCF=1
 I $P(^AMQQ(1,+Q,0),U,12) S AMQQDSCF=$P(^(0),U,12)
 I AMQQCCLS="V" D VISIT
 I AMQQCCLS="H" D PROV
 S AMQQTAX=$P(Q,U,17),%=$P(Q,U,9),N=9999999.999999,X=N-$P(%,";",2),AMQQD1=X-.0000001,AMQQD2=N-(+%)
 S AMQQTDFN=1,AMQQENUM=0,X=$P(@AMQQSERF@(0),U,4),AMQQEINC=$S(X<50:0,1:(X\50)),AMQQECNT=0
SAMPLE F AMQQEDEN=0:1 S AMQQTDFN=$O(@AMQQSERF@(AMQQTDFN)) Q:AMQQTDFN'=+AMQQTDFN  S AMQQECMP=$G(AMQQECMP) X S S AMQQTDFN=AMQQTDFN+AMQQEINC,AMQQECNT=AMQQECNT+1 W:'$D(AMQQHIDE) "." I AMQQECNT>50 Q
SER S X=AMQQENUM/AMQQEDEN I X=0 S X=.01
 I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"NULL")) S X=1-X G SETSER
 S X=(1-X)/$S($P(^AMQQ(1,+Q,0),U,8):X,1:1),X=X/AMQQDSCF
SETSER S X=$J(X,1,2)
 I $P(AMQQQ,U,3)="G",+AMQQQ>689.9999,+AMQQQ<706 S X=X_":900" G SS1
 ; I $P(AMQQQ,U,3)="G" S X=X_":9"
SS1 S AMQQSER=X,$P(AMQQQ,U,11)=X
EXIT K AMQQTAX,AMQQTPFN,%,X,Y,Z,A,B,C,D,N,I,AMQQD1,AMQQD2,AMQQTDFN,S,AMQQDSCF,AMQQENUM,AMQQEDEN,AMQQEINC,AMQQECNT,AMQQETGB,AMQQETAX,AMQQSERF
 Q
 ;
MTEST F X=AMQQD1:0 S X=$O(@AMQQETGB@(X)) Q:'X  Q:X>AMQQD2  F AMQQTPFN=0:0 S AMQQTPFN=$O(@AMQQETGB@(X,AMQQTPFN)) Q:'AMQQTPFN  I (($D(^UTILITY("AMQQ TAX",$J,AMQQURGN,+@AMQQETAX))=10)+($P(Q,U,18)=3))=1 S AMQQENUM=AMQQENUM+1 G MEXIT
MEXIT Q
 ;
TTEST I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"*")),AMQQETGB'="" S AMQQENUM=AMQQENUM+1 Q
 I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"-")),AMQQETGB="" S AMQQENUM=AMQQENUM+1 Q
 I AMQQETGB'="",$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQETGB)),'$D(^("--")) S AMQQENUM=AMQQENUM+1 Q
 I '$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) Q
 I AMQQETGB="" S AMQQENUM=AMQQENUM+1 Q
 I AMQQETGB'="",'$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQETGB)) S AMQQENUM=AMQQENUM+1
 Q
 ;
VFILE ; ENTRY POINT FROM AMMQATR1
 D VSET
RINCI S I=I+1 W:'$D(AMQQHIDE) "." I I>50 G RSET
 S B=B+A,B=$O(@G@(B)) G RSET:'B S D=0
RINCD S D=$O(@G@(B,D)) G RINCI:'D S C=-999999999
RINCC S C=$O(@G@(B,D,C)) G RINCD:'C
 S R=$P(@F@(C,S),U,T)
 I $D(AMQQLTR) X AMQQLTR S Y=AMQQLTB1_AMQQLTR1,Z=AMQQLTB2_AMQQLTR2
 I $D(AMQQRTXT) X AMQQRTXT G INCJ
 I Z="" S %="I R"_Y X % G INCJ
 S %="I R"_Y_",R"_Z X %
INCJ I  S J=J+1 G RINCI
 G RINCC
RSET S:'K K=1 S %=(J/I) S:'% %=.01 S %=(1-%)/(%*K),%=$J(%,1,2)
 S AMQQSER=%
REXIT K %,A,B,C,D,E,F,G,H,I,J,K,M,N,P,R,S,T
 Q
 ;
VSET S %=^AMQQ(1,+AMQQQ,0),F=U_$P(%,U,10),G=F_"(""AA"")"
 S P=$P(^DPT(0),U,4),(B,I,J)=0,A=(P\50)+(P<50)
 S S=$P(%,U,11),T=$P(S,";",2),S=+S,K=$P(%,U,12)
 S %=$P(AMQQQ,U,9),Y=$P(%,";",4),Y=$P(Y,":")_$P(Y,":",2),Z=$P(%,";",5),Z=$P(Z,":")_$P(Z,":",2)
 Q
 ;
VISIT N %,X,Y S AMQQSERF="^AUPNVSIT"
 S %=^AMQQ(1,+Q,0),%=$P(%,U,3) I %=9000010 Q
 S %=^DIC(%,0,"GL"),X=$E(%,$L(%)),Y=$E(%,1,$L(%)-1),AMQQSERF=Y_$S(X=",":")",1:"")
 S X=$P(^AUPNVSIT(0),U,4),Y=$P(@AMQQSERF@(0),U,4)
 I X,Y S AMQQDSCF=(X/Y)*AMQQDSCF
 Q
 ;
PROV S AMQQSERF=AMQQ200(6) ;VA/SLC ISC/GIS 11/24/93
 Q
 ;

AMQQATS
AMQQATS ; IHS/OHPRD/JCM - MAKE "Q" LINE ; [ 09/15/95 8:59 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4,8**;SEP 15, 1995
NEW N AMQQFTYP,AMQQLINK,AMQQSYMB,AMQQVCL,AMQQCOMP,AMQQCOND
RUN D VAR
 I $P(Q,U,4) D ^AMQQATS1,SET G EXIT
 S X(1)=$P(AMQQCOMP,";"),X(2)=$P(AMQQCOMP,";",2)
 D @("FILTER"_AMQQFTYP)
 I $D(AMQQCOMP),$D(X(3)),$D(X(4)),$P(AMQQCOMP,";",4)="EXISTS" S AMQQF(1)=X(3),AMQQF(2)=X(4)
 D SET
EXIT K AMQQF,%,I,Q,X,Y,N,AMQQFSQN,AMQQFSQX
 Q
 ;
VAR S Q=AMQQQ
 S AMQQLINK=+Q,AMQQFTYP=$P(Q,U,3),AMQQCOMP=$P(Q,U,9),AMQQVCL=$P(Q,U,10),AMQQSYMB=$P(Q,U,8),AMQQCOND=$P(Q,U,7)
 Q
 ;
SET I $P(Q,U,3)="L",$D(AMQQURGN),$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) S $P(Q,U,18)=3
 S %="" F I=1:1 Q:'$D(AMQQF(I))  S %=%_AMQQF(I)_";"
 I +Q=166!(+Q=178)!(+Q=86) S %=$P(Q,U,9)
 S $P(Q,U,15)=%
 I $D(AMQQSQQF) S ^UTILITY("AMQQ",$J,"QQ",AMQQSQQF)=Q Q
 I $D(AMQQGVF) Q
 S ^UTILITY("AMQQ",$J,"Q",AMQQUATN)=Q
 S %=$P(Q,U,11),X=1-(+%),^UTILITY("AMQQ",$J,"WEIGHT",X,AMQQUATN)=$P(%,":",2)
 Q
 ;
FILTERD S X(3)=0,X(4)=99999999,X(5)=.0000001 D ANAL
 Q
 ;
FILTERB S X(3)=-1,X(4)=1.01,X(5)=.000001 D ANAL
 Q
 ;
FILTERN S X(3)=-9999999,X(4)=9999999,X(5)=.000001 D ANAL
 Q
 ;
FILTERY S AMQQF(1)=X(1),AMQQF(2)=X(2),AMQQF(3)=$P($P(Q,U,9),";",3),AMQQF(4)=$P($P(Q,U,9),";",4)
 Q
 ;
FILTERC S AMQQF(1)=X(1),AMQQF(2)=X(2)
 Q
 ;
FILTERG ;;
FILTERL ; I $D(AMQQURGN),$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) S $P(Q,U,18)=3 Q
 F %=1,2 S AMQQF(%)=$P(AMQQCOMP,";",4)
 Q
 ;
FILTERS S AMQQF(1)=AMQQSYMB
 I AMQQCOMP=";;;EXISTS" S AMQQF(2)="",AMQQF(3)="~~~~" Q
 S %=$E(AMQQCOMP,$L(AMQQCOMP)),%=$A(%),%=$C(%-1)_"~~~~~",AMQQF(2)=$E(AMQQCOMP,1,$L(AMQQCOMP)-1)_%,AMQQF(3)=AMQQCOMP
 Q
 ;
FILTERF I AMQQSYMB'="-" S AMQQF(1)=AMQQSYMB,AMQQF(2)=AMQQCOMP,AMQQF(3)="" Q
 S AMQQF(1)="-",AMQQF(3)=$P(AMQQCOMP,";",2),%=$P(AMQQCOMP,";")
 S X=$E(%,$L(%)),%=$E(%,1,$L(%)-1),X=$C($A(X)-1),%=%_X_"~~~~~",AMQQF(2)=%
 Q
 ;
FILTERA S %DT="",X="T+1" D ^%DT S X(3)=Y
 S %=AMQQSYMB
 I %="'<" S X(1)=X(1)-1,%=">" G FAG
 I %="'>" S X(1)=X(1)+1,%="<" G FAL
FAG I %=">" S AMQQF(1)=0,AMQQF(2)=X(3)-((X(1)+1)*10000),%="><" G FSET
FAL I %="<" S AMQQF(2)=99999999,AMQQF(1)=DT-(X(1)*10000),%="><" G FSET
 I %="=" S AMQQF(1)=DT-((X(1)+1)*10000),AMQQF(2)=X(3)-(X(1)*10000),%="><" G FSET
 I %="'=",AMQQCOMP["EXIST" S AMQQF(1)=0,AMQQF(2)=9999999 G FSET
 I %="'=" S AMQQF(1)=DT-(X(1)*10000),AMQQF(2)=X(3)-((X(1)+1)*10000),%="'><" G FSET
 I %="><",'+AMQQCOMP S AMQQCOMP=$P(AMQQCOMP,";",2)+1,%="<",$P(Q,U,9)=AMQQCOMP,X(1)=X(2)+1 G FAL ; IHS/OHPRD/TMJ 9/15/95
 I %="><" S AMQQF(1)=DT-((X(2)+1)*10000),AMQQF(2)=X(3)-(X(1)*10000) G FSET
 S AMQQF(1)=DT-(X(1)*10000),AMQQF(2)=(X(3)-(X(2)*10000))-10000
FSET S $P(Q,U,8)=%,AMQQSYMB=%
 Q
 ;
ANAL I AMQQSYMB=">" S AMQQF(1)=X(1),AMQQF(2)=X(4) Q
 I AMQQSYMB="<" S AMQQF(1)=X(3),AMQQF(2)=X(1) Q
 I AMQQSYMB="=",AMQQFTYP="D",X(1)=X(2),X(1)=X(1)\1 S AMQQF(2)=X(1)+.99,AMQQF(1)=X(1)-.76 Q  ;IHS/OHPRD/GIS 5/16/94
 I AMQQSYMB="=" S AMQQF(1)=X(1)-X(5),AMQQF(2)=X(1)+X(5) Q
 I AMQQSYMB="><" S AMQQF(1)=X(1)-X(5),AMQQF(2)=X(2)+X(5) Q
 I AMQQSYMB="'>" S AMQQF(1)=X(3),AMQQF(2)=X(1)+X(5) Q
 I AMQQSYMB="'<" S AMQQF(1)=X(1)-X(5),AMQQF(2)=X(4) Q
 I AMQQSYMB="'=" S AMQQF(1)=X(1),AMQQF(2)=X(1) Q
 S AMQQF(1)=X(2),AMQQF(2)=X(1)
 Q
 ;
DOC S X="LINK^ATTRIBUTE NAME^F TYPE^CONTEXT SWITCH^CONDITION^NUMBER OF CONDITIONS^CONDITION NAME^SYMBOL^COMPARISON VALUE^VALIDITY CODE LOCATION^SEARCH EFFICIENCY RATING^OR TEXT^INDEXED^NUMBER OF VARIABLES^FILTERS^NOT"
 W !! F I=1:1:16 W !,I,") ",$P(X,U,I)
 Q
 ;

AMQQATS1
AMQQATS1 ; IHS/OHPRD/JCM - SETS MULTIPLES ; [ 07/18/94 7:28 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4,5**;JUN 10, 1993
MULT S %=$P(Q,U,9)
 I $P(%,";",6) S %=$P(%,";",1,5),AMQQSQNL="" S:$P(%,";",5)="" %=$P(%,";",1,4) S $P(Q,U,9)=%,AMQQQ=Q
 I $P(Q,U,3)="E"!($P(Q,U,3)="V") D BP Q
 F I=1,2,3,6,7 S AMQQF(I)=$P(%,";",I)
 I $P(Q,U,3)="I" S AMQQF(4)=$P(%,";",4),AMQQF(5)="" S:$P(%,";",5)="ANY" AMQQF(5)="ANY",AMQQF(4)=AMQQF(4)_"~~ANY" G MY ; &&& FIXES IMMUNIZATION ANY BUG
 I $P(Q,U,3)="F" S AMQQF(4)="'[",AMQQF(5)="```" D:$P(%,";",4)[":" TEXT G MY
 I $P(Q,U,3)="S" S AMQQF(4)=$P($P(%,";",4),":"),AMQQF(5)=$P($P(%,";",4),":",2) G MY
 I "QZ"'[$P(Q,U,3) S X=$P(%,":",2) I X'="",X'=+X D TEXT G MY
 I $P(Q,U,16)>1,AMQQF(2)>9990000 S AMQQF(2)=AMQQF(1)+.0000001,AMQQF(1)=0 G MX
 I $P(Q,U,16)>1,AMQQF(1)<1 S AMQQF(1)=AMQQF(2)-.0000001,AMQQF(2)=9999999
 I AMQQF(1)>0,AMQQF(2)<9990000 S:AMQQF(1)=AMQQF(2) AMQQF(2)=AMQQF(2)+.2359 S AMQQF(1)=AMQQF(1)-.76 ;IHS/OHPRD/GIS 5/14/94
MX I $P(Q,U,3)="Z" D ZERO G MY
 I $P(Q,U,3)="Q" D QUAL G MY
 I $P(Q,U,17) S %=$P(Q,U,9) F I=1:1:5 S:'$D(AMQQF(I)) AMQQF(I)=$P(%,";",I) I I=5 G MY
MZ D RANGE S AMQQF(4)=$P(X,":"),AMQQF(5)=$P(X,":",2)
MY S %="0^9999999^9999999^-999999999^999999999^"_AMQQUATN_U_$D(AMQQMULT)
 F I=1:1:7 I AMQQF(I)="" S AMQQF(I)=$P(%,U,I)
 I $D(AMQQSQNL)!($D(^UTILITY("AMQQ",$J,"SQ",+$G(AMQQUSQN),"NULL"))&$D(AMQQFSQN))!$D(AMQQFSQX) K AMQQFSQX,AMQQSQNL,AMQQFSQN S %=$P(Q,U,9),$P(%,";",6)="NULL",$P(Q,U,9)=%
 Q
 ;
ZERO S X=$P(%,";",4)
 I $P(X,":",4)'="",$P(Q,U,8)="'" S Y=$P(X,":",2) D ZTR S AMQQF(5)=Y S Y=$P(X,":",4) D ZTR S AMQQF(4)=Y Q
 I $P(X,":",4)'="" S Y=$P(X,":",2) D ZTR S Y=Y-.1,AMQQF(4)=Y S Y=$P(X,":",4) D ZTR S AMQQF(5)=Y Q
 S Y=$P(X,":",2) D ZTR S X=$P(X,":")
 I X=">" S AMQQF(4)=Y+.01,AMQQF(5)=9 Q
 I X="<" S AMQQF(4)=-1,AMQQF(5)=Y-.01 Q
 I X="=" S AMQQF(4)=Y,AMQQF(5)=Y Q
 I X="'>" S AMQQF(4)=-1,AMQQF(5)=Y Q
 I X="'<" S AMQQF(4)=Y,AMQQF(5)=9 Q
 I X="'=" S AMQQF(4)=Y+.01,AMQQF(5)=Y-.01 Q
 S AMQQF(4)=-1,AMQQF(5)=5
 Q
 ;
ZTR S Y=$E(Y),Y=$S(Y="N":0,Y="T":1,1:(Y+1))
 Q
 ;
QUAL I %="" S AMQQF(4)=-1,AMQQF(5)=2 Q
 S X=$P(%,";",4)
 I X="=:POS"!(X="'=:NEG") S AMQQF(4)=1,AMQQF(5)=1 Q
 I X="=:NEG"!(X="'=:POS") S AMQQF(4)=0,AMQQF(5)=0 Q
 S AMQQF(4)="",AMQQF(5)=""
 Q
 ;
RANGE S %=$P(AMQQCOMP,";",4),Y=$P(%,":"),Z=$P(%,":",2),N=.00000001
 I $P(%,":",4),$P(Q,U,16) S X=$P(%,":",4)_":"_Z Q
 I $L(Y)=1,"[]?="[Y S X=Y_":"_Z I Z'=+Z S X="=:"_Z
 I Y="=" S X=Z_":"_Z Q
 I Y="'=" S X=(Z+N)_":"_(Z-N) Q
 I $P(%,":",4) S X=(Z-N)_":"_($P(%,":",4)+.99999999) Q
 S X=-999999999
 I Y="<" S X=X_":"_(Z-N) Q
 I Y="'>" S X=X_":"_Z Q
 S X=999999999
 I Y=">" S X=Z_":"_X Q
 S X=(Z-N)_":"_X
 Q
 ;
TEXT S Y=$P(%,";",4) S AMQQF(4)=$P(Y,":",1)_":"_$P(Y,":",3),AMQQF(5)=$P(Y,":",2)_":"_$P(Y,":",4)
 Q
 ;
BP N AMQQCOMP
 I %'["~" S (AMQQCOMP,AMQQCOM2)=">:0",AMQQBOOL="!",AMQQCOMP=%_";>:0;>:0"
 E  S AMQQCOMP=$P(%,"~"),AMQQCOM2=$P(%,"~",2),AMQQBOOL=$P(%,"~",3)
 S AMQQF(6)=$S($D(AMQQ("BP COHORT FLG")):"",1:2) F I=1:1:5,7 S AMQQF(I)=$P(AMQQCOMP,";",I) ;IHS/OHPRD/GIS 5/14/94 IHS/OHPRD/JCM 7/15/94
 D MZ
 S AMQQF="" F I=1:1:7 S AMQQF=AMQQF_AMQQF(I)_U
 S AMQQF=AMQQF_AMQQBOOL
 S AMQQCOMP=";;;"_AMQQCOM2 D MZ
 S AMQQF=AMQQF_U_AMQQF(4)_U_AMQQF(5)
 F I=1:1:10 S AMQQF(I)=$P(AMQQF,U,I)
 K AMQQBOOL,AMQQCOM2
 Q
 ;

AMQQATSQ
AMQQATSQ ; OHPRD/DG - OVERRUN FROM AMQQATL ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
SQ ; - ENTRY POINT - from AMQQATL
 I '$D(AMQQGVF),"GL"[$P(AMQQQ,U,3) S Z="" D ZSET^AMQQATL1 S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?"_(3*AMQQUSQL+3)_","""_$P(AMQQQ,U,2)_Z_"  [SER = "_+$P(AMQQQ,U,11)_"]""" ; IHS/CMI/GIS 11/19/98
 I $D(AMQQLSQF) D SQ1^AMQQATL K ^UTILITY("AMQQ",$J,"SQL"),^UTILITY("AMQQ",$J,"SQXL"),AMQQLSQF,AMQQSQLN Q
 I '$D(AMQQLSQF),$D(^UTILITY("AMQQ",$J,"SQL",0,1)) S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?9,""(INVERSE SET)""" K ^UTILITY("AMQQ",$J,"SQL")
 I $P(AMQQQ,U,3)="I" N % S %=$P($P(AMQQQ,U,9),";",4) S:"A"[$E(%) %="ALL" S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?"_(3*AMQQUSQL+3)_",""IMMUNIZED WITH "_$P(AMQQQ,U,2)_" ("_%_")"""
 I  S %=$P(AMQQQ,U,11) I +% S ^UTILITY("AMQQ",$J,"LIST",AMQQILIN)=^UTILITY("AMQQ",$J,"LIST",AMQQILIN)_",""  [SER = "_+%_"]"""
 Q
 ;

AMQQAV
AMQQAV ; IHS/OHPRD/JCM - AMQQAT SUBROUTINE...GETS COMPARISON VALUES ; [ 11/24/93 7:02 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**3**;JUN 10, 1993
 I $D(AMQQSQRD) D EN1^AMQQAVR G EXIT
 I $D(AMQQSVAL) D  Q
 .K AMQQCOMP
 .I $D(Y) S %=$G(^AMQQ(5,+Y,0)) I $P(%,U,3)=7!($P(%,U,20)="D") S X=AMQQSVAL,%DT="" D ^%DT K:Y<1 AMQQSVAL S:Y>0 AMQQSVAL=Y
 .I '$D(AMQQSVAL) W "  ??",*7 H 1
 .I $D(AMQQSVAL) S AMQQCOMP=+AMQQSVAL ;IHS/OHPRD/JCM 11/24/93
 .K AMQQSVAL
 .Q
 I $D(AMQQNATF),$P(AMQQNATF,";",2)'="" S AMQQCOMP=$P(AMQQNATF,";",2) Q
RUN D @("COMP"_AMQQFTYP)
EXIT K %DT,A,B,AMQQSQRD
 Q
 ;
COMPA D COMPA^AMQQAV0
 Q
 ;
COMPD I AMQQATNM="ALIVE" D ALIVE Q
 D COMPD^AMQQAV0
 Q
 ;
COMPS D COMPS^AMQQAV0
 Q
 ;
COMPN D COMPN^AMQQAV0
 Q
 ;
COMPL S DIC("A")="Enter "_AMQQATNM_": ",DIC=$P(^AMQQ(1,AMQQLINK,0),U,2),DIC(0)="AEQ"
 D ^DIC K DIC
 I X=U S AMQQQUIT="" Q
 I X="" Q
 S AMQQCOMP=+Y
 Q
 ;
COMPQ D COMPQ^AMQQAV1
 Q
 ;
COMPF D COMPF^AMQQAV1
 Q
 ;
COMPZ D COMPZ^AMQQAV1
 Q
 ;
COMPB D ^AMQQAVB
 Q
 ;
COMPT D COMPT^AMQQAV2
 Q
 ;
COMPC S AMQQCOMP=AMQQCHRT K AMQQCHRT
 Q
 ;
COMPV D COMPV^AMQQAV2
 Q
 ;
COMPX D ^AMQQSQ
 Q
 ;
ALIVE ; ENTRY POINT FROM AMQQAV0
 S %DT="AEX",%DT("A")="Alive at least until exactly what date: ",%DT("B")="TODAY"
 I $D(AMQQADAM) S %DT="AE"
 D ^%DT
 I $D(DTOUT) S X=U K DTOUT
 I Y'=-1 S AMQQCOMP=Y Q
 I $E(X)=U S AMQQQUIT=""
 Q
 ;

AMQQAV0
AMQQAV0 ; IHS/OHPRD/JCM - AMQQAV SUBROUTINE FOR AGE, DATE, SET, NUMBER AND LOOKUP DATA TYPES ; [ 01/31/94 9:30 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
COMPA ; ENTRY POINT FROM AMQQAV
 I AMQQNOCO>1 D COMPA2 Q
 I $D(AMQQXX) G COMPA1
GETAGE R !,?(5*$D(AMQQZNM)),"Age: ",X:DTIME E  S AMQQQUIT="" Q
COMPA1 I X="" Q
 I X=U S AMQQQUIT="" Q
 I X?1.3N S AMQQCOMP=X Q
 D SPEC I $D(AMQQCOMP) Q
 I $D(AMQQXX) Q
 W "  ??",*7 G GETAGE
 Q
 ;
COMPA2 I $D(AMQQXX) N Z S Z=X,X=+X G COMPN21
 R !,?(5*$D(AMQQZNM)),"Start with (and include) AGE: ",X:DTIME E  S AMQQQUIT="" Q
COMPA21 I X="" S AMQQCOMP=";" G A2
 I X=U S AMQQQUIT="" Q
 I X'?1.3N W "  ??",*7 G COMPA2
 S AMQQCOMP=X_";"
 I $D(AMQQXX) S X=$P(Z,";",2) G A21
A2 R !,?(5*$D(AMQQZNM)),"End with (and include) AGE: ",X:DTIME E  S AMQQQUIT="" Q
A21 I X="",AMQQCOMP=";" K AMQQCOMP Q
 I X="" Q
 I X=U S AMQQQUIT="" Q
 I X'?1.3N W "  ??",*7 G A2
 I X<+AMQQCOMP W "  ??",*7 G A2
 I AMQQCOMP=";" S AMQQCOMP="0;"
 S AMQQCOMP=AMQQCOMP_X
 Q
 ;
COMPD ; ENTRY POINT FROM AMQQAV
 I AMQQATNM="ALIVE" D ALIVE^AMQQAV Q
 I $G(AMQQNOCO)>1 D COMPD2 Q
 S %DT="AETX",%DT("A")="Exact date: " I $D(AMQQADAM) S %DT="AET" ;IHS/OHPRD/JCM 1/27/94
 I $D(AMQQXX) S %DT="" K %DT("A")
 D ^%DT
 I $D(DTOUT) K DTOUT S AMQQQUIT="" Q
 I X="" S X=U,AMQQQUIT="" Q
 I Y'=-1,AMQQSYMB="=" S AMQQCOMP=Y_";"_Y Q
 I Y'=-1,AMQQSYMB=">",Y?7N S Y=Y+.235959 ;IHS/OHPRD/JCM 1/27/94
 I Y'=-1 S AMQQCOMP=Y Q
 I X=U S AMQQQUIT=""
 Q
 ;
COMPD2 I '$D(AMQQXX) G COMPD29
 N Z S Z=X,X=$P(X,";"),%DT="" D ^%DT G COMPD21
COMPD29 S %DT="AETX",%DT("A")="Exact starting date: " S:$D(AMQQADAM) %DT="ATE" D ^%DT ;IHS/OHPRD/JCM 1/27/94
COMPD21 I $D(DTOUT) K DTOUT S AMQQQUIT="" Q
 I X="" S AMQQCOMP=";" G D2
 I X=U S AMQQQUIT="" Q
 S AMQQCOMP=Y_";"
 I $D(AMQQXX) S X=$P(Z,";",2),%DT="" D ^%DT G D21
D2 S %DT("A")="Exact ending date: " D ^%DT
D21 I $D(DTOUT) K DTOUT S AMQQQUIT="" Q
 I X="",AMQQCOMP=";" S AMQQCOMP="0;"_DT Q
 I X="" Q
 I X=U S AMQQQUIT="" Q
 I Y<+AMQQCOMP W "  ??",*7 G COMPD2
 I Y?7N S Y=Y+.235959 ;IHS/OHPRD/JCM 1/27/94
 S AMQQCOMP=AMQQCOMP_Y ;IHS/OHPRD/JCM 1/27/94
 Q
 ;
 ;
COMPS ; ENTRY POINT FROM AMQQAV
 N AMQQSSS
 S X=$P(^AMQQ(1,AMQQLINK,0),U,6)
 I X="",AMQQLINK>1000 S %=$G(^AMQQ(1,AMQQLINK,4,1,1)) S %=$P(%,"S Y=",2) S %=$P(%,""",X=$F") S AMQQSSS=% G COMPSXX
 S Y=+X,Z=$P(X,",",2),AMQQSSS=";"_$P(^DD(Y,Z,0),U,3)
COMPSXX I $D(AMQQXX),$D(AMQQXXVV) S X=AMQQXXVV G COMPSA
 I $D(AMQQXX),$D(AMQQNVAL) S X=AMQQNVAL G COMPSA
COMPSR R !,?(5*$D(AMQQZNM)),"Value: ",X:DTIME E  S AMQQQUIT="" Q
 I X=U S AMQQQUIT="" Q
 I X?1."?" W !,"CHOOSE FROM: " F I=2:1 S A=$P(AMQQSSS,";",I) G:A="" COMPS W !,?7,$P(A,":"),?15,$P(A,":",2)
 I X="" D ACA^AMQQAC
 I X=4 Q
 I X="" W !! K AMQQCOND Q
COMPSA K AMQQCOMP S A=";"_X_":",A=$F(AMQQSSS,A) I A S AMQQCOMP=X W:'$D(AMQQXX) "  ",$P($E(AMQQSSS,A,99),";") Q
 F I=2:1 S A=$P(AMQQSSS,";",I) Q:A=""  S B=$P(A,":",2),C=$P(A,":") I $E(B,1,$L(X))=X S AMQQCOMP=C W:'$D(AMQQXX) $E(B,$L(X)+1,99) Q
 I $D(AMQQCOMP) Q
 D SPEC I $D(AMQQCOMP) Q
 I $D(AMQQXX) Q
 W "  ??",*7 G COMPSR
 Q
 ;
COMPN ; ENTRY POINT FROM AMQQAV
 I AMQQNOCO>1 D COMPN2 Q
 I $D(AMQQXX) G COMPN1
 W !,?(5*$D(AMQQZNM)),"Value: " R X:DTIME E  S AMQQQUIT="" Q
 I X?1."?" W !!,"Enter a number to be used as the comparison value.",!! G COMPN
 I X=U S AMQQQUIT="" Q
 I X="" Q
 I $D(AMQQCCHK),AMQQCCHK'="" X AMQQCCHK G:$D(X) CN W "  ??",*7 G COMPN
COMPN1 I X=+X S AMQQCOMP=X Q
 D SPEC I $D(AMQQCOMP) Q
 I $D(AMQQXX) Q
 W "  ??",*7 G COMPN
CN S AMQQCOMP=X
 Q
 ;
COMPN2 I $D(AMQQXX) N Z S Z=X,X=+X G COMPN21
 R !,?(5*$D(AMQQZNM)),"Enter the lower limiting value: ",X:DTIME E  S AMQQQUIT="" Q
COMPN21 I X="" S AMQQCOMP="" Q
 I X=U S AMQQQUIT="" Q
 I X?1."?" W !,"Enter a number",!!! G COMPN2
 I $D(AMQQCCHK),AMQQCCHK'="" X AMQQCCHK G N:$D(X) W "  ??",*7 G COMPN2
 I X'=+X W "  ??",*7 G COMPN2
N S AMQQCOMP=X_";"
 I $D(AMQQXX) S X=$P(Z,";",2) G N21
N2 R !,?(5*$D(AMQQZNM)),"Enter the upper limiting value: ",X:DTIME E  S AMQQQUIT="" Q
N21 I X="" S AMQQCOMP="" Q
 I X?1."?" W !,"Enter a number",!!! G N2
 I X=U S AMQQQUIT="" Q
 I $D(AMQQCCHK),AMQQCCHK'="" X AMQQCCHK G:$D(X) CN2 W "  ??",*7 G N2
 I X'=+X!(X<+AMQQCOMP) W "  ??",*7 G COMPN2
CN2 S AMQQCOMP=AMQQCOMP_X
 Q
 ;
SPEC I X="*" S X="EXISTS" W "  (List all values)"
 K AMQQCOMP
 S Z="ANY;SAVE;ALL;EXISTS;BLANK;EMPTY;NULL;@" F I=1:1 S %=$P(Z,";",I) Q:%=""  I X=$E(%,1,$L(X)) W $E(%,$L(X)+1,99) S X=% D S1 Q
 Q
 ;
S1 I $D(AMQQMULT) Q
 I I>2,$E(X,1,4)="NOT " S I=$S(I>4:4,1:5)
 S X=$S(I>4:"NULL",I>2:"EXISTS",I=1:"ANY",1:"SAVE")
 I X="ANY" D ANY^AMQQAC
 S AMQQSYMB="'=",AMQQCOMP=";;;"_X
 Q
 ;

AMQQCMP0
AMQQCMP0 ; IHS/OHPRD/JCM - MAKES SEARCH TEMPLATES ; [ 09/18/95 1:34 PM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4,8***;SEP 18, 1993
 ; CALLS TASKMAN
RUN D COHORT
EXIT K AMQQFILE,AMQQBACK,%,%Y,I,K,T,X1,X2,XY
 Q
 ;
COHORT K AMQQFILE D FILE I $D(AMQQQUIT)!('$D(AMQQFILE)) Q
COH1 W ! S DIC("A")="Enter the name of the SEARCH TEMPLATE: "
 S DIC="^DIBT(",DLAYGO=0,DIC(0)="AEQL",DIC("S")="I $P(^(0),U,4)=AMQQFILE"
 D ^DIC
 I Y=-1,X=U S AMQQQUIT="" Q
 I Y=-1 W !,"Cohort not saved...",!! K AMQQCHRT Q
 I '$P(Y,U,3) D CHECK G:Y=-1 COH1 D COVER Q:$D(AMQQQUIT)  I Y=-1 G COH1
COSET K AMQQDIBS S AMQQDIBT=+Y,DA=AMQQDIBT,DIE="^DIBT(",DR="2////"_DT_";3////"_DUZ(0)_";4////"_AMQQFILE_";5////"_DUZ_";10" D ^DIE K DIE,DA,DR,DIC S AMQQH1=$H
 K AMQQBACK D BACK I $D(AMQQBACK) Q
 I $D(AMQQQUIT) Q
 S (IOP,AMQQIOP)=0 D ^%ZIS
 I $E(IOST,1,2)'="P-" W !! D WAIT^DICD
 X AMQV(0)
 D DIBT
 Q
 ;
CHECK ; Check to see if user storing results in a template used in this search 
 N AMQQCNT
 F AMQQCNT=0:1  Q:'$D(AMQV(AMQQCNT))!(Y=-1)  I AMQV(AMQQCNT)[("DIBT("_+Y) W !,*7,"You cannot save results in a search template currently in use by your search!",!,"Please select a different search template." S Y=-1
 Q
 ;
COVER S AMQQDIBS=Y
 W !!,"The "_$P(Y,U,2)_" cohort already exists.  Want to overwrite"
 S %=2 D YN^DICN S:$D(DTOUT) %Y=U K DTOUT
 I %Y=U S AMQQQUIT="" Q
 I "Nn"[$E(%Y) S Y=-1 Q
 I $P(^DIBT(+Y,0),U,5)=DUZ G COVX
 W !!,"Whoops...I just realized you did not create this template, and therefore you",!
 W "are not allowed to overwrite it. (You wouldn't want to destroy someone else's",!
 W "data, would you???)  Try again with a new template name.",!,*7
 S Y=-1 Q
COVX S DIK="^DIBT(",DA=+AMQQDIBS D ^DIK S DIC=DIK,DIC(0)="L",DIADD=1,DINUM=+AMQQDIBS,X=$P(AMQQDIBS,U,2) D ^DIC K DIC,DIADD,AMQQDIBS  S AMQQSAVY=Y,DR=".01",DIE="^DIBT(",DA=+Y D ^DIE K DA,DIE,DR
 S Y=AMQQSAVY K AMQQSAVY
 I '$D(^DIBT(+Y,0)) S Y=-1
 Q
 ;
FILE I AMQQCCLS="V" S AMQQFILE=9000010
 E  I AMQQCCLS="H" S AMQQFILE=6
 E  S AMQQFILE=9000001
 W !!,"Fileman users please note =>",!,"This template will be attached to IHS' ",$S(AMQQFILE=9000001:"PATIENT file (#9000001)",AMQQFILE=9000010:"VISIT file (#9000010)",1:"PROVIDER file (#6)"),!!
 I AMQQFILE=6 W "=> This template can only be used within File Manager.",!
 Q
 ;
DIBT W !!!,"Search template completed...",*7,!!,"This query generates ",AMQQTOT," ""hits""",!
 S AMQQH2=$H,X1=AMQQH1,X2=AMQQH2 D ELT W "Time required to create search template: ",X,!!
 I '$D(ZTQUEUED) R !,"<>",X:DTIME
 K AMQQH1,AMQQH2,AMQQDIBT
 Q
 ;
MAIL ;SEND MAIL MESSAGES TO USERS RE:TEMPLATES
 S XMDUZ=.5,XMTEXT="AMQQMAIL("
 S XMSUB="*** NOTICE OF QMAN SEARCH TEMPLATE COMPLETION ***"
 S AMQQMAIL(1,0)="THE SEARCH TEMPLATE "_$P(^DIBT(AMQQDIBT,0),U)_" IS NOW READY FOR USE"
 S XMY(DUZ)=""
 D ^XMD
 K AMQQMAIL
 Q
 ;
ELT ; ENTRY POINT FROM AMQQCMPP
 S X=(((+X2)-(+X1))*86400)+$P(X2,",",2)-$P(X1,",",2),%=""
 F I=1:1:3 S K=$P("86400^3600^60",U,I),T=$P("DAY^HOUR^MINUTE",U,I),Y=X\K I Y S %=%_Y_" "_T_$S(Y>1:"S, ",1:", "),X=X-(K*Y)
 S %=%_X_" SECOND" I X'=1 S %=%_"S"
 S X=%
 Q
 ;
BACK W !!,"Want to run this task in background" S %=2 D YN^DICN
 S %Y=$S(%=2:"N",%=1:"Y",%=0:"?",%=-1:"^",1:0) ;/IHS/OHPRD/TMJ 9/18/95
 I $D(DTOUT) S %Y=U K DTOUT
 I $E(%Y)=U S AMQQQUIT="" Q
 I "nN"[%Y Q
 I $E(%Y)="?" W !!,?5,"ANSWER 'YES' or 'NO'",! G BACK ;/IHS/OHPRD/TMJ 9/18/95
ZT S AMQQBACK="",ZTRTN="TASK^AMQQCMP0",ZTIO="",ZTDTH="NOW"
 S ZTDESC="QUERY UTILITY GENERATING SEARCH TEMPLATE "
 ;IHS/OHPRD/JCM 3/17/94
 F I=1:1 S %=$P("DT;AMQQ200(;AMQQBACK;AMQQDIBT;DTIME;DUZ(;DUZ;U;AMQV(;AMQQCCLS;^UTILITY(""AMQQ"",$J,""VAR NAME"",;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)=""
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Search template being generated in background",1:"Background job cancelled due to technical problems"),!!!
 H 3
 Q
 ;
TASK X AMQV(1)
 F I=1:1 S %=$P("AMQQ^AMQQ TAX^AMQQ TEMP^AMQQ SER1^AMQQ SAVE",U,I) Q:%=""  K ^UTILITY(%,$J)
 I $D(ZTQUEUED) S ZTREQ="@"
 D MAIL
 Q

AMQQCMP1
AMQQCMP1 ; OHPRD/DG - PRELIMINARY QUERY COMPILE ; [ 02/12/97  9:39 AM ]
 ;;2;PCC QUERY UTILITY;**9**;JAN 11, 1997
 ;Patch 9 fixes an incomplete subject on Fast Facts Language
 I $D(AMQQMULX) D ^AMQQCMPM I $D(AMQQQUIT) G EXIT
VAR S AMQQ="^UTILITY(""AMQQ"",$J,""WEIGHT"")" K AMQQRED
 I AMQQOPT="FAST",'$D(^UTILITY("AMQQ",$J)) S AMQQFAIL=4 D FAIL^AMQQN S AMQQQUIT=1 Q  ;IHS/OHPRD/TMJ Patch #9 5/20/96
 S AMQQLINO=1,AMQQVAR=9,(%,AMQQSER)=$O(@AMQQ@(-9999)),AMQQUATN=$O(@AMQQ@(+%,"")),AMQQTURB=^(AMQQUATN),Q=^UTILITY("AMQQ",$J,"Q",AMQQUATN)
 I $P(Q,U,17)!($P(Q,U,3)="I") S %=$P(Q,U,9),%=$P(%,";",5) I %="NULL"!(%="INVERSE")!(%="ANY") D @("START"_AMQQCCLS) G EXIT
 I Q[";ALL^",$P(Q,U,3)="L" D @("START"_AMQQCCLS) G EXIT
 I $D(AMQQRAND) D @("RAND"_AMQQCCLS) K AMQQRAND G EXIT
 I $D(AMQQCHRT) D @("COH"_AMQQCCLS) K AMQQCHRT G EXIT
 S %=$P(Q,U,9)
 I %[";NULL"!(%[";ANY") D @("START"_AMQQCCLS) G EXIT
 I $D(^UTILITY("AMQQ",$J,"Q",AMQQUATN,1)),$P(^(1),U,2)="NULL" D @("START"_AMQQCCLS) G EXIT
 I %'["EXIST",'$P(Q,U,4),(($P(Q,U,8)["'><")!($P(Q,U,8)["'=")) D @("START"_AMQQCCLS) G EXIT
 I AMQQSER>1 G EXIT
 S %=$P(Q,U,15),%=$P(%,";",4,5) I +%>$P(%,";",2) G EXIT
GT I AMQQTURB["AQ" D @(AMQQTURB_"^AMQQCMPT") G EXIT
 I AMQQTURB S %=$P(Q,U,15),%=$P(%,";",4) I %'["*" D @("TURB"_AMQQTURB_U_$S(AMQQTURB<5:"AMQQCMPT",1:"AMQQCMPZ"))
EXIT S AMQQSER=-9999
 K X,AMQQTURB,Q
 Q
 ;
STARTH S ^UTILITY("AMQQ",$J,"Q",.1)="211^NAME (PROVIDER)^F^^^^^^^^^^^^'=;|||||;;;" G ST1
STARTP S ^UTILITY("AMQQ",$J,"Q",.1)="3^NAME^F^^^^^^^^^^^^'=;|||||;;;" G ST1
NOALPHA ; S AMQV(1)="F AMQP(0)=0:0 S AMQP(0)=$O(^DPT(AMQP(0))) Q:'AMQP(0)  X AMQV(2)",AMQQLINO=2 Q
STARTD S ^UTILITY("AMQQ",$J,"Q",.1)="164^POV NUMBER^N^^^^^^^^^^^^0;999999999;" G ST1
STARTV S ^UTILITY("AMQQ",$J,"Q",.1)="133^DATE OF VISIT^D^^^^^^^^^^^^0;99999999;" G ST1
ST1 S ^UTILITY("AMQQ",$J,"WEIGHT",-99,.1)=""
 Q
 ;
RANDP S ^UTILITY("AMQQ",$J,"Q",.1)="37^RANDOM^R^^^^^^^^^^^1^"_AMQQRAND G RA1
RANDV S ^UTILITY("AMQQ",$J,"Q",.1)="140^RANDOM^R^^^^^^^^^^^1^"_AMQQRAND G RA1
RA1 S ^UTILITY("AMQQ",$J,"WEIGHT",-99,.1)=""
 Q
 ;
COHP S ^UTILITY("AMQQ",$J,"Q",.1)="40^COHORT^C^^^^^^^^^^^1^"_AMQQCHRT G CO1
COHV S ^UTILITY("AMQQ",$J,"Q",.1)="141^COHORT^C^^^^^^^^^^^1^"_AMQQCHRT G CO1
CO1 S ^UTILITY("AMQQ",$J,"WEIGHT",-99,.1)=""
 Q
 ;

AMQQCMP2
AMQQCMP2 ; IHS/OHPRD/JCM - NON "OR" SEARCH CRITERIA COMPILATATION ; [ 04/20/95 8:42 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**7**;JUN 10, 1993
RUN F  S AMQQSER=$O(@AMQQ@(AMQQSER)) Q:AMQQSER=""  F AMQQUATN=0:0 S AMQQUATN=$O(@AMQQ@(AMQQSER,AMQQUATN)) Q:'AMQQUATN  S (Q,AMQQQ)=^UTILITY("AMQQ",$J,"Q",AMQQUATN) D TEMPLATE
 D ^AMQQCMP4,^AMQQCMP6
 I $D(^UTILITY("AMQQ",$J,"SQ",0)) D EN1^AMQQCMP3
 S AMQV(AMQQLINO)="D ^AMQQDO"
 I $D(AMQQFFF) S AMQV(AMQQLINO)="D OUTPUT^AMQQRMFF"
 I $D(AMQQYY(0)) S AMQV(AMQQLINO)="D OUTPUT^AMQQCMPS"
 I '$D(AMQQCNAM),AMQQCCLS="P" S AMQQCNAM="PATIENTS"
 S AMQV(0)="K AMQQQUIT S AMQQTOT=0,AMQQCCLS="""_AMQQCCLS_""",AMQQCNAM="""_AMQQCNAM_""" D LOG^AMQQMGR2 X AMQV(1) D TIME^AMQQMGR2"
EXIT K AMQQ,AMQQCOMP,AMQQFVAR,AMQQHOLD,AMQQINDX,AMQQLINK,AMQQNVAR,AMQQSER,AMQQSF,AMQQVALU,AMQQVAR,%,Y,Z,A,B,C,D,E,I,Q,AMQQZLIN,AMQQZNN,AMQQQ,AMQQUSQN,AMQQI,AMQQIQ
 Q
 ;
TEMPLATE ; ENTRY POINT FROM AMQQCMPK
 S AMQQLINK=+Q,Z="",AMQQNVAR=$P(Q,U,14)
 I $P(Q,U,9)[";NULL",$D(^AMQQ(1,+Q,5)),^(5)'="" S AMQQSBSC=5 G T1
 I $P(Q,U,9)[";ANY",$D(^AMQQ(1,+Q,7)),^(7)'="" S AMQQSBSC=7 G T1
 I $P(Q,U,9)[";INVERSE",$D(^AMQQ(1,+Q,8)),^(8)'="" S AMQQSBSC=8 G T1
 S AMQQSBSC=$S(AMQQLINO>1:2,$D(AMQQKGNO):2,1:1)
 S %=$P(Q,U,11),%=$P(%,":",2) I %=2 S AMQQSBSC=2
 S %=$P(Q,U,9) I %[";NULL"!(%["EXIST")!(%[";INVERSE") S AMQQNVAR=1
T1 F AMQQCSC=AMQQSBSC:.1 Q:'$D(^AMQQ(1,AMQQLINK,AMQQCSC))  I ^(AMQQCSC)'="" S AMQV(AMQQLINO)=^(AMQQCSC) D TSET K AMQQTFLG
 S %=0 F AMQQI=1:1:AMQQNVAR S %=$O(^AMQQ(1,AMQQLINK,4,%)) Q:'%  I '$D(AMQQKGNO) D GROUP I $D(AMQQIQ) K AMQQIQ Q
 S AMQQVAR=AMQQVAR+AMQQNVAR
 I $P(Q,U,17),$P(Q,U,4) S %=$P(Q,U,9),%=$P(%,";",5) I %'="" S AMQV(AMQQLINO-1,%)=""
 I $P(Q,U,3)="I" S %=$P(Q,U,9),%=$P(%,";",5) I %'="" S AMQV(AMQQLINO-1,%)=""
 K AMQQSBSC,AMQQCSC
 Q
 ;
TSET S Y=$P(Q,U,15),X=AMQQLINO K AMQQUSQN
 S %=$P(AMQQQ,U,9),Z="|13|;|14|"
 I $D(AMQQTFLG) K AMQQTFLG S $P(AMQV(X),";",15)=2 ; S AMQV(X)=$P(AMQV(X),"|6|")_"|6|;;;2"_$P(AMQV(X),"|6|",2,9)
 I $P(%,";",5)="NULL",AMQV(X)[Z S AMQV(X)=$P(AMQV(X),Z)_$P(Y,";",4)_"~~"_$P(Y,";",4)_";NULL"_$P(AMQV(X),Z,2,99) G TSET1
 S %=$P(%,";",4)
 I %'="",";SAVE;NULL;EXISTS;ANY;"[(";"_%),AMQV(X)[Z S AMQV(X)=$P(AMQV(X),Z)_$P(Y,";",4)_"~~"_$P(Y,";",5)_";"_%_$P(AMQV(X),Z,2,99)
 I AMQV(X)'["~~",AMQV(X)[Z,$P($P(AMQQQ,U,9),";",6)="NULL" S AMQV(X)=$P(AMQV(X),Z)_$P(Y,";",4)_"~~"_$P(Y,";",5)_";NULL"_$P(AMQV(X),Z,2,99)
TSET1 F I=1:1:10 S Z=$P(Y,";",I) Q:$P(Y,";",I,99)=""  S %="|"_(I+9)_"|" F  Q:AMQV(X)'[%  S AMQV(X)=$P(AMQV(X),%,1)_Z_$P(AMQV(X),%,2,99)
 S %="|20|" F  Q:AMQV(X)'[%  S AMQV(X)=$P(AMQV(X),%)_X_$P(AMQV(X),%,2,99)
 S %="|23|",A=$P(Q,U,8),B=(A'="'="&(A'="'><")) F  Q:AMQV(X)'[%  S AMQV(X)=$P(AMQV(X),%)_$S(B:"*",1:"+")_$P(AMQV(X),%,2,99)
 I '$D(AMQQKGNO) S %="|30|",AMQV(X)=$P(AMQV(X),%)_"X:AMQT("_X_") AMQV("_(X+1)_")"
 S %="|7|",Z=$P(Q,U,14) S:Z="" Z=1 F  Q:AMQV(X)'[%  S AMQV(X)=$P(AMQV(X),%)_Z_$P(AMQV(X),%,2,99)
 S %=AMQV(X),A="|6|",B="|5|" F I=1:1 Q:%'[A  D CKER
 S AMQV(X)=%
 I $D(AMQQMULL),AMQQMULL=AMQQUATN,%["AMQQX=" D ADDMULL
 I $D(^UTILITY("AMQQ",$J,"SQXQ",AMQQUATN)),%["AMQQX=" S AMQQUSQN=$O(^(AMQQUATN,"")) D ^AMQQCMP3
 S AMQQLINO=AMQQLINO+1,Q=AMQQQ
 K A,B,C,D,E,%
 Q
 ;
CKER S C=$P(%,A),D=$P(%,A,2),E=$E(%,4+$L(C)+$L(D),255)
 F  Q:D'[B  S D=$P(D,B)_(AMQQVAR+I)_$P(D,B,2,99)
 S %=C_(AMQQVAR+I)_D_E
 Q
 ;
GROUP I +Q=33,Q[";;;NULL" Q
 I +Q=133 Q
 N X,Z
 S X=AMQQLINK_U_%
 I AMQQI=1,'$P(Q,U,17),$D(^AMQQ(1,+X,4,1,0)),$P(^(0),U,8) S $P(X,U,4)=+$P(Q,U,14)
 I $P(Q,U,17) S Z=$P(Q,U,9),Z=$P(Z,";",5) I Z'="",Z'=+Z S $P(X,U,5)=Z
 I AMQQI=1,$D(AMQQRED) S:$P(AMQQRED,U,3) AMQQRED=$P(AMQQRED,U,1,2),AMQQIQ="" S X=X_U_AMQQRED
 S ^UTILITY("AMQQ",$J,"VAR NAME",AMQQVAR+AMQQI)=X
 K AMQQRED
 Q
 ;
ADDMULL N X,Y,Z,% S %=AMQV(AMQQLINO)
 S X=$P(%,"AMQQX="),Y=$P(%,"AMQQX=",2),Z=$P(Y,""" D ^AMQQ",2),Y=$P(Y,""" D ^AMQQ")
 I X["S AMQQB=" S $P(Y,";",8)=AMQQMULL ;IHS/OHPRD/TMJ 4/20/95
 S $P(Y,";",18)=AMQQMULL,AMQV(AMQQLINO)=X_"AMQQX="_Y_""" D ^AMQQ"_Z
 K AMQQMULL
 Q
 ;

AMQQCMPL
AMQQCMPL ; IHS/OHPRD/JCM - SETS SEARCH CODE ; [ 07/18/94 7:28 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4,5**;JUN 10, 1993
 K AMQQKGNO,AMQQUSQN,AMQQUQQN,AMQQSQAA,AMQQUSQL,AMQQXSQF S AMQQTOT=0
 I '$D(AMQQNOET) S X="ERR^AMQQCMPL",@^%ZOSF("TRAP")
 I $D(^UTILITY("AMQQ OR",$J)) D ^AMQQCMPK
 I $D(AMQQXX) D ^AMQQCMP1 G:$D(AMQQQUIT) EXIT D ^AMQQCMP2,@AMQV("OPTION") G EXIT
RUN K AMQQRERF,AMQQQUIT D OUT^AMQQOPT
 I $D(AMQQQUIT) G EXIT
 I '$D(AMQQCPLF) D ^AMQQCMP1 G:$D(AMQQQUIT) EXIT D ^AMQQCMP2
DOIT ; ENTRY POINT FROM AMQQQE1
 D @AMQV("OPTION")
 I $D(AMQQCPLF)!$D(AMQQQUIT),$G(AMQV("OPTION"))'="LIST" G RUN
EXIT K Q,AMQQHOLD,AMQQLINO,AMQQFVAR,AMQQVALU,AMQQVSIT,AMQQTOT,AMQQSF,AMQQAG,AMQT,AMQP,X,X1,X2,N,G,AMQQCPLF,AMQQMULL,AMQQMUNV,AMQQMUFV,AMQQOV,AMQQXX,AMQQDIBT,AMQQSQFN,AMQQSQ1,AMQQAFNN,%,%Y,AMQQFFF,AMQQ("BP COHORT FLG") ;IHS/OHPRD/JCM 7/15/94
 Q
 ;
LIST ; ENTRY POINT FROM AMQQCMP0
 I $D(AMQQYY(0)) X AMQV(0) Q
 I '$D(AMQQXX),$E(IOST,1,2)'="P-",AMQV("OPTION")'="COUNT" W !! D WAIT^DICD I $G(AMQQCCLS)="P" W !!!,"Please note:  Patients whose names are marked with an ""*"" may have aliases.",!!! H 2
 D PRINT^AMQQSEC E  W !!,*7,"Not a secure device!",!! H 2 W @IOF Q
 X AMQV(0)
LISTEND ; ENTRY POINT FROM AMQQQE1
 K AMQQCPLF
 I $D(AMQQQUIT) Q
 I $E(IOST,1,2)'="P-" W !,"Total: ",+$G(AMQQTOT) S DIR(0)="E" D ^DIR K DUOUT,DTOUT,DIRUT,DIR Q
 W @IOF,@IOF D ^%ZISC
 Q
 ;
COHORT I '$D(AMQQNOET),$D(^%ZOSF("TRAP")) S X="ERRC^AMQQCMPL",@^%ZOSF("TRAP")
 I $D(AMQQEN31) D ^AMQQCMPC Q
 D ^AMQQCMP0
 Q
 ;
PRINT D ^AMQQCMPP
 K AMQQCPLF
 Q
 ;
COUNT D COUNT^AMQQCMPP
 K AMQQCPLF
 Q
 ;
SAVE D ^AMQQCMPS
 Q
 ;
OUTPUT ; ENTRY POINT FROM AMQQENQ
 D OUT^AMQQOPT I $D(AMQQQUIT) Q
 D @AMQV("OPTION")
 Q
 ;
ERRC I $D(AMQQDIBT) K ^DIBT(AMQQDIBT,1)
ERR I '$D(AMQQNOET) X "I $P($ZE,"">"")=""<INRPT""!($ZE[""-CTRAP"")" I  D ^%ZISC W !!,"Session terminated...",!! H 2 S AMQQQUIT="" D EXIT S AMQQQUIT="" Q  ;IHS/OHPRD/JCM 1/13/94
 I $E(IOST,1,2)="C-" W !!,"ERROR DETECTED...SESSION ABORTED...SUSPECT MISSING DATA...NOTIFY SITE MANAGER",!!,*7 H 3 D ^%ZISC,@^%ZOSF("ERRTN")
 I $E(IOST,1,2)'="C-" D ^%ZISC
 D EXIT,EXIT^AMQQ Q
 Q
 ;
STORE D STORE^AMQQQE I $D(AMQQQUIT) Q
 D ^AMQQCMPS
 S AMQQCPLF="" K AMQV("OPTION")
 Q
 ;
MAIL D MAILX^AMQQRML Q
AGE D BUCKET^AMQQRMA Q
WORK D WORK^AMQQRMD Q
MONTH D MON^AMQQRMM Q
TIME D TIME^AMQQRMT Q
HSUM D HSUM^AMQQRMH Q
EMAN D ^AMQQEMAN Q  ; &&& NEW DATA EXPORT MANAGER

AMQQCMPM
AMQQCMPM ; IHS/OHPRD/JCM - RESOLVES DISPLAY OF MULTIPLE MULTIPLES ; [ 09/19/95 10:08 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**7,8**;SEP 5, 1995
MM N N,X,Y,Z,%,DIC,A,B,I
 D ALL I $D(AMQQQUIT) G EXIT
 F I=1:1:($L(AMQQMULX,U)-2) S N=$P(AMQQMULX,U,I) D MM1
EXIT K AMQQMULX
 Q
 ;
MM1 I $D(^UTILITY("AMQQ",$J,"Q",N))=1 S %=$P(^UTILITY("AMQQ",$J,"Q",N),U,9),$P(^(N),U,14)=1 Q:%["NULL"!(%["INVERSE")  S $P(%,";",4)="EXISTS",$P(^(N),U,9)=% Q
 F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"Q",N,%)) Q:'%  S Z=%
 S ^UTILITY("AMQQ",$J,"Q",N,Z+1)=Y_"^U^EXIST^AMQQF^3^^0^0",$P(^UTILITY("AMQQ",$J,"Q",N),U,14)=1
 Q
 ;
ALL S %=$L(AMQQMULX,U),%=$P(AMQQMULX,U,%-1),AMQQMULN=%,AMQQOBJ=$P(^UTILITY("AMQQ",$J,"Q",%),U,2),AMQQOBJS=AMQQOBJ_$S($E(AMQQOBJ,$L(AMQQOBJ))?1P!($E(AMQQOBJ,$L(AMQQOBJ))="S"):"",1:"S"),AMQQMULL=AMQQMULN
 I AMQQCCLS="V" G ALLEXIT
 F %="NULL","INVERSE" I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,9)[% D SPEC G ALLEXIT ;/IHS/OHPRD/TMJ 9/5/95
 I $D(AMQQXX) S X=$S($D(AMQQXX("FORMAT")):AMQQXX("FORMAT"),1:2) G X1
 S %=$G(AMQV("OPTION")) S %=$S(%="MAIL":2,%="HSUM":2,%="WORK":1,%="WORK":1,%="TIME":1,%="MONTH":1,1:0) I % S X=% G @("X"_X)
 I $D(^UTILITY("AMQQ",$J,"SQXQ",AMQQMULN)) S Z=$O(^(AMQQMULN,"")) I Z F %="NULL","ALL","EXISTS","ANY","INVERSE" I $D(^UTILITY("AMQQ",$J,"SQ",Z,%)) S X=2 S:Z'="ALL"&(Z'="ANY") $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,14)=1 G ALLEXIT
 I $D(^UTILITY("AMQQ",$J,"Q",AMQQMULN,1)),$P(^(1),U,2)="NULL" G ALLEXIT
 I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,9)["ANY" G ALLEXIT
 I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,3)="I" S %=$P(^(AMQQMULN),U,9) I $P(%,";",5)=2 G ALLEXIT
 S %=$P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,13) I %,%'=4 G ALLEXIT
 S X=+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULN)) I X,$D(^AMQQ(1,X,9)),$P(^(9),U)'="" S AMQQN=^(9) D MULT G ALLEXIT
 I $D(AMQQONE) S X=1 G X1
 I AMQV("OPTION")="COHORT" S X=2 G X2
 S A="@AMQQRV,""PATIENTS"",@AMQQNV",B="@AMQQRV,"""_AMQQOBJS_""",@AMQQNV"
 S %="list" I $G(AMQV("OPTION"))="COUNT" S %="count"
 W !!,"You have 2 options for ",%,"ing ",AMQQOBJS," =>",!
 W !?5,"1) For ea. patient, ",%," all ",@B," which match your",!?8,"criteria"
 W !?5,"2) ",$S(AMQV("OPTION")="COUNT":"Count",1:"List")," all ",@A," with ",AMQQOBJS," meeting your criteria,",!?8,"but do not ",%," the individual values of ea. ",AMQQOBJ,!
ALLQ W !,"Your choice (1 or 2): 1// " R X:DTIME E  S X=U
 I $E(X)=U S AMQQQUIT="" G ALLEXIT
 I X="" S X=1 W " (1)"
 I X?1."?" D HELP G ALL
X1 I X=1 D:$D(^UTILITY("AMQQ",$J,"Q",AMQQMULN)) X11 G ALLEXIT
X2 I X=2 S AMQQMULX=AMQQMULX_AMQQMULN_U G ALLEXIT
 W "  ??",*7 G ALLQ
ALLEXIT K AMQQMULN,AMQQOBJ,AMQQOBJS,A,B,AMQQN,AMQQNO3
 Q
 ;
CD W !!,"You have 2 options for counting ",AMQQN(1)," =>",!
 W !?5,"1) Count all specified ",AMQQN(2)," for all patients"
 S AMQQI=0 F  S AMQQI=$O(^UTILITY("AMQQ",$J,"LIST",AMQQI)) Q:'AMQQI!($D(AMQQSTP))  I ^(AMQQI)[$E(AMQQN(1),1,($L(AMQQN(1))-2)) S:$D(AMQQHIT) AMQQSTP="" S AMQQHIT=""
 W !?5,"2) Count PATIENTS with at least one of the ",$S('$D(AMQQSTP):AMQQN(1),1:AMQQN(1)_" in each query"),!,?7," you specified",!
 K AMQQSTP,AMQQHIT
CDQ W !,"Your choice (1-2): 1// " R X:DTIME E  S X=U
 I X=2 S X=3 Q
 I X="" Q
 I X=1 Q
 I X?1."?" D HELP G CD
 I $E(X)=U Q
 W "  ??",*7 G CDQ
 ;
HELP N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQLIST","")) D EN1^XQH
 Q
 ;
MULT F I=1:1:3 S AMQQN(I)=$P(AMQQN,U,I)
 I AMQV("OPTION")="COHORT" S X=3 G X3
 S %=$P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,15),%=$P(%,";",4)
 I %,$D(^UTILITY("AMQQ TAX",$J,%,"--"))!$D(^UTILITY("AMQQ TAX",$J,%,"-")) Q
 I AMQV("OPTION")="COUNT" D CD G DXQA
 I $D(AMQQONE) S X=2 G DXQA
 W !!,"You have ",$S('$D(AMQQNO3):3,1:2)," options for listing ",AMQQN(1)," =>",!
 W !?5,"1) List every ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",1:AMQQN(2))," meeting search criteria." ;IHS/OHPRD/TMJ 3/8/95
 W !?5,"2) List every ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",1:AMQQN(2))," and ",AMQQN(3)," meeting search criteria." I $D(AMQQNO3) W ! ;IHS/OHPRD/TMJ 3/8/95
 I '$D(AMQQNO3) W !?5,"3) List all PATIENTS with ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",1:AMQQN(2))," you specified, but DO NOT list",!?8,"individual ",AMQQN(2)," or ",AMQQN(3)," (FASTEST OPTION!!)",! ;IHS/OHPRD/TMJ 3/8/95
 W ?8,"(Displays UNDUPLICATED list of PATIENTS)",!
DXQ W !,"Your choice (1-",(3-$D(AMQQNO3)),"): 1// " R X:DTIME E  S X=U
DXQA I $E(X)=U S AMQQQUIT="" G DXEXIT
 I X="" S X=1 W " (1)"
 I X?1."?" D HELP G MULT
DXQA1 I X=2 S %=+^UTILITY("AMQQ",$J,"Q",AMQQMULN) D  Q
 .I %>999 D EXP Q
 .S:$D(^AMQQ(1,%+.1)) $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,1)=%+.1 S $P(^(AMQQMULN),U,18)=1,$P(^(AMQQMULN),U,14)=3
 .Q
X11 I X=1 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=1,$P(^(AMQQMULN),U,14)=2 Q
X3 I '$D(AMQQNO3),X=3 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=2,AMQQMULX=AMQQMULX_AMQQMULN_U Q
 W " ??",*7 G DXQ
DXEXIT K X
 Q
 ;
SPEC I $G(AMQV("OPTION"))'="COHORT",%="ALL"!(%="ANY"),$D(^AMQQ(1,+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULN)),9)) S:%="ANY" AMQQNO3="" S AMQQN=^(9) D MULT Q
 S X=2-((%="ALL")!(%="ANY")) D DXQA1
 Q
 ;
EXP ; EXPANDED LAB OUTPUT
 N X,Y,Z
 S $P(^AMQQ(1,%,4,1,0),U,5,6)="30^30",^(1)="D EXP^AMQQDO"
 Q
 ;

AMQQCMPP
AMQQCMPP ; IHS/OHPRD/JCM - MANAGES PRINTED REPORTS ; [ 08/02/94 8:07 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4,5**;JUN 10, 1993
 ; CALLS TASKMAN
RUN N AMQQRV,AMQQNV,AMQQXV S (AMQQRV,AMQQNV)="AMQQXV",AMQQXV=""
 I '$D(AMQQFFF) D SUP I $D(AMQQQUIT) Q
 I $D(^XUSEC("AMQQZRPT",DUZ)) S DIR("A")="Enter name of person requesting report",DIR(0)="P^200:AQEM",DIR("B")=$P(@AMQQ200(3)@(DUZ,0),U) D ^DIR S:Y>0 AMQQUSR=+Y K Y,DIRUT,DUOUT,DTOUT,DIR I '$D(AMQQUSR) S AMQQQUIT=1 Q  ;VA/SLC ISC/GIS 8/2/94
 D DEV I $D(AMQQQUIT) Q
 I '$D(IO("Q")) U IO D TASK D ^%ZISC G EXIT
 S ZTRTN="TASK^AMQQCMPP",ZTIO=ION,ZTDTH="NOW"
 S ZTDESC="QUERY UTILITY REPORT"
 ;IHS/OHPRD/JCM 3/17/94
QUEUE F I=1:1 S %=$P("AMQV(;AMQQ200(;AMQQRV;AMQQSUPF;AMQQNV;AMQQFFF;AMQQXV;AMQQUSR;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)=""
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3
EXIT K X,Y,%,AMQQSUPF,I,AMQQUSR
 W @IOF
 Q
 ;
DEV W ! S %ZIS="QM",%ZIS("B")="" D ^%ZIS S AMQQIOP=IO
 I POP S AMQQQUIT="" Q
 D PRINT^AMQQSEC E  W "  <= Not a secure device!!",*7 G DEV
 I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G DEV
 Q
 ;
TASK I '$D(AMQQFFF) D COVER I $D(AMQQQUIT) Q
 X AMQV(0)
 I '$D(AMQQFFF) W !,"Total: ",+$G(AMQQTOT)
 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR,DUOUT,DTOUT,DIRUT
 W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 Q
 ;
COVER ; - EP -
 S %="",$P(%,"*",79)="" W !!!!,%,! K AMQQQUIT
 W "**   WARNING...The following report may contain CONFIDENTIAL PATIENT DATA.  **"
 W !,"** You are accountable for keeping the report in a SECURE AREA at all times.**"
 W !,"**            SHRED the report as soon as it is no longer needed.           **"
 W !,"**            PRIVACY ACT violators are subject to a $5000 fine!            **"
 W !,%
CV1 S %=$P(@AMQQ200(3)@(DUZ,0),U),%=$P(%,",",2,9)_" "_$P(%,",") D
 . W !!,"This report ",$S('$D(AMQQUSR)!($G(AMQQUSR)=DUZ):"requested",1:"printed")," by ",% I $D(AMQQUSR),AMQQUSR'=DUZ S %=$P(@AMQQ200(3)@(AMQQUSR,0),U),%=$P(%,",",2,9)_" "_$P(%,",") W " and requested by ",% ;VA/SLC ISC/GIS 11/24/93
 W !,"Date of report: " S Y=DT X ^DD("DD") W Y
 W !!
 F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"LIST",%)) Q:'%  W ! X ^(%)
 I $E(IOST,1,2)="C-" W !! S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)+$D(DTOUT) K DUOUT,DTOUT,DIRUT S AMQQQUIT=""
 Q
 ;
COUNT ; ENTRY POINT FROM AMQQCMPL
 N AMQQRV,AMQQNV,AMQQXV S (AMQQRV,AMQQNV)="AMQQXV",AMQQXV=""
 D DEV I $D(AMQQQUIT) Q
 I '$D(IO("Q")) U IO D TASKC D ^%ZISC Q
 S ZTRTN="TASKC^AMQQCMPP",ZTIO=ION,ZTDTH="NOW",ZTDESC="Q-MAN COUNT"
 D QUEUE
 Q
 ;
TASKC S AMQQH1=$H
 I $E(IOST,1,2)'="P-" W !!!!,"COUNTING....",!
 E  W !!!! D CV1 W !!!
 X AMQV(0)
 I $E(IOST,1,2)="C-" W *13,?9,*13
 W "Total: ",+$G(AMQQTOT)
 S X1=AMQQH1,X2=$H D ELT^AMQQCMP0 W !,"Search time: ",X
 I $E(IOST,1,2)="C-" W !!! S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT,DTOUT
 K AMQQH1,X1,X2
 W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 Q
 ;
SUP W !!,"Want to suppress patient names and only print the chart no."
 S %=2 D YN^DICN
 I %Y=U S AMQQQUIT="" K %Y Q
 I $D(DUOUT)+$D(DTOUT) K DTOUT,DUOUT S AMQQQUIT="" Q
 I "Nn"[$E(%Y) K %Y Q
 S AMQQSUPF="" K %Y
 Q
 ;

AMQQCMPT
AMQQCMPT ; IHS/OHPRD/JCM - COMPILES TURBO CODE FOR "AQ" XREF ; [ 10/02/95 3:46 PM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**8**;SEP 5, 1993
TURB3 ; ENTRY POINT FROM AMQQCMP1
TURB1 ; ENTRY POINT FROM AMQQCMP1
 S %=$P(^AMQQ(1,+Q,0),U,15) ; S Z=$P(^UTILITY("AMQQ",$J,"Q",1),U,15) ; S Z=$S($P(Z,";",4)=$P(Z,";",5):"-.00000001)",1:")")
 S C=$P(Q,U,15),A=$P(C,";",4),B=$P(C,";",5) S:A=B A=A-.000001
 S A=$E("00000",1,3-$L(A\1))_A,B=$E("00000",1,3-$L(B\1))_B
 S AMQV(1)="S AMQP(.1)="""_%_A_""",AMQP(.11)="""_%_B_""" X AMQV(2)" D TSET
 S AMQV(2)="F  S %=$O(^AUPNVMSR(""AQ"",AMQP(.1))) S:((%="""")!(%]AMQP(.11))) %=""ZZ999"" K:"""_%_"""'=$E(%,1,"_$L(%)_") ^UTILITY(""AMQQ TEMP"",$J) Q:"""_%_"""'=$E(%,1,"_$L(%)_")  S AMQP(.1)=% X AMQV(3)"
 S AMQV(3)="F AMQP(.2)=0:0 Q:"""_%_"""'=$E(AMQP(.1),1,"_$L(%)_")  S AMQP(.2)=$O(^AUPNVMSR(""AQ"",AMQP(.1),AMQP(.2))) Q:'AMQP(.2)  S %=$P(^AUPNVMSR(AMQP(.2),0),U,2) I '$D(^UTILITY(""AMQQ TEMP"",$J,%)) S ^(%)="""",AMQP(0)=% X AMQV(4)"
 S AMQQLINO=4,AMQQTFLG="" D KILL
 Q
 ;
TURB2 ; ENTRY POINT FROM AMQQCMP1
 S AMQV(1)="F AMQP(2)=|10|:0 S AMQP(2)=$O(^AUPNVSIT(""B"",AMQP(2))) K:'AMQP(2)!(AMQP(2)>|11|) ^UTILITY(""AMQQ TEMP"",$J) Q:'AMQP(2)!(AMQP(2)>|11|)  X AMQV(2)" D TSET
 S AMQV(2)="F AMQP(1)=0:0 S AMQP(1)=$O(^AUPNVSIT(""B"",AMQP(2),AMQP(1))) Q:'AMQP(1)  I '$P(^AUPNVSIT(AMQP(1),0),U,11) S %=$P(^(0),U,5) I '$D(^UTILITY(""AMQQ TEMP"",$J,%)) S ^(%)="""",AMQP(0)=% I $D(^DPT(%,0)) X AMQV(3)" ; IHS/OHPRD/TMJ 8/10/95
 S AMQQLINO=3 D KILL
 Q
 ;
TURB4 ; ENTRY POINT FROM AMQQCMP1
 I +Q=168 S X="BPS",Y="BPD"
 I +Q=170 S X="VCR",Y="VCL"
 I +Q=171 S X="VUR",Y="VUL"
 S AMQV(1)="S AMQP(.11)="""_X_"|13|"",AMQP(.12)="""_X_"|14|"",AMQP(.13)="""_Y_"|18|"",AMQP(.14)="""_Y_"|19|"",AMQP(0)=0,AMQP(.1)=AMQP(.11),AMQP(.3)=""^UTILITY(""""AMQQ TEMP"""",$J)"" X AMQV(2)" D TSET
 S AMQV(2)="F  K:AMQP(0)=99999999999 @AMQP(.3) Q:AMQP(0)=99999999999  S AMQP(.1)=$O(^AUPNVMSR(""AQ"",AMQP(.1))) X AMQV(3)"
 S AMQV(3)="S:AMQP(.1)]AMQP(.12) AMQP(.1)="""" S:AMQP(.1)=""""&(AMQP(.12)["""_X_""") AMQP(.1)=AMQP(.13),AMQP(.12)=AMQP(.14) S:AMQP(.1)="""" AMQP(0)=99999999999 X:AMQP(.1)'="""" AMQV(4)"
 S AMQV(4)="F AMQP(.2)=0:0 Q:AMQP(0)=99999999999  S AMQP(.2)=$O(^AUPNVMSR(""AQ"",AMQP(.1),AMQP(.2))) Q:'AMQP(.2)  X AMQV(5)"
 S AMQV(5)="I $D(^AUPNVMSR(AMQP(.2),0)) S AMQP(0)=$P(^(0),U,2) I AMQP(0),'$D(@AMQP(.3)@(AMQP(0))) S ^(AMQP(0))="""" I $D(^DPT(AMQP(0))) X AMQV(6)"
 S AMQQLINO=6 D KILL
 Q
 ;
TSET N % S Y=$P(Q,U,15)
 F I=1,2,4,5,9,10 S Z=$P(Y,";",I) S:Z<0 Z=0 S:I>2 Z=$E("000",1,3-$L($P(Z,".")))_Z Q:$P(Y,";",I,99)=""  S %="|"_(I+9)_"|" F  Q:AMQV(1)'[%  S AMQV(1)=$P(AMQV(1),%,1)_Z_$P(AMQV(1),%,2,99)
 Q
 ;
AQ1 ; ENTRY POINT FROM AMQQCMPP
AQ2 ; ENTRY POINT FROM AMQQCMPP
 S %=$P(Q,U,15),X=$P(%,";",2),%=+%
 S X=X+1,%=%+1
 I '% S %=.5
 S AMQQLINO=3
 S AMQV(1)="S AMQP(0)=0,AMQP(""V1"")="_%_" F  Q:AMQP(0)=99999999999  S AMQP(""V1"")=$O(^AUPNPAT("""_AMQQTURB_""",AMQP(""V1""))) Q:AMQP(""V1"")=""""  Q:AMQP(""V1"")>"_X_"  X AMQV(2)"
 S AMQV(2)="F AMQP(""V2"")=0:0 Q:AMQP(0)=99999999999  S (%,AMQP(""V2""))=$O(^AUPNPAT("""_AMQQTURB_""",AMQP(""V1""),AMQP(""V2""))) Q:'AMQP(""V2"")  I '$D(^UTILITY(""AMQQ TEMP"",$J,%)) S ^(%)="""",AMQP(0)=% X AMQV(3)"
 D KILL
 Q
 ;
KILL K %,A,B,C,I,Q,X,Y,Z
 Q
 ;

AMQQDFN
AMQQDFN ; IHS/OHPRD/JCM - CHECK TO SEE IF ANY ^AUTT FILE DFNS HAVE CHANGED ; [ 08/08/1999  10:39 AM ]
 ;;2;PCC QUERY UTILITY;*8,10,15*;MAR 11, 1997
EN ; ENTRY POINT
 N %,A,B,C,I,X,Y,Z,DFN,%Z
 S U="^"
 I '$D(AMQQXX) W !,"Qman is now waking up "
 F X=0:0 S X=$O(^AMQQ(5,X)) Q:'X  S Y=^(X,0),Z=$P(Y,U,12) I Z'="" W:'$D(AMQQXX) "." D G1
 Q
 ;
G1 S (%,B)=$P(Y,U,5),%=$G(^AMQQ(1,%,2))
 I %="" Q
 I %["AUPNVXAM" S %=$P(%,";",2) G G11
 S A="AUPNV"_$P(Z,";")_";",%=+$P(%,A,2)
G11 S %Z=$P(Z,";",2),Z="^AUTT"_$P(Z,";")_"(""C"","""_$P(Z,";",2)_""","""")"
 S Z=$O(@Z)
 I Z,Z=% Q
 I 'Z Q
 S DFN=%
 D RESET
 Q
 ;
RESET ;
 S $P(^AMQQ(1,B,0),U,11)=Z I Z S $P(^(0),U,15)=Z
 S A=^AMQQ(1,B,1) I A'["IMM" S C=" I $D(^(AMQP(0)," S %=$P(A,C,2),%="))"_$P(%,"))",2,999),%=Z_%,A=$P(A,C)_C_%,^AMQQ(1,B,1)=A
 F I=1,2 S A=^AMQQ(1,B,I),C=$P(^AMQQ(5,X,0),U,12),C=$P(C,";") S:C="EXAM" C="XAM" S C="AUPNV"_C_";",%=$P(A,C,2),%=Z_";"_$P(%,";",2,999),A=$P(A,C)_C_%,^AMQQ(1,B,I)=A
 I A["IMM",'$D(^AUTTIMM(101,0)) D IMM ;IHS/CMI/THL - PATCH 15
 Q
 ;
IMM ; Check compound immunization links to see if need to change a dfn
 NEW %A,%B,%C,%D,%E,%F,%I,%LINK
 F %I=1:1 S %A=$P($T(IMMUN+%I),";;",2) Q:%A=""  D  ;IHS/OHPRD/TMJ Patch #10 3/11/97
 . S %C=$P(%A,U) F I=1:1 S %D=$P(%C,":",I) Q:%D=""  I %D=%Z S %LINK=$P(%A,U,2) D  Q
 ..  F I=1,2 S A=^AMQQ(1,%LINK,I),C="AUPNVIMM;",%=$P(A,C,2),%C=$P(%,";") D  S %=%C_";"_$P(%,";",2,999),A=$P(A,C)_C_%,^AMQQ(1,%LINK,I)=A
 ... F %E=1:1 S %F=$P(%C,":",%E)  Q:%F=""  I %F=DFN S $P(%C,":",%E)=Z
 Q
 ;
IMMUN ; Table of Compound Immunizations - IHS CODE:IHS CODE^QMAN LINK ENTRY ; IHS/OHPRD/TMJ 12/11/95
 ;;02:03:04:34:42^180
 ;;02:04^186
 ;;03:04:34:42^185
 ;;15:17^199
 ;;14:17:18^198
 ;;35:37:38:39^306
 ;;11:17:18^197

AMQQDO
AMQQDO ; OHPRD/DG - GENERATE OUTPUT ;9/9/93  3:35 PM [ 04/22/1999   9:34 AM ]
 ;;2;PCC QUERY UTILITY;**1,2,3,4,6,14**;JUN 10, 1993
 ;IHS/CMI/LAB - PATCH 13 added +
 ; SPECIAL AMQP VARIABLES: AMQP(0)=PATIENT #, AMQP(1)=VISIT #, AMQP(2)=VISIT DATE, AMQP(3)=V POV #, AMQP(4)= V MED #, AMQP(5) = PROVIDER #, AMQP(6)=V PROCEDURE # ;IHS/OHPRD/JCM 3/11/94
 S AMQQOV=$S(AMQQCCLS="P":0,AMQQCCLS="D":3,AMQQCCLS="H":5,1:1)
 I $D(AMQQBACK),$D(AMQQDIBT) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))="" Q
 I $D(AMQQEN3),$D(AMQQDIBT),$D(AMQQND) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))="" W "." Q  ;IHS/OHPRD/JCM 10/6/94
 I '$D(AMQQLABB) S AMQQLABB="" I $D(DUZ(2)),$D(^AUTTLOC(DUZ(2),0)) S AMQQLABB=$E($P(^(0),U,2),1,6)
 I $G(AMQQMULL),$D(^UTILITY("AMQQ",$J,"AG",AMQQMULL)) D MULT G EXIT
 D DISPLAY
EXIT K AMQQSVAR,AMQQOV,^UTILITY("AMQQ",$J,"AG"),AMQQLDFN,%,A,I,J,Z,W,X,Y
 Q
 ;
MULT ; ENTRY POINT FROM AMQQCMPS
 F AMQQHOLD=0:0 S AMQQHOLD=$O(^UTILITY("AMQQ",$J,"AG",AMQQMULL,AMQQHOLD)) Q:'AMQQHOLD  S %=^(AMQQHOLD) D M1 I AMQP(AMQQOV)=99999999999 Q
 K ^UTILITY("AMQQ",$J,"AG",AMQQMULL)
 Q
 ;
M1 ;S X=AMQQMUFV-1 F I=1:1:AMQQMUNV S X=$O(^UTILITY("AMQQ",$J,"VAR NAME",X)) Q:'X  I X<(AMQQMUFV+2) S Y=^(X),A=$P(Y,U,2) I A S AMQP(X)=$P(%,U,A) ;IHS/OHPRD/JCM 11/4/93
 S Z=(AMQQMUFV+AMQQMUNV-1) F X=AMQQMUFV:1:Z I $D(^UTILITY("AMQQ",$J,"VAR NAME",X)) S Y=^(X),A=$P(Y,U,2) I A S AMQP(X)=$P(%,U,A) ;IHS/OHPRD/JCM 11/19/93
 I $D(AMQQYY(0)) Q
 I 'AMQQOV,'$D(^DPT(AMQP(0),0)) W !,"BAD POINTER FOR PATIENT NUMBER ",AMQP(AMQQOV) Q
 D DISPLAY
 Q
 ;
DISPLAY S:'$D(AMQQTOT) AMQQTOT=0 S AMQQTOT=AMQQTOT+1
 I $D(AMQQRMFL) D @AMQQRMFL Q
 I $D(AMQV("OPTION")),AMQV("OPTION")="COUNT" W:$E(IOST,1,2)'="P-" *13,AMQQTOT Q
 I $D(AMQQDIBT) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))=""
 I AMQQTOT#(IOSL-6-(5*($E(IOST,1,2)="P-")))=1 D ^AMQQDOH I AMQP(AMQQOV)=99999999999 Q
 I AMQQCCLS="D" D DD Q
 I AMQQCCLS="H" D DH Q
 I AMQQCCLS="V" D DV Q
 I $P($G(^DPT(AMQP(AMQQOV),0)),U)="" W !,"MISSING DATA FOR """_$S($G(AMQP(.1))'="":AMQP(.1),1:("#"_AMQP(AMQQOV)))_""".  HAVE SITE MANAGER CHECK ""B"" INDEX!" S AMQQTOT=AMQQTOT-1 Q
 S %=$E($P(^DPT(AMQP(0),0),U),1,16) I $D(^DPT(AMQP(0),.01,1)) S %=$E(%,1,15)_"*"
 I $D(AMQQSUPF) S %="*****"
 W !,%," "
 I $D(DUZ(2)),$D(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0)) W ?17,$P(^(0),U,2)
DIS S J=$$CHKVA(24) F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I  I $D(AMQP(I)) D FORMAT ;IHS/OHPRD/JCM 9/13/93
 Q
 ;
DV S Y=+^AUPNVSIT(AMQP(1),0) X ^DD("DD") W !,AMQP(1),?9,Y
 S J=$$CHKVA(29) F I=9:0 S I=$O(AMQP(I)) Q:'I  I $D(^UTILITY("AMQQ",$J,"VAR NAME",I)) D FORMAT ;IHS/OHPRD/JCM 9/13/93
 Q
 ;
DD W !,AMQP(3) S J=9 F I=9:0 S I=$O(AMQP(I)) Q:'I  I $D(^UTILITY("AMQQ",$J,"VAR NAME",I)) D FORMAT
 Q
 ;
DH S %=$P(@AMQQ200(16)@(AMQP(5),0),U),Y=$P($G(@AMQQ200(6)@(AMQP(5),9999999)),U,2) ;VA/SLC ISC/GIS 11/24/93
 W !,$E(%,1,18),?19,$E(Y,1,4) D DIS
 Q
 ;
FORMAT S X=AMQP(I),%=^UTILITY("AMQQ",$J,"VAR NAME",I),Y=1,A=$P(%,U,2) S:'A A=1
 I $P(%,U,5)="EXISTS" S X="+"
 I $P(%,U,5)="INVERSE" S X="-"
 S Z=^AMQQ(1,+%,4,A,0),Z=$P(Z,U,6)
 I X="" S X="-"
 I $P(%,U,3)'="" S Z=$P(%,U,4)
 I $D(AMQQTOTF(I)) K AMQQTOTF(I) S Y=0 G FOR1
 I $D(^AMQQ(1,+%,4,A,1)),X'?1P,X'="SAVED",X'="NULL",Y X ^(1)
FOR1 W ?J,$E(X,1,Z)
 S J=J+2+Z
 Q
 ;
EXP ; ENTRY POINT FROM METADICTIONARY
 N J,Y,Z,%,SITE,VLAB ;IHS/OHPRD/JCM 8/21/94
 S J=$G(AMQQLDFN) I 'J Q
 S Y=$P(^LAB(60,J,0),U),Y=$P(Y,"(",2) S:Y'="" Y="  ("_$E(Y,1,16)
 S %=^UTILITY("AMQQ",$J,"AG",AMQQMULL,AMQQHOLD),Z=$P(%,U,4),VLAB=Z,Z=$P($G(^AUPNVLAB(Z,11)),U)
 S %=$P(%,U),%=$E(%,$L(%)-1,$L(%)),%=$S(%="L*":" ",%="H*":" ",%=" H":"  ",%=" L":"  ",1:"    "),Z=%_Z
 S SITE="NO SITE RECORDED" ;IHS/OHPRD/JCM 8/21/94
 S %=$P($G(^AUPNVLAB(VLAB,11)),U,3) ;IHS/OHPRD/JCM 8/21/94
 S:$G(^LAB(61,+%,0))'="" SITE=$P(^LAB(61,%,0),U) ;CMI/MIC/JCM 8/21/94 ; IHS/CMI/GIS 3/1/98
 S X=X_Z_"   "_SITE_Y ;IHS/OHPRD/JCM 8/21/94
 Q
 ;
SUOUT ; Output transform for CHART SERVICE UNIT attribute; prints chart #s/su
 N % S X="",%=0 F  S %=$O(^AUPNPAT(AMQP(0),41,%)) Q:'%  N %A S %A=$P(^AUTTLOC(%,0),U,5) I %'=DUZ(2),$D(^UTILITY("AMQQ TAX",$J,AMQP(4101),%A))!($D(^("*"))) S:X'="" X=X_"," S X=X_$P(^AUTTLOC(%,0),U,7)_$P(^AUPNPAT(AMQP(0),41,%,0),U,2)
 Q
 ;
CHKVA(C) ; RETURN C+3 IF VA, ELSE C ;IHS/OHPRD/JCM 9/13/93
 Q $S('$D(DUZ("AG")):C,$E(DUZ("AG"))="V":C+3,1:C)

AMQQDOH
AMQQDOH ; IHS/OHPRD/JCM - AMQQDO SUBROUTINE...PRINTS OUTPUT HEADERS 9/9/93 3:39 PM ; [ 9/9/93 3:39 PM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**1,4**;JUN 10, 1993
 I $D(AMQV("OPTION")),AMQV("OPTION")="COUNT" Q
HEADER S X=""
 I '$D(ZTQUEUED),'$D(AMQQDIBT),AMQQTOT>1,$E(IOST,1,2)="C-" W !,"<>" R X:DTIME E  S X=U
 I X=U S AMQQQUIT="" F %=AMQQOV,.1,1,2,3,5,10 S AMQP(%)=99999999999
 I $D(AMQQQUIT) Q
IOF W @IOF I $E(IOST,1,2)="P-" D TOP I 1
 E  W #
 I AMQQCCLS="H" D HH Q
 I AMQQCCLS="D" D HD Q
 I AMQQCCLS="V" D HV Q
 S W=$S('$D(AMQQCNAM):"        ",AMQQCNAM="LIVING PATIENTS":"(Alive)",1:"        ")
 F AMQQHDR="HF1","HF2" W:AMQQHDR[1 "PATIENTS",?17,AMQQLABB W:AMQQHDR[2 !,W,?17,"NUMBER" D
 .S J=$$CHKVA(24) F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I  S %=^(I),X=$P(%,U,3),A=$P(%,U,2) S:'A A=1 D @AMQQHDR ;IHS/OHPRD/JCM 9/13/93
 K W S %="",$P(%,"-",IOM)="" W !,%,!
 K AMQQHDR,AMQQORCT
 Q
 ;
HV F AMQQHDR="HF1","HF2" W:AMQQHDR[1 "VISIT NO.   VISIT DATE" W:AMQQHDR[2 !?13,"AND TIME" S J=29 F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I  S %=^(I),X=$P(%,U,3),A=$P(%,U,2) S:'A A=1 D @AMQQHDR
HV1 S %="",$P(%,"-",IOM)="" W !,%,!
 K AMQQHDR
 Q
 ;
HD F AMQQHDR="HF1","HF2" W:AMQQHDR[1 "POV NO." W:AMQQHDR[2 ! S J=9 F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I  S %=^(I),X=$P(%,U,3),A=$P(%,U,2) S:'A A=1 D @AMQQHDR
 D HV1
 Q
 ;
HH F AMQQHDR="HF1","HF2" W:AMQQHDR[1 "PROVIDERS",?19,"IHS" W:AMQQHDR[2 !,?19,"CODE" S J=24 F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I  S %=^(I),X=$P(%,U,3),A=$P(%,U,2) S:'A A=1 D @AMQQHDR
 K W S %="",$P(%,"-",IOM)="" W !,%,!
 K AMQQHDR
 Q
 ;
HF1 I X["\" S X=$P(X,"\")
 I X'="" W ?J,X S J=J+2+$P(%,U,4) Q
 S X=^AMQQ(1,+%,4,A,0)
 S Y=$P(X,U,6)
 W ?J,$P(X,U,4)
 S J=J+2+Y
 Q
 ;
HF2 I X["\" S X=$P(X,"\",2) W ?J,X S J=J+2+$P(%,U,4) Q
 S X=^AMQQ(1,+%,4,A,0),Z=$P(X,U,7)
 I $P(X,U,8) S Z="#"_$P(%,U,4)
 I +%=179 S AMQQORCT=1+$G(AMQQORCT),Z="#"_AMQQORCT
 S Y=$P(X,U,6) I $P(%,U,4)>Y S Y=$P(%,U,4)
 W ?J I Z'="",A=1 W Z
 S J=J+2+Y
 Q
 ;
TOP W ?7,"*****   IHS Query Manager        Confidential Patient Data  *****"
 S %=$P(@AMQQ200(3)@(DUZ,0),U),%=$P(%,",",2,9)_" "_$P(%,",") W !,"**  Report requested by ",% ;VA/SLC ISC/GIS 11/24/93
 W ?64 S Y=DT X ^DD("DD") W Y,"  **",!!
 Q
CHKVA(C) ;RETURN C+# IF VA, ELSE C ;IHS/OHPRD/JCM 9/13/93
 Q $S('$D(DUZ("AG")):C,$E(DUZ("AG"))="V":C+3,1:C)

AMQQEM1
AMQQEM1 ; OHPRD/GIS,DWG - GETS DOS/UNIX PATH AND FILE NAME ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 fixed export for NT
 I $G(^DD("OS"))'=8 S AMQQEM("FORMAT")="MUMPS" Q
 I ^%ZOSF("OS")["UNIX" S AMQQEM("FORMAT")="UNIX" G RUN
 I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["386")!(^%ZOSF("OS")["NT") S AMQQEM("FORMAT")="PC" G RUN ;IHS/CMI/LAB FIXED FOR NT
 S AMQQEM("FORMAT")="MUMPS" Q
RUN S U="^" F AMQQERUN=12:1:14 D @$P("UNIX^FILE^OVER",U,AMQQERUN-11) Q:AMQQERUN<11  I $D(AMQQQUIT) Q
EXIT Q
 ;
MARK W !!,"---------",!!
 Q
 ;
FWD S AMQQEMS=AMQQERUN_U_AMQQEMS
 Q
 ;
BACKUP S AMQQERUN=$P(AMQQEMS,U)-1,AMQQEMS=$P(AMQQEMS,U,2,99)
 Q
 ;
CK I $D(DIRUT)!($D(DUOUT))!($D(DTOUT))!($D(DIROUT))!(X="") K DIRUT,DUOUT,DTOUT,DIROUT S AMQQQUIT=""
 Q
 ;
VAR ; OS VARIABLES
 N X,I
 ; The following line contain commands that perform OPEN, USE
 ; commands without use of the kernel utilities. - An exemption to
 ; SAC 6.3.1 has been approved by Jim McArthur per memo dated 
 ; May 17, 1993. This exemption is only for version 2. ** BRJ/IHS ** 6/7/93
 S X="O 51:(AMQQEFN):5 Q:'$T  U 51 S Y=$ZA^51^O 51:(AMQQEFN:""R""::::$C(10)):5^O 51:(AMQQEFN:""W""):5^U 51^C 51^^U 0:(0)"
 F I=1:1:8 S AMQQEX($P("CHECK^IOP^READ^WRITE^USE^CLOSE^EOF^WRAPOFF",U,I))=$P(X,U,I)
 Q
 ;
UNIX ; UNIX CHOICES ; 11
 D MARK W "OUTPUT FILE LOCATION",!
 I AMQQEM("FORMAT")="PC" D PC Q
 S DIR(0)="S^1:UNIX FILE;2:MUMPS FILE"
 S DIR("A")="     Your choice",DIR("?")="See User's Guide or type '??' for a full explanation of output format alternatives"
 D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I X=U D BACKUP Q
 D CK I $D(AMQQQUIT) Q
 D FWD S AMQQEM("FORMAT")=$S(Y=1:"UNIX",1:"MUMPS")
 I $G(AMQQEX("PATH"))["\" K AMQQEX("PATH")
 I Y=2 S AMQQERUN=99,AMQQEM("FORMAT")="MUMPS"
 Q
 ;
PC ; PC CHOICES ; 11
 S DIR(0)="S^1:DOS FILE;2:MUMPS FILE",DIR("A")="     Your choice",DIR("?")="See User's Guide or type '??' for a full explanation of output format alternatives." S DIR("??")="AMQQEMANHOST"
 D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I X=U D BACKUP Q
 D CK I $D(AMQQQUIT) Q
 D FWD S AMQQEM("FORMAT")=$S(Y=1:"DOS",1:"MUMPS")
 I $G(AMQQEX("PATH"))["/" K AMQQEX("PATH")
 I Y=2 S AMQQERUN=99
 Q
 ;
FILE ; FILE NAME AND PATH ; 12
 D VAR,MARK W "FILE NAME AND PATH",!
 I AMQQEM("FORMAT")="DOS" S DIR(0)="F^:",DIR("A")="Enter the DOS file (path, name, extension)",DIR("?")="Enter path, file name and extension; e.g., 'C:\DBASE\DATA\MYFILE.DAT'" I 1
 E  S DIR(0)="F^:",DIR("A")="Enter the UNIX file (path, name, extension)",DIR("?")="Enter path, file name and extension; e.g., 'user/mumps/myfile.data'"
 D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I X=U D BACKUP S AMQQERUN=11 Q
 D CK I $D(AMQQQUIT) Q
 D FWD S AMQQEX("FILE")=Y
 N AMQQEFN S AMQQEFN=AMQQEX("FILE")
CHKIT X AMQQEX("CHECK")
 E  W !,"The Host File Server is being used by someone else.  I will keep trying for 30 seconds.",!,"If it is still not free, I must terminate this session.",!! D  I $D(AMQQQUIT) Q
 .N H,T,D S H=$H,D=+H,T=$P(H,",",2)+30
 .F  X AMQQEX("CHECK") Q:$T  I +$H'=D!($P($H,",",2)>T) S AMQQQUIT="" Q
 .Q
 X AMQQEX("CLOSE") I Y'<0 Q
 I Y<0 X AMQQEX("WRITE"),AMQQEX("CHECK"),AMQQEX("CLOSE") I Y<0 W !!,"Sorry, I can't accept this path/filename...Check your User's Guide!" G FILE
F1 S X=AMQQEX("FILE"),Y=$S(AMQQEM("FORMAT")="DOS":"\",1:"/"),Z=$L(X,Y)
 I Z>1 S AMQQEX("PATH")=$P(X,Y,1,Z-1),X=$P(X,AMQQEX("PATH"),2,99)
 S %=$L(X,"."),AMQQEX("EXT")=$P(X,".",%),AMQQEX("NAME")=$P($P(AMQQEX("FILE"),Y,Z),"."),AMQQERUN=99,AMQQEX("DOC")=$P(AMQQEX("FILE"),".")_".DOC"
 Q
 ;
OVER ; OVERWRITE OLD FILE ; 13
 D MARK W "OVERWRITE OLD FILE",!
 W !!,"This ASCII file already exists..."
 S DIR(0)="Y",DIR("A")="Want to overwrite the old version",DIR("B")="NO",DIR("?")="If you answer 'Y', you will destroy the old version and create a new file with the same name"
 D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I X=U D BACKUP Q
 D CK I $D(AMQQQUIT) Q
 I Y="" S Y=0
 I 'Y D BACKUP Q
 D F1
 Q
 ;

AMQQEM4
AMQQEM4 ; IHS/OHPRD/JCM - RECOMPILE DATA EXOPRT INSTRUCTIONS AND EXPORT THE DATA ; [ 03/17/94 6:15 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
RUN D VAR,RC,ENTRY Q:$D(AMQQQUIT)  D ^AMQQEM41,BACK
EXIT K ^UTILITY("AMQQ",$J,"FLAT"),T,AMQQEML,AMQQEMX,AMQQEMI,AMQQEX
 Q
 ;
INC S AMQQEML=AMQQEML+1
 Q
 ;
VAR S T="^UTILITY(""AMQQ"",$J,""EMAN"",1,AMQQEML)"
 S AMQQEML=1,@T="S AMQQEMX=""""",AMQQEX("HEADER")=""
 I '$D(AMQQEM("FIX")),AMQQEM("DEL")="TAB" S AMQQEM("DEL")=$C(9)
 I $G(AMQQEM("DEL"))="UP ARROW" S AMQQEM("DEL")=U
 Q
 ;
RC N A F AMQQEMI=1:1 S AMQQEMN=$P(AMQQEMFS,U,AMQQEMI) Q:'AMQQEMN  D
 .S %=$G(AMQQEX("HEADER")) S:%'="" %=%_$G(AMQQEM("DEL"))
 .S A=$P(@G@(AMQQEMN,0),U,6)
 .I $D(AMQQEM("FIX")),'$D(AMQQEX("NO HEADER")) S A=$E(A,1,AMQQEM("HLEN"))_$J("",AMQQEM("FIX")-$L(A))
 .S AMQQEX("HEADER")=%_A
 .D INC S @T=@G@(AMQQEMN,1)
 .F %=2,3 I $G(@G@(AMQQEMN,%))'="" D INC S @T=^(%)
 .S %=$G(AMQQEM("FIX")) I % D INC S @T="S X=$E(X,1,"_%_") I $L(X)<"_%_" N % S %="""",$P(%,"" "",1+"_%_"-$L(X))="""",X=X_%" D INC S @T="S AMQQEMX=AMQQEMX_X" Q
 .S %=+$P($G(^UTILITY("AMQQ",$J,"FLAT",AMQQEMN,0)),U,7) I % D INC S @T="S X=$E(X,1,"_%_")" D INC S @T="S AMQQEMX=AMQQEMX_X_"""_AMQQEM("DEL")_"""" Q
 .Q
 Q
 ;
BACK D EXIT^AMQQEMAN ; CLEANUP
 S DIR(0)="Y",DIR("A")="Want to run this request as a 'background' job",DIR("B")="NO" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I X?1."^" S AMQQQUIT="" K DIRUT,DIROUT,DUOUT,DTOUT Q
 I Y D ETASK Q
 U IO D ERUN D ^%ZISC
 Q
 ;
EXPORT ; ENTRY POINT FROM SEARCH CODE
 I AMQQTOT=1,'$D(ZTQUEUED),'$D(AMQQEX("NO HEADER")) U 0 W:$G(IOST)["C-" AMQQEX("HEADER"),!
 I AMQQTOT=1,$D(AMQQEX("USE")),'$D(AMQQEX("NO HEADER")) X AMQQEX("USE") W AMQQEX("HEADER"),!
 F I=0:0 S I=$O(^UTILITY("AMQQ",$J,"EMAN",1,I)) Q:'I  X ^UTILITY("AMQQ",$J,"EMAN",1,I)
 I $G(AMQQEMX)="" Q
 S AMQQEMX=$E(AMQQEMX,1,$L(AMQQEMX)-1)
 I '$D(ZTQUEUED) U 0 I $G(IOST)["C-" W AMQQEMX,!
 I $D(AMQQEX("USE")) X AMQQEX("USE") W AMQQEMX,!
 I $D(AMQQEX("TDFN")) S ^AMQQ(3.1,AMQQEX("TDFN"),1,AMQQTOT,0)=AMQQEMX,$P(^AMQQ(3.1,AMQQEX("TDFN"),1,0),U,3,4)=(AMQQTOT_U_AMQQTOT) Q
 Q
 ;
ENTRY ; AMQQ(3.1 ENTRY
 I '$D(AMQQEX("TDFN")) Q
 S DIE="^AMQQ(3.1,",DR=.02_"///"_+$G(DUZ)_";.03///"_DT,DA=AMQQEX("TDFN")
 D ^DIE K DIC,DIE,DA,DR
 F %=1,2 S ^AMQQ(3.1,AMQQEX("TDFN"),%,0)="^^^^"_DT_U
 Q
 ;
NAME ; -  EP - MUMPS FILE NAME ; ENTRY POINT FROM AMQQEMAN
 D MARK^AMQQEMAN W "MUMPS FILE NAME",!
N1 S DIC="^AMQQ(3.1,",DIC(0)="AEQMZL",DIC("A")="File name: " D ^DIC K DIC
 I X=U S AMQQFNMP="",AMQQQUIT="" Q
 I X="^^"!($D(DTOUT)) K DTOUT S AMQQQUIT="" Q
 I X=""!($D(DUOUT)) W " ??  Enter '^^' to terminate the session." K DUOUT G NAME
 I '$P(Y,U,3) D OVER I $D(AMQQQUIT) Q
 I Y="" W ! G N1
 S AMQQEX("TDFN")=+Y,AMQQERUN=99
 Q
 ;
OVER N AMQQEMNM S AMQQEMNM=$P(Y,U,2)
 S DA=+Y,%=$P(^AMQQ(3.1,DA,0),U,2)
 I $G(DUZ)'=%,% W !!,*7,"Someone else has already saved an ASCI file under this name.",!,"Try another name please..." S Y="" Q
 W !!,*7,"You already have an ASCI file stored under this name!"
 S DIR(0)="Y",DIR("A")="Want to erase the old file and replace it",DIR("B")="NO" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I "^"[X S Y="" Q
 I X?2."^" S AMQQQUIT="" Q
 I 'Y S Y="" Q
 S DIK="^AMQQ(3.1," D ^DIK
 S X=AMQQEMNM,DINUM=DA,DIC=DIK,DIC(0)="L" K DD,DO D FILE^DICN K DIC,DIK,DA
 Q
 ;
ETASK S ZTRTN="ERUN^AMQQEM4",ZTIO=""
 S ZTDESC="QUERY UTILITY DATA EXPORT MANAGER"
 F I=1:1 S %=$P("AMQQRM*;AMQQEX(;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)="" ;IHS/OHPRD/JCM 3/17/94
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3 W @IOF
 Q
 ;
ERUN ; EXPORT DATA
 I $D(AMQQEX("FILE")) S AMQQEFN=AMQQEX("FILE")
 I $G(IOST)["C-" W @IOF
 S AMQQRMFL="EXPORT^AMQQEM4"
 I $D(AMQQEX("WRITE")) X AMQQEX("WRITE") E  D BUSY
 I '$D(AMQQSTOP) S:'$D(AMQQNOET) X="ERR^AMQQEM4",@^%ZOSF("TRAP") X $G(AMQQEX("WRITE")),AMQV(0)
 X $G(AMQQEX("CLOSE"))
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 K AMQQEFN,AMQQSTOP
 Q
 ;
BUSY ; EP FROM AMQQEM41 ; HFS IS BUSY
 I $G(IOST)["C-" W !,"The Host File Server is being used by someone else.",!,"If it is not free in 60 seconds, I must terminate this session",!!
 N H,T,D S H=$H,D=+H,T=$P(H,",",2)+60
 F  X AMQQEX("WRITE") Q:$T  I +$H'=D!($P($H,",",2)>T) S AMQQSTOP="" Q
 Q
 ;
ERR ; ERROR MGMT
 X AMQQEX("CLOSE") D ^%ZISC,EXIT
 I $G(IOST)["C-" W *7,"WHOOPS...AN ERROR HAS OCCURRED DURING THE SEARCH.  SESSION TERMINATED.",!! H 3
 Q
 ;

AMQQEM41
AMQQEM41 ; IHS/OHPRD/JCM - DOCUMENTATION OF EXPORT INSTRUCTIONS ; [ 01/31/94 9:35 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
RUN N T,I,X,Y,Z,%,I,J
 D VAR,INTRO,LOGIC,FIELD,SET,SAVE
EXIT K AMQQEML
 Q
 ;
VAR S T="^UTILITY(""AMQQ"",$J,""EMAN"",2,AMQQEML)"
 S AMQQEML=0
 Q
 ;
INC S AMQQEML=AMQQEML+1
 Q
 ;
INTRO ;
 S %=$P(@AMQQ200(3)@(DUZ,0),U),%=$P(%,",",2,9)_" "_$P(%,","),%="This report requested by "_% ;VA/SLC ISC/GIS 11/24/93
 D INC S @T=%
 D INC S Y=DT X ^DD("DD") S @T="Date created: "_Y
 F %=1,2 D INC S @T=" "
 S %=$G(AMQQEM("MLEN")) I % D INC S @T="Record type: DELIMITED"
 S %=$G(AMQQEM("LEN")) I % D INC S @T="Maximum record length: "_%
 S %=$G(AMQQEM("DEL")) I %'="" D INC S @T="Delimiter: '"_%_"'"
 S %=$G(AMQQEM("FIX")) I % D INC S @T="Field length: "_%
 S %=$G(AMQQEM("FILE")) I %'="" D INC S @T="Destination path/file: "_%
 F %=1,2 D INC S @T=" "
 Q
 ;
LOGIC ;
 D INC S @T="Search criteria =>"
 D INC S @T=" "
 F I=0:0 S I=$O(^UTILITY("AMQQ",$J,"LIST",I)) Q:'I  S X=^(I) D
 .S %="",Z=0 I $P(X,",")["W ?" S Z=+$E($P(X,","),4,99) F J=1:1:Z S %=%_" "
 .F J=1:1 S Y=$P(X,",",J) Q:Y=""  I $E(Y)="""",$E(Y,$L(Y))="""" S Y=$E(Y,2,$L(Y)-1),%=%_Y
 .D INC S @T=%
 .Q
 Q
 ;
FIELD ;
 F %=1,2 D INC S @T=" "
 D INC S @T="VARIABLES / FIELDS"
 D INC S @T=" "
 D INC S @T="NAME                DATA TYPE   LENGTH      COLUMN #"
 D INC S @T="------------------- ----------- ----------- -----------"
 F I=1:1 S X=$P(AMQQEMFS,U,I) Q:'X  D
 .S X=^UTILITY("AMQQ",$J,"FLAT",X,0)
 .S X(1)=$P(X,U,6),X(2)=$P(X,U,4),X(3)=$P(X,U,7),X(4)=I
 .S X(1)=$E(X(1),1,19)_$J("",20-$L(X(1)))
 .I $G(AMQQEM("FIX")) S X(3)=AMQQEM("FIX")
 .F J=2:1:4 S X(J)=$E(X(J),1,11) I J'=4 S X(J)=X(J)_$J("",12-$L(X(J)))
 .S X="" F J=1:1:4 S X=X_X(J)
 .D INC S @T=X
 .Q
 Q
 ;
SET ;
 I $D(AMQQEX("TDFN")) F I=1:1 Q:'$D(^UTILITY("AMQQ",$J,"EMAN",2,I))  S ^AMQQ(3.1,AMQQEX("TDFN"),2,I,0)=^(I),$P(^AMQQ(3.1,AMQQEX("TDFN"),2,0),U,3,4)=I_U_I
 I $D(AMQQEX("DOC")) S AMQQEFN=AMQQEX("DOC") X AMQQEX("WRITE") E  D BUSY^AMQQEM4
 I '$D(AMQQSTOP),$D(AMQQEX("DOC")) X AMQQEX("USE") F I=1:1 Q:'$D(^UTILITY("AMQQ",$J,"EMAN",2,I))  W ^(I),!
 X $G(AMQQEX("CLOSE"))
 K AMQQSTOP
 Q
 ;
SAVE ; SAVE SEARCH LOGIC AND FORMATTING INSTRUCTIONS
TMP W !! Q  ; THIS OPTION IS TEMPORARILY DISABLED UNTIL DR. GRAU RESTORES THE SCRIPT OPTION ON THE OPENING SCREEN
 W !! S DIR(0)="Y",DIR("A")="Save the search logic and formatting instructions for future use",DIR("B")="NO" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I "^"[X!('$G(Y)) Q
 I X?2."^" S AMQQQUIT="" Q
 D STORE^AMQQQE I $D(AMQQQUIT) Q
 I $D(AMQQCPLF) D ^AMQQCMPS
 Q
 ;

AMQQEM5
AMQQEM5 ; IHS/OHPRD/JCM - EMAN OPTIONS ; [ 01/31/94 9:35 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
EN ; ENTRY POINT FOR EXPORT OF DATA FROM ^AMQQ(3.1,
 S DIC="^AMQQ(3.1,",DIC(0)="AEQM",DIC("A")="File name: "
 D ^DIC K DIC
 I Y=-1 G ENX
 I '$D(^AMQQ(3.1,+Y,2,1,0)) G DATA
 W !!,"Get ready to receive the reference file (approx 1K)....."
 R !!,"Press the <return> key to initiate data transfer",X:DTIME E  G ENX
 I X?1."^" G ENX
 W !! F %=0:0 S %=$O(^AMQQ(3.1,+Y,2,%)) Q:'%  W ^(%,0),!
DATA W @IOF,!!,"Get ready to receive the data file......."
 R !!,"Press the <return> key to initiate data transfer",X:DTIME E  G ENX
 I X?1."^" G ENX
 F %=0:0 S %=$O(^AMQQ(3.1,+Y,1,%)) Q:'%  W ^(%,0),!
ENX W @IOF K DUOUT,DTOUT,X,Y
 Q
 ;
EN1 ;EP FOR PURGING EXPORT DATA FILE
 N AMQQEMPG
 W:$D(IOF) @IOF W !,?15,"*****  PURGE MUMPS EXPORT DATA FILE  *****",!!!
EN11 S DIR(0)="PO^9009073.1:EQM",DIR("A")="Select MUMPS data file to purge" D ^DIR K DIR
 I $D(DIRUT)!($D(DIROUT)) K DIRUT,DIROUT,DUOUT,DTOUT Q
 S AMQQEMPG=+Y
 W !!,"MUMPS data file: ",$P(Y,U,2),!,"Created by: "
 S %=$P(^AMQQ(3.1,+Y,0),U,2),%=$P($G(@AMQQ200(3)@(+$G(%),0)),U) S:%="" %="??" W % ;VA/SLC ISC/GIS 11/24/93
 W !,"Entered on: " S Y=$P(^AMQQ(3.1,+Y,0),U,3) X ^DD("DD") W Y,!!
 I $P(^AMQQ(3.1,AMQQEMPG,0),U,2)'=DUZ W !!,"You are not allowed to purge anyone else's MUMPS data file.",*7,!! G EN11
 S DIR(0)="YO",DIR("A")="Are you sure" D ^DIR K DIR
 I $D(DIRUT)!($D(DIROUT)) K DIROUT,DIRUT,DUOUT,DTOUT Q
 I 'Y G EN11
 S DA=AMQQEMPG,DIK="^AMQQ(3.1," D ^DIK K DIK,DIC,DA
 I $D(AMQQ(3.1,"B")) S DIR(0)="YO",DIR("A")="Want to purge another" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I Y G EN11
 K DIRUT,DIROUT,DUOUT,DTOUT
 Q
 ;

AMQQF1
AMQQF1 ; IHS/OHPRD/JCM - MORE ANALYTIC FUNCTIONS ; [ 05/16/94 7:34 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
TEST N T S T=$T I '$D(AMQQNOT)=T K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)
EXIT Q
 ;
COMP S X1=Z,X2=$P(AMQQCOMP,";") D C^%DTC S A=X
 S X1=Z,X2=$P(AMQQCOMP,";",2) D C^%DTC S B=X
 Q
 ;
CDOB N X,Y,Z,%,I,A,B
 S Z=$P(^DPT(AMQP(0),0),U,3) I Z D COMP
 F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I  S Y=$P(^(I),U,2) D CDOB1,TEST
 K AMQQNOT
 Q
 ;
CDOB1 I Z="" Q
 I Y<A!(Y>B)
 Q
 ;
CDOD N X,Y,Z,%,I,A,B
 S Z="" I $D(^DPT(AMQP(0),.35)) S Z=+^(.35) I Z D COMP
 F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I  S Y=$P(^(I),U,2) D CDOD1,TEST
 K AMQQNOT
 Q
 ;
CDOD1 I Z="" Q
 I Y<B!(Y>A)
 Q
 ;
CAGE N X,Y,Z,%,I,A,B
 S X1=$P(^DPT(AMQP(0),0),U,3) I X1="" K X1 S Z="" G CAGET
 S X2=$P(AMQQCOMP,";",4) D C^%DTC S Z=X D COMP
CAGET F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I  S Y=$P(^(I),U,2) D CAGE1,TEST
 K AMQQNOT
 Q
 ;
CAGE1 I Z="" Q
 I Y<A!(Y>B)
 Q
 ;
SUB N AMQQSQFS,AMQQSQFN,AMQQSQFP,I
 S AMQQSQFS=$P(AMQQCOMP,";"),AMQQSQFN=$P(AMQQCOMP,";",2),AMQQSQFP=$P(AMQQCOMP,";",3) N AMQQCOMP
 F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I  S AMQQHIT=^(I) D SUB1,TEST
 K AMQQNOT
 Q
 ;
SUB1 N I
 I AMQQSQFN N AMQP,AMQT S AMQP(AMQQSQFN)=$P(AMQQHIT,U,AMQQSQFP) G SUBX ;IHS/OHPRD/GIS 5/14/94
 S AMQQDPT=AMQP(0)
 N AMQQ,AMQQGR,AMQQID,AMQQST,AMQQFIN,AMQQLAST,AMQQVAL,AMQQMLT,AMQQT,AMQQIDX,AMQQIDN,AMQQIDT,AMQQX,AMQQITR,AMQQAFNO,AMQQVDAT,AMQQVNO,AMQQLCNT,AMQQVAL1,AMQQVAL2,AMQQMULZ,AMQQLCOF
 N AMQQTAX,AMQQNNA,AMQQCPG1,AMQQVAL3,AMQQVAL4,AMQQBOOL,AMQQB,AMQQMSS,AMQQMPC,AMQQSTRT,AMQQFVAR,AMQQAG,AMQQSQVS,AMQQUATN,AMQQNVAR,AMQQT,AMQQUSQN,AMQT,AMQP,AMQQSQVN,AMQQSPEC
 S AMQQAG="SAG",AMQP(0)=AMQQDPT,AMQQSQVS=$P(AMQQHIT,U,3)
 I AMQV("QQ",AMQQSQFS,1)[";+0;+0;" S AMQQSQVN=AMQQSQVS
SUBX K AMQQDPT,AMQQHIT
 X AMQV("QQ",AMQQSQFS,1)
 Q
 ;
BP N %,I,Z,A,B,C,D,E
 F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I  S %=$P(^(I),U) D BP1,TEST
 Q
 ;
BP1 S A=$P(%,"/"),B=$P(%,"/",2)
 S %=AMQQCOMP,C=$P(%,"~"),D=$P(%,"~",2),E=$P(%,"~",3)
 S Z="I "_A_$P(C,":")_$P(C,":",2)_E_"("_B_$P(D,":")_$P(D,":",2)_")"
 X Z I '$T
 Q
 ;

AMQQFAN
AMQQFAN ; IHS/OHPRD/JCM - FREE TEXT ANALYTIC ROUTINES ; [ 11/19/93 11:50 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**3**;JUN 10, 1993
VAR S AMQQSYMB=$P(AMQQX,";"),AMQQVAL1=$P(AMQQX,";",2),AMQQVAL2=$P(AMQQX,";",3) K AMQQNOT
SYMBOL I $E(AMQQSYMB)="'" S AMQQNOT="",AMQQSYMB=$E(AMQQSYMB,2,99)
 S %=$F("[]=$-#?",AMQQSYMB) ;IHS/OHPRD/JCM 11/19/93
 I '% ;IHS/OHPRD/JCM 11/19/93
 E  D @("A"_(%-1)) ;IHS/OHPRD/JCM 11/19/93
 I ('$D(AMQQNOT)=$T)
EXIT K %,AMQQSYMB,AMQQVAL1,AMQQVAL2,AMQQVALU,AMQQNOT,AMQQX
 Q
 ;
A1 I AMQQVALU[AMQQVAL1
 Q
 ;
A2 I AMQQVALU]AMQQVAL1
 Q
 ;
A3 I AMQQVALU=AMQQVAL1
 Q
 ;
A4 I $E(AMQQVALU,1,$L(AMQQVAL1))=AMQQVAL1
 Q
 ;
A5 I AMQQVALU]AMQQVAL1,AMQQVALU']AMQQVAL2
 Q
 ;
A6 I $E(AMQQVALU,$L(AMQQVALU)-$L(AMQQVAL1)+1,250)=AMQQVAL1
 Q
 ;
A7 X ("I AMQQVALU?"_AMQQVAL1)
 Q
 ;
SER ; ENTRY POINT FOR COMPUTING SEARCH EFFICIENCY RATING
 ; ENTRY POINT FROM EXECUTING ^AMQQ(1,D0,3)
 N AMQQSYMB,AMQQVALU,AMQQVAL1,AMQQVAL2,AMQQNOT,%
 S AMQQSYMB=AMQQESBL,AMQQVALU=AMQQEVAL,AMQQVAL1=$P(AMQQECPR,";"),AMQQVAL2=$P(AMQQECPR,";",2)=""
 D SYMBOL
 Q
 ;
NAME ; ENTRY POINT FROM METADICTIONARY (PATIENT;NAME)
 N AMQQSYMB,AMQQVALU,AMQQVAL1,AMQQVAL2,AMQQNOT,%
 S AMQQSYMB=AMQP(.11),AMQQVALU=AMQP(.1),AMQQVAL1=AMQP(.101),AMQQVAL2=""
 D SYMBOL
 Q
 ;
TEXT ; ENTRY POINT FROM AMQQMULT
 N X,Y,Z,%,AMQQSYMB,AMQQNOT
 S X=AMQQVAL1,Y=AMQQVAL2,Z=AMQQVALU
 N AMQQVAL1,AMQQVAL2
 S AMQQSYMB=$P(X,":")
 I X="'<:'>" S AMQQSYMB="-"
 S AMQQVAL1=$P(Y,":"),AMQQVAL2=$P(Y,":",2)
 D SYMBOL
 I  S AMQQVALU=Z
 Q
 ;
START ; ENTRY POINT FROM METADICTIONARY
 N X,Y,Z,%
 S Y=AMQP(.11) I Y'="$",Y'="=" Q
 S %=AMQP(.101)
 S X=$E(%,$L(%)),X=$A(X)-1,X=$C(X)
 S AMQP(.1)=$E(%,1,$L(%)-1)_X
 I Y="$" S AMQP(.111)=AMQP(.101)_"~" Q
 S AMQP(.111)=AMQP(.101)
 Q
 ;

AMQQHEL2
AMQQHEL2 ; OHPRD/DG - CONTINUATION OF AMQQHELP ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
EN1 ; ENTRY POINT FROM AMQQSQA
 S X="SQT^"_$O(^AMQQ(4,"B",AMQQSQST,""))_";16" I AMQQSQSN'=226 S X=X_";7"
 I $G(AMQQSQSN),$P($G(^AMQQ(5,AMQQSQSN,5)),U,3) S X=X_"~AF^"_$P(^(5),U,3) G EN11
 S Y=U,%="" F  S %=$O(^AMQQ(7,"B",%)) Q:%=""  I %[" ATTRIBUTES" S Z=$O(^(%,"")),Y=Y_Z_U
 S %=$P(^AMQQ(5,AMQQSQSN,0),U,4) S:%=48 %=50 I %,Y[(U_(%+1)_U) S X=X_"~AF^"_(1+%) ; IHS/CMI/GIS 3/20/98
EN11 S AMQQMSPF=""
 I AMQQSQSN=35 S X=$P(X,"~",2)
 I $G(AMQQSQST)'="","LG"[AMQQSQST K AMQQMSPF
 D EN1^AMQQHELP
 Q
 ;
EN2 ; ENTRY POINT FROM AMQQSQA
 S X="SQT^"_$S(AMQQSQDV'=306:7,1:$O(^AMQQ(4,"B",AMQQSQST,"")))
 D EN1^AMQQHELP
 Q
 ;

AMQQHELP
AMQQHELP ; OHPRD/DG - HELP MESSAGES FORQUERY UTILITY ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
RUN ; - EP -
 N Y,Z,I,%,A,B,C,AMQQLNO
 S AMQQLNO=0
EN1 ; - EP - FROM ^AMQQHEL2 AND ^AMQQSQA0
 N S,J,Y,Z,I,%,A,B,C,AMQQLNO S S=X,AMQQLNO=0
 I S["~" D MULT W !! Q
 D L0
 W !!
 Q
 ;
L0 S A=$P(X,U),C=$P(X,U,2)
 F I=1:1 S B=$P(C,";",I) Q:B=""  S Y="" F  S Y=$O(^AMQQ(5,A,B,Y)) Q:Y=""  D L1 I Y=999999999 G LISTX
LISTX Q
 ;
L1 I X="AF^51",'$$WHP(Y) Q  ; IHS/CMI/GIS 11/23/98
 S AMQQLNO=AMQQLNO+1
 I AMQQLNO=1 W !!,"Possible choices:" D TYPE
 I $D(AMQQMSPF) K AMQQMSPF S AMQQLNO=4 W !?3,"ALL",!?3,"ANY",!?3,"EXISTS",!?3,"NULL" G L1
 I AMQQLNO#(IOSL-4)=1,AMQQLNO>1 D L2 I Y=999999999 Q
 W !,?3,Y
 Q
 ;
L2 W !!,"Enter '^' to stop listing or any other key to see more <>" R Z:DTIME E  S Y=999999999 Q
 I Z=U S Y=999999999 Q
 W @IOF
 Q
 ;
LISTG ; ENTRY POINT FROM AMQQ1
 N Y,Z,I,%,AMQQLNO
 S Y="",AMQQLNO=0 F  S Y=$O(^AMQQ(5,"GOAL",Y)) Q:Y=""  D L1
 W !!
 Q
 ;
MULT F J=1:1 S X=$P(S,"~",J) Q:X=""  D L0
 W !!
 Q
 ;
ITEM ; - EP - FROM ^AMQQATA AND ^AMQQSQA0
 W @IOF,?20,"*****  ATTRIBUTE CATEGORIES  *****"
ATTS S DIR(0)="SO^1:DEMOGRAPHICS;2:DENTAL CODES;3:DIAGNOSES;4:EXAMS;5:INPATIENT;6:IMMUNIZATIONS;7:LAB;8:MEASUREMENTS;9:MEDICATIONS;10:PATIENT ED;11:PROCEDURES;13:SKIN TESTS;14:TREATMENTS;15:VISIT INFO;16:WOMEN'S HEALTH" ; IHS/CMI/GIS 3/4/98
 S DIR("A")="Your choice" D ^DIR K DIR
 I X=U S AMQQQUIT=""
 I "^"[X K DIRUT,DTOUT,DUOUT Q
 I Y=1 S X="AF^11" D RUN Q
 I Y=2 W !,"Type ""ADA CODE"" and the enter the code number or procedure name",! Q
 I Y=3 W !,"Type ""DX""<RETURN> and then enter the ICD code or diagnosis",! Q
 I Y=14 W !,"Type ""TREATMENT""<RETURN> and then enter the name of the treatment",! Q
 I Y=9 W !,"Type ""RX""<RETURN> and then enter the name of the prescription",! Q
 I Y=11 W !,"Type ""PROCEDURE""<RETURN> and then enter the procedure code or name",! Q
 I Y=12 S X="AF^16" D RUN Q
 I Y=7 S X="AF^3" D RUN Q
 I Y=6 S X="AF^1" D RUN Q
 I Y=8 S X="AF^5" D RUN Q
 I Y=13 S X="AF^18" D RUN Q
 I Y=4 S X="AF^22" D RUN Q
 I Y=15 S X="AF^17" D RUN Q
 I Y=16 S X="AF^48" D RUN Q  ; IHS/CMI/GIS 3/4/98
 W !,"Sorry, these attributes are not currently available",!
 Q
 ;
TYPE I $G(AMQQSQST)="Q" S AMQQLNO=4 W !!,?3,"POSITIVE",!?3,"NEGATIVE",! Q
 I $G(AMQQSQST)="S" W ! S AMQQLNO=2 N %,I,X D  W ! Q
 .S %=$P($G(^AMQQ(5,AMQQSQSN,0)),U,5) I % S %=$P($G(^AMQQ(1,%,0)),U,6) I % S %="^DD("_%_",0)" I $D(@%) S %=$P(^(0),U,3) F I=1:1 S X=$P(%,";",I) Q:X=""  W !?3,$P(X,":",2) S AMQQLNO=AMQQLNO+1
 .Q
 Q
 ;
WHP(Y) ; SCREEN WH PROCEDURE ATTRIBUTES ; IHS/CMI/GIS 11/23/98 ; ENTIRE SUBROUTINE IS A NEW PATCH
 I '$D(^BWAA("AC")) Q 1
 N %,Z,T
 S T=$O(^UTILITY("AMQQ TAX",$J,+$G(AMQQTAX),0)) I $O(^(T)) Q 1 ; DON'T SCREEN IF THERE IS MORE THAN ONE PROCEDURE SELECTED
 S %=$O(^AMQQ(5,"B",Y,0)) I '% Q 1
 S Z=+$P($G(^AMQQ(1,%,0)),U,4) I Z="" Q 1
 I $D(^BWAA("AC",Z,T)) Q 1
 Q 0
 ;

AMQQKILL
AMQQKILL ; IHS/OHPRD/JCM - KILLS OFF BIG GROUPS OF LOCAL VARIABLES...HOUSEKEEPING ; [ 10/18/94 6:41 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4,6**;JUN 10, 1993
EXIT1 ; ENTRY POINT FROM AMQQ
 K AMQQQUIT,AMQQILIN,AMQQQ,AMQQMULT,AMQQCCLS,AMQQCNAM,%,%Y,H,I,J,K,L,A,Y,Z,T,V,AMQQONE,AMQQNULL,AMQQCOMP,AMQQNVAR,X,AMQQLABB,AMQQTOT,AMQQONE,AMQQSCPT,AMQQSVFL,AMQQAGIN,AMQQRMFL
 K AMQQTDFN,AMQQLBF,AMQQLCT,AMQQLGR,AMQQLHT,AMQLLL,AMQQLLP,AMQQLRH,AMQQLPTR,AMQQLBC
 K AMQQUSQL,AMQQUSQN,AMQQURGN,AMQQRAND,AMQQCHRT,%X,AMQV,N,AMQQMULX,AMQQKONG,AMQQKGNO,AMQQUSQN,AMQQSQAA,AMQQLSQF,AMQQUQQN,AMQQESN,AMQQRMB,AMQQUSR,AMQQFSQN,AMQQLENO,AMQQFSQX,AMQQEX
 K D,D0,DA,DD,DI,DIADD,DIC,DICR,DIG,DIH,DIK,DISYS,DIU,DIV,DIW,DO,DQ,DIE,DR,DX,%T,%H,%,S,DUOUT,DTOUT,DPP,AMQQMULL,AMQQMULD
 I '$D(AMQQADAM) K AMQV,AMQP,AMQT
EXIT2 ; ENTRY POINT FROM AMQQCMPP
 F I=1:1 S %=$P("AMQQ DRUG CLASS^AMQQ OR^AMQQ FRAND^AMQQ FTEMP^AMQQ RAND^AMQQ^AMQQ TAX^AMQQ TEMP^AMQQ SER1^AMQQ SAVE^AMQQ RANGE^AMQQ DELETE",U,I) Q:%=""  K ^UTILITY(%,$J)
 F %=1000:0 S %=$O(^AMQQ(1,%)) Q:'%  S X=$P(%,".",2),X=$E(X,$L(X)-2,$L(X)) I +X=$J K ^(%)
EXIT3 ; ENTRY POINT FROM AMQQMUL*
 K AMQQ,AMQQGR,AMQQID,AMQQST,AMQQFIN,AMQQLAST,AMQQVAL,AMQQMLT,AMQQT,AMQQIDX,AMQQIDN,AMQQIDT,AMQQX,I,AMQQITR,AMQQAFNO,AMQQVDAT,AMQQVNO,AMQQLCNT,AMQQVAL1,AMQQVAL2,AMQQMULZ,AMQQSQVN,%,%H,%T,%Y,H,I,Y,Z,A,B,C,T
 K AMQQTAX,AMQQNNA,AMQQAG,AMQQCPG1,AMQQVAL3,AMQQVAL4,AMQQBOOL,AMQQB,AMQQMSS,AMQQMPC,AMQQSTRT,AMQQSQVN,AMQQSPEC,%,AMQQAAFL,AMQQLSS,AMQQLSS1 ;IHS/OHPRD/JCM 8/21/94
 Q
 ;
EXIT ; ENTRY POINT FROM AMQQ
 K AMQQUATN,AMQQUNBC,AMQQNV,AMQQRV,AMQQXV,AMQQSAUT,AMQQOPT,AMQQVER,AMQQIOP,POP,DISYS,AMQQNOET,AMQQXX,AMQQYY,AMQQEN31,AMQQLKUP,AMQQ200 ;VA/SLC ISC/GIS 11/24/93
 Q
 ;
SQKILL ; - EP - KILL SUBQUERY VARS
 K AMQQSQAA,AMQQSQAN,AMQQSQBF,AMQQSQBS,AMQQSQCF,AMQQSQCT,AMQQSQCV,AMQQSQDF,AMQQSQDV,AMQQSQF1,AMQQSQF2,AMQQSQFL,AMQQSQFL,AMQQSQFN,AMQQSQFR,AMQQSQGF
 K AMQQSQJ1,AMQQSQJ2,AMQQSQLS,AMQQSQN,AMQQSQN1,AMQQSQN2,AMQQSQNC,AMQQSQNF,AMQQSQNM,AMQQSQNN,AMQQSQAT,AMQQSQP,AMQQSQP1,AMQQSQP2,AMQQSQPH,AMQQSQPL,AMQQSQPQ,AMQQSQPS,AMQQSQPY,AMQQSQQQ,AMQQSQQT
 K AMQQSQRD,AMQQSQSC,AMQQSQSJ,AMQQSQSN,AMQQSQSQ,AMQQSQST,AMQQSQSZ,AMQQSQTF,AMQQSQTP,AMQQSQVV,AMQQSQZL,AMQQSQP,AMQQSQZF ; &&& AMQQSQZF ADDED
 Q
 ;
NUKE ; S %="%" F  S %=$O(@%) K:%="" % Q:'$D(%)  I $E(%)'="D",$E(%,1,2)'="IO",%'="U" K @% ; EQUIVALENT TO K (D*,IO*,U)
 Q
 ;
NEW ; NEW TEMPLATE
 ;N (DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED)
 Q
 ;

AMQQLXR
AMQQLXR ; OHPRD/DG - SETS AQ1 XREF ON BLOOD QUANTUM FLD IN PT FILE ; [ 06/24/96  9:44 AM ]
 ;;2;PCC QUERY UTILITY;*9*;JUN 24, 1996
REINDEX ;
 S U="^"
 I $P(^AUTTSITE(1,0),U,19)'="Y" W *7,!,"""AQ"" indices for Q-MAN not currently set up.",!,"Use Q-MAN site manager option to create these indices." Q
 K ^AUPNPAT("AQ1")
 F DA=0:0 S DA=$O(^AUPNPAT(DA)) Q:'DA  S X=$P($G(^(DA,11)),U,10) K AMQQQXR D QXR I $D(AMQQQXR) S ^AUPNPAT("AQ1",AMQQQXR,DA)=""
 K ^AUPNPAT("AQ2") ;IHS/OHPRD/TMJ 6/24/96 Patch #9
 F DA=0:0 S DA=$O(^AUPNPAT(DA)) Q:'DA  S X=$P($G(^(DA,11)),U,9) K AMQQQXR D QXR I $D(AMQQQXR) S ^AUPNPAT("AQ2",AMQQQXR,DA)="" ;IHS/OHPRD/TMJ 6/24/96 Patch #9
 Q
 ;
QXR ; ENTRY POINT
 I X="" Q
 N % S %=X N X
 I %["/" S %=(+%/$S($P(%,"/",2):$P(%,"/",2),1:1)) S:$E(%)="." %=0_%,AMQQQXR=$E(%,1,8)+1 S:'$D(AMQQQXR) AMQQQXR=%+1 Q  ;IHS/OHPRD/TMJ 6/24/96 Patch #9
 S %=$S($E(%)="F":2,$E(%)="N":1,$E(%,1,3)="UNK":2.1,$E(%,1,3)="UNS":2.2,1:"")
 I %'="" S AMQQQXR=%
 Q
 ;

AMQQMGR
AMQQMGR ; IHS/OHPRD/JCM - MANAGER'S UTILITIES ; [ 09/06/95 8:08 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
 S IOP=0 D ^%ZIS
 S X=$P(^AMQQ(8,DUZ(2),0),U,6) F %=3,6,16 S AMQQ200(%)=$S(X:"^VA(200)",1:("^DIC("_%_")")) ;11/24/94 GIS
MENU ;
 I '$O(^AMQQ(8,0)) D INIT I '$O(^AMQQ(8,0)) Q
 S DIC="^AMQQ(8,",DIC(0)="",X="`"_DUZ(2) D ^DIC K DIC I Y=-1 W !!,*7,"DUZ(2) MUST BE SET TO THE FACILITY INDICATED IN THE QMAN SITE PARAMETERS FILE!" H 2 Q
ASK W !! S DIR(0)="SO^1:CHECK security keys;2:DEVICE management;3:INDEX setup;4:INTEG check;5:LAB startup;6:LOG of queries;7:SECONDARY facilities;9:HELP;0:EXIT"
 S DIR("??")="AMQQMGR",DIR("A")=$C(10)_"     Your choice",DIR("?")="Enter a code from the list or type '??' for more information"
 D ^DIR K DIR
 D CHK I $D(AMQQQUIT) G EXIT
 I Y=0 G EXIT
 I Y=9 W !!,"Enter a code from the list or type '??' for more information." G ASK
 D @("M"_Y) I '$D(AMQQQUIT) G MENU
EXIT K AMQQQUIT,X,Y,%,AMQQMGRL,AMQQMGRN,AMQQMGRS,AMQQMGRF,AMQQLSSX
 Q
 ;
CHK I $D(DTOUT)+$D(DUOUT)+(Y=-1)+(Y="") K DIRUT,DUOUT,DTOUT S AMQQQUIT="" Q
 Q
M1 ;
 D ^%ZIS U IO
 I POP W:$D(IOF) @IOF Q
 W:IOST["C-" @IOF
 W ?15,"*****  SECURITY KEY ASSIGNMENT CRITERIA  *****",!!
 W "Q-MAN DEMOGRAPHIC DATA ACCESS   Key = AMQQZMENU  Assign to all Q-Man users",!
 W "Q-MAN CLINICAL DATA ACCESS  Key = AMQQZCLIN  Assign to health professionals only",!
 W "Q-MAN PROGRAMMER ACCESS  Key = AMQQZPROG  Assign to PCC developers only",!
 W "Q-MAN MANAGERS UTILITIES   Key = AMQQZMGR   Only the site manager should hold it"
 W "PROMPT FOR WHO REPORT IS FOR   Key = AMQQZRPT   Assign to users running reports",!,"for others"
 S AMQQMGRL=6,Z=""
 F X="AMQQZMENU^Q-MAN ACCESS","AMQQZCLIN^CLINICAL DATA ACCESS","AMQQZPROG^Q-MAN PROGRAMMER ACCESS","AMQQZMGR^SITE MANAGER'S UTILITIES","AMQQZRPT^REPORT GENERATORS" D KEY I $G(Z)=U G M10
 I IOST["C-" R !,"<Press the ENTER key to go on>",X:DTIME K DUOUT,DTOUT,DIRUT Q
M10 W @IOF
 K AMQQMGRL D ^%ZISC
 Q
 ;
KEY S AMQQMGRL=AMQQMGRL+3 W !!,?10,"*****  ",$P(X,U,2),"  *****",!
 S X=$P(X,U)
 F %=0:0 S %=$O(^XUSEC(X,%)) Q:'%  S AMQQMGRL=AMQQMGRL+1 W ! D WAIT Q:$G(Z)=U  W $S($D(@AMQQ200(3)@(%,0)):$P(^(0),U),1:(%_"  ??")) ;VA/SLC ISC/GIS 11/24/93
 Q
 ;
WAIT I (AMQQMGRL<(IOSL-3)) Q
 S AMQQMGRL=0
 I IOST'["C-" W IOF Q
 R "<>",Z:DTIME E  S AMQQQUIT="",%=99999999999 W @IOF Q
 W @IOF
 Q
 ;
M2 D ^AMQQMGR5
 Q
 ;
M7 W @IOF,!!,?20,"*****  SECONDARY FACILITIES  *****",!!
 W !,"Normally, when the user requests patient reports, s/he will only see the chart"
 W !,"number at this facility.  The user may request other chart numbers provided"
 W !,"that you enter the other local facilities now.  You may enter up to three",!,"facilities, but do not enter this one!",!
 I $P(^AMQQ(8,DUZ(2),0),U,2) W !,"OTHER FACILITIES' CHART NUMBERS NOW DISPLAYED =>",! D
 . F %=2:1:4 Q:'$P(^AMQQ(8,DUZ(2),0),U,%)  W !,$P(^DIC(4,$P(^(0),U,%),0),U)
ASKFAC . W !!,"You may recreate this list if you want.  Do you want to remove this list",!,"and enter other local facilities" S %=2 D YN^DICN G:%=0 ASKFAC I %=-1!(%=2) S AMQQSTP=""
 I $D(AMQQSTP) K AMQQSTP Q
 W !
 I $P(^AMQQ(8,DUZ(2),0),U,2) S DA=DUZ(2),DIE="^AMQQ(8,",DR=".02///@;.03///@;.04///@" D ^DIE K DIE,DR,DA D
 . S DIE="^AMQQ(1,256,4,",DA=1,DA(1)=256,DR="4///@;5///@" D ^DIE K DIE,DR,DA
 S AMQQMGRF="@^@^@" F  D FAC Q:"^@"[X  I $G(AMQQMGRN)=3 Q
 I X="@" S AMQQMGRN=0 G SETM7
 I '+AMQQMGRF Q
SETM7 S %=AMQQMGRF,DA=DUZ(2),DIE="^AMQQ(8,",DR=".02////"_$P(%,U)_";.03////"_$P(%,U,2)_";.04////"_$P(%,U,3) D ^DIE K DIE,DR,DA
 S %=AMQQMGRN*10,DIE="^AMQQ(1,256,4,",DA=1,DA(1)=256,DR="4///"_%_";5///"_% D ^DIE K DIE,DR,DA
 W !!,"Okay, the entered local facility or facilities' chart numbers will now appear",!,"on all outputs" H 2
 K AMQQMGRF,AMQQMGRN,DIC
 Q
 ;
FAC S DIR(0)="PO^9999999.06:EMQ" D ^DIR
 I +Y=DUZ(2) W !,*7,"Enter a facility other than your local facility.",! G FAC
 I X=""!(X=U)!(X="@") Q
 D CHK I $D(AMQQQUIT) K AMQQQUIT Q
 S AMQQMGRN=$G(AMQQMGRN)+1
 S $P(AMQQMGRF,U,AMQQMGRN)=+Y
 Q
 ;
M3 D ^AMQQMGR1
 Q
 ;
M6 D ^AMQQMGR2
 Q
 ;
M4 D ^AMQQNTEG
 Q
 ;
M5 ;
VER ;I $G(^DD(60,0,"VR"))'>5 W !!,"Sorry, this option requires LAB TEST FILE Ver. 5.01 or higher!!",!!,*7 H 3 Q
 W @IOF,!,?15,"*****  LAB RESULTS FOR Q-MAN  *****",!!
M51 W ! S DIR(0)="SO^1:TOP 40 tests;2:INDIVIDUAL tests;3:VIEW Q-Man lab tests;9:HELP;0:EXIT",DIR("A")=$C(10)_"Your choice",DIR("??")="AMQQLABSTART" D ^DIR K DIR
 I Y=9 W !!,"Select a code from the list or type '??' for more info",!! G M51
 I 'Y Q
 I Y=1 D TOP^AMQQMGR4 G M5
 I Y=2 D GET^AMQQMGR4 G M5
 I Y=3 D LIST^AMQQMGR4 R !!,"<>",X:DTIME G M5
 G M5
 ;
INIT ;
 I '$D(DUZ(2)) W !!,"KERNEL VARIABLES NOT SET!!,",!! Q
 W !!,"Is the site where Q-Man is being installed ",$P(^DIC(4,DUZ(2),0),U)
 S %=0 D YN^DICN I $E(%Y)?1A,"yYnN"[$E(%Y) D ISET
 K DUOUT,DTOUT,%,%Y
 Q
 ;
ISET I "nN"[$E(%Y) W !!,"Well then, you must log in again, and this time enter the correct site!",!!,*7 Q
 S X="`"_DUZ(2),DIC="^AMQQ(8,",DIC(0)="L",DLAYGO=9009078 D ^DIC
 I Y'=-1 S X="0:1;2:4;5:10;11:19;20:39;40:59;60:79;80:199" X $P(^DD(9009078,30,0),U,5,99) I $D(X) S ^AMQQ(8,+Y,3)=X S DIK="^AMQQ(8,",DIK(1)=30,DA=DUZ(2) D EN^DIK
 Q
 ;

AMQQMGR1
AMQQMGR1 ; IHS/OHPRD/JCM - CHECKS AND SETS THE 'AQ' XREF ; [ 11/09/94 11:52 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**6**;JUN 10, 1993
 ; CALLS TASKMAN
 W:$D(IOF) @IOF
START I '$D(^AUTTSITE(1,0)) W !!,"RPMS SITE PARAMETER FILE NOT PRESENT...REQUEST CANCELLED"
 I $P(^AUTTSITE(1,0),U,19)'="Y" D NEW G EXIT
 W !!,"Q-Man indices are active!",!!!
 W ?3,"V EXAM 'AQ' index is " W:'$D(^AUPNVXAM("AQ")) "not " W "present",!
 W ?3,"The INDIAN BLOOD QUANTUM 'AQ1' index of the PATIENT file is " W:'$D(^AUPNPAT("AQ1")) "not " W "present",!
 W ?3,"V IMMUNIZATION 'AQ' index is " W:'$D(^AUPNVIMM("AQ")) "not " W "present",!
 W ?3,"V LAB 'AQ' index is " W:'$D(^AUPNVLAB("AQ")) "not " W "present",!
 W ?3,"V MEASUREMENT 'AQ' index is " W:'$D(^AUPNVMSR("AQ")) "not " W "present",!
 W ?3,"V SKIN TEST 'AQ' index is " W:'$D(^AUPNVSK("AQ")) "not " W "present",!
 W !!!
 S DIR(0)="E" D ^DIR K DIRUT,DUOUT,DTOUT,DIR
EXIT K %Y
 Q
 ;
NEW W !!,"Q-Man indices have not been activated!",!!
 W "I can create the Q-Man indices now.  This will significantly improve the",!
 W "performance of Q-Man and reduce stress on the CPU.  However, the new indices",!
 W "will increase the size of the PCC database by approximately 1%"
 W !!,"Want me to create the indices?"
 S %=0 D YN^DICN K DIR,%
 I $E(%Y)=U!("Yy"'[%Y)!(%Y="")!($D(DUOUT))!($D(DTOUT)) K DUOUT,DTOUT,%Y Q
 W !,"OK, I'll run the job in background.  This job will take 1-72 hours to complete.",!!
MAILTASK S ZTRTN="JOB^AMQQMGR1",ZTDTH="NOW",ZTIO=""
 S ZTDESC="CREATE Q-MAN INDICES"
 D ^%ZTLOAD ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3
 Q
 ;
JOB ; IHS/OHPRD/JCM 11/9/94 reworked this whole section
 S G=U_"AUTTSITE",$P(@G@(1,0),U,19)="Y" K G,AMQQAQF
 I $P($G(^AUTTSITE(1,0)),U,19)'="Y" Q
 ;
VIMM ; re-indexing v immunization
 K ^AUPNVIMM("AQ")
 S DIK="^AUPNVIMM(",DIK(1)=".01^AQTOO" D ENALL^DIK K DIK
 ;
PAT ; re-indexing aq1 on Patient
 K AUPNPAT("AQ1")
 F DA=0:0 S DA=$O(^AUPNPAT(DA)) Q:'DA  S X=$P($G(^(DA,11)),U,10) K AMQQQXR D QXR I $D(AMQQQXR) S ^AUPNPAT("AQ1",AMQQQXR,DA)=""
 ;
VMSR ; re-indexing aq on v measurement
 K ^AUPNVMSR("AQ")
 F DA=0:0 S DA=$O(^AUPNVMSR(DA)) Q:'DA  S AUPNCIXF="S",AUPNCIXV=$G(^(DA,0)),X=$P(AUPNCIXV,U,4) I X'="" D VMSR04^AUPNCIX
 ;
VDXP ; Re-indexing AQ on V DIAGNOSTIC PROCEDURE RESULT
 K ^AUPNVDXP("AQ") S AMQQX=0 F  S AMQQX=$O(^AUPNVDXP(AMQQX)) Q:AMQQX'=+AMQQX  I $D(^AUPNVDXP(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVDXP(AMQQX,0),U,1),AUPNDXQF="S1" D ^AUPNVDXP
 ;
VXAM ;re-index AQ on V exam
 K ^AUPNVXAM("AQ") S AMQQX=0 F  S AMQQX=$O(^AUPNVXAM(AMQQX)) Q:AMQQX'=+AMQQX  I $D(^AUPNVXAM(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVXAM(AMQQX,0),U,1) D AQE1^AUPNCIXL
 ;
VSK ;re-index aq on v skin test
 K ^AUPNVSK("AQ") S AMQQX=0 F  S AMQQX=$O(^AUPNVSK(AMQQX)) Q:AMQQX'=+AMQQX  I $D(^AUPNVSK(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVSK(AMQQX,0),U,1) D AQS1^AUPNCIXL
 ;
VRAD ; re-index aq on v radiology
 K ^AUPNVRAD("AQ") S AMQQX=0 F  S AMQQX=$O(^AUPNVRAD(AMQQX)) Q:AMQQX'=+AMQQX  I $D(^AUPNVRAD(AMQQX,0))  S DA=AMQQX,X=$P(^AUPNVRAD(AMQQX,0),U,1) D AQR1^AUPNCIXL
 ;
VLAB ; re-index aq on v lab
 K ^AUPNVLAB("AQ") S AMQQX=0 F  S AMQQX=$O(^AUPNVLAB(AMQQX)) Q:AMQQX'=+AMQQX  I $D(^AUPNVLAB(AMQQX,0))  S DA=AMQQX,X=$P(^AUPNVLAB(AMQQX,0),U,1) D AQ1^AUPNCIXL
 ;
KILL K AMQQX,DA,DIE,DIK,AUPNDXQF
 Q
 ;
QXR ; ENTRY POINT
 I X="" Q
 N % S %=X N X
 I %["/" S %=(+%/$S($P(%,"/",2):$P(%,"/",2),1:1)) S:$E(%)="." %=0_%,AMQQQXR=$E(%,1,5)+1 S:'$D(AMQQQXR) AMQQQXR=%+1 Q
 S %=$S($E(%)="F":2,$E(%)="N":1,$E(%,1,3)="UNK":2.1,$E(%,1,3)="UNS":2.2,1:"")
 I %'="" S AMQQQXR=%
 Q
 ;

AMQQMGR4
AMQQMGR4 ; OHPRD/DG - OVERFLOW FROM AMQQMGR3 ; [ 02/12/97  9:42 AM ]
 ;;2;PCC QUERY UTILITY;**4,9**;SEP 5, 1993
LHEAD ; ENTRY POINT FROM AMQQMGR3 ; GETS HEADER INFO
 I 'AMQQLSPX S AMQQLTRM="" Q
 S AMQQLUNT=$P($G(^LAB(60,AMQQLDFN,1,AMQQLSPX,0)),U,7)
 S AMQQLHN=$P($G(^LAB(60,AMQQLDFN,.1)),U),AMQQLHL=$L(AMQQLHN),AMQQLOUT=""
 I AMQQLHN'="" G LHT
 S N=99 F I=1:1 S X=$P(AMQQLSTG,U,I) Q:X=""  I $L(X)<N S Y=X,N=$L(X)
 I N=99 Q
 S AMQQLHN=Y,AMQQLHL=N
LHT I AMQQLTYP=9 S %=$P(^LAB(60,AMQQLDFN,0),U,12),%=U_%_"0)",%=$P(@%,U,2),%=+$E(%,4,9) G LH1
 I AMQQLTYP=15 S %=8,AMQQLOUT="S X=$P(X,"" ""),X=$S(X="""":""??"",X=0:""Neg."",X=+X:(""1:""_X),1:X)" G LH1
 I AMQQLTYP=12 S AMQQLOUT="S X=$P(X,"" "") S:X'?1N X=""??"" S:X?1N X=X+1,X=$P(""Neg.;Trace;1+;2+;3+;4+"","";"",X)" G LH1
 I AMQQLTYP=11 S AMQQLOUT="S X=$S($E(X)=""P"",""Pos"",1:""Neg"")",%=4 G LH1
 I AMQQLTYP=6 S %=0,X=$P(^LAB(60,AMQQLDFN,0),U,12),X=U_X_"0)",X=$P(@X,U,3) D LOUT F I=1:1 S Y=$P(X,";",I) G:Y="" LH1 S Y=$P(Y,":",2),Y=$L(Y) I Y>% S %=Y
 I AMQQLTYP=2 S %=0,X=$P(^LAB(60,AMQQLDFN,0),U,12),X=U_X_"0)",X=$P(@X,U,5),%=+$P(X,"K:$L(X)>",2)
LH1 I (%+4)>AMQQLHL S AMQQLHL=(%+4)
 Q
 ;
LOUT S AMQQLOUT="N Y S Y="";"_X_""",X=$F(Y,("";""_X_"":"")),X=$E(Y,X,999),X=$P(X,"";"")"
 Q
 ;
CO ; ENTRY POINT FROM AMQQMGR3
 S %=^LAB(60,AMQQLDFN,0),%=$P(%,U),%=$P(%," ("),%=$P(%,"("),AMQQLC=%
 S AMQQLCO=% D CO2 I $D(AMQQLCOF) G COEXIT
 I $D(AMQQCONO) K AMQQCONO G COEXIT
 F AMQQLI=70:1:79 I $D(^LAB(60,AMQQLDFN,1,AMQQLI,0)) D CO1
COEXIT K AMQQLC,AMQQLCO,AMQQLI
 Q
 ;
CO1 S %=$P("BLOOD^URINE^SERUM^PLASMA^CSF^URETHRAL FLUID^PERITONEAL FLUID^PLEURAL FLUID^SYNOVIAL FLUID^CLOT",U,(AMQQLI-69)),AMQQLCO=AMQQLC_","_%
CO2 S %=$O(^AMQQ(5,"C",AMQQLCO,""))
 I '% W !,"Unable to find the companion test for ",$P(^LAB(60,AMQQLDFN,0),U) S AMQQCONO="" Q
 S DA(1)=%,X=AMQQLDFN
 S DIC="^AMQQ(5,"_DA(1)_",4.1,",DIC(0)="L"
 I '$D(^AMQQ(5,DA(1),4.1,0)) S ^(0)="^9009075.02PA^^"
 D ^DIC K DIC I Y'=-1 S AMQQLCOF=""
 W !,$P(^LAB(60,AMQQLDFN,0),U)," added as a companion test of ",AMQQLCO
 Q
 ;
TOP ; ENTRY POINT ; GETS TOP 40 LAB TESTS
 D CHECK ;IHS/OHPRD/TMJ 8/15/95 PATCH #9
 S I=$P(^AUPNVLAB(0),U,4)\500,G="^UTILITY(""AMQQ"",$J,""LU"")",Z="" K @G
 F X=0:0 S X=$O(^AUPNVLAB(X)) Q:'X  S Y=+^(X,0),%=$G(@G@(1,Y))+1,^(Y)=%,X=X+I W:X#2 "."
 F X=0:0 S X=$O(@G@(1,X)) Q:'X  S Y=^(X),@G@(2,(10000-Y),X)="" W:X#2 "."
 W !!!,?15,"*****  TOP 40 LAB TESTS  *****",!!!
 S I=0 F X=0:0 S X=$O(@G@(2,X)) Q:'X  F Y=0:0 S Y=$O(@G@(2,X,Y)) Q:'Y  S I=I+1 W:I#2 ! W:'(I#2) ?40 W I,") ",$E($P(^LAB(60,Y,0),U),1,30)," [",(10000-X),"]" S Z=Z_Y_U I I=40 G TOP1
TOP1 S AMQQLUST=Z D STUFF
 K @G,X,Y,Z,I,%
 Q
 ;
GET ; ENTRY POINT FOR 1 AT A TIME LAB TESTS
 D CHECK ;IHS/OHPRD/TMJ 8/15/95 PATCH #9
 S Z=""
 F  D  I Y=-1!($E(Y)=U) Q
 .I $L(Z)>235 S Y="" W !!,"I can't accept more new tests now.  If you want to add more, try again later",!! Q
 .S DIR(0)="PO^60:EMQ",DIR("A")="Lab test",DIR("?")="Enter the name of the test you want to add to the Q-Man metadictionary." D ^DIR K DIR
 .I +Y=175 D NEWGLU
 .I +Y=643 W "  <= It's already in there" Q
 .I $D(^AMQQ(5,1000+Y)) W "   <= It's already in there!" Q
 .I (U_Z)[(U_Y_U) W "   <= Already selected" Q
 .S Z=Z_Y_U
 .Q
 S AMQQLUST=Z D STUFF
 Q
 ;
STUFF W !!! F AMQQLSN=1:1 S X=$P(AMQQLUST,U,AMQQLSN) Q:X=""  D EN1^AMQQMGR3
 K AMQQLUST,AMQQLSN,X,Y,Z
 Q
 ;
LIST ; - EP - FROM ^AMQQMGR
 W !!! F X=1000:0 S X=$O(^AMQQ(5,X)) Q:'X  S Y=^(X,0),Y=$P(Y,U) W Y,", "
 K X,Y
 Q
 ;
CHECK ;
 S Z=0,X=$P(^AUPNVLAB(0),U,3)-1000 F I=1:1:1000  S X=$O(^AUPNVLAB(X)) Q:'X  I $P($G(^AUPNVLAB(X,11)),U,3) S Z=1 Q  ;IHS/OHPRD/JCM 5/31/94
 I Z
 W:'Z !!,"Specimen/site not entered into V LAB...Request cancelled",!!,*7 H 2
 K X,Z,I
 Q
 ;
NEWGLU S DA(1)=184,DIK="^AMQQ(5,"_DA(1)_",1,"
 F DA=0:0 S DA=$O(^AMQQ(5,184,1,DA)) Q:'DA  D ^DIK
 K DIK,DA
 Q
 ;

AMQQMGR5
AMQQMGR5 ; IHS/OHPRD/JCM - SECURE DEVICES ; [ 09/13/93 6:39 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**1**;JUN 10, 1993
 I $P($G(^AMQQ(8,DUZ(2),0)),U,10)'="" D OLD G EXIT
 D M2
EXIT K X,DIRUT,DIRDT,DUOUT,DTOUT,DISYS,C,DG,%,%Y
 Q
 ;
M2 W @IOF,!!,?15,"*****  IDENTIFY SECURE DEVICES FOR Q-MAN  *****",!!
 W !!,"You may want to define a group of ""secure devices"" for Q-Man.  If you choose"
 W !,"this option, Q-Man reports can only be displayed or printed on the devices you"
 W !,"specify.  First tell me if the set is ""inclusionary"" (all devices on your list"
 W !,"are secure) or ""exclusionary"" (all devices are secure unless they appear on"
 W !,"your list).  You may assign ""secure status"" to all devices or just the printers."
 W !,"Finally, I will ask you to enter the devices one at a time.",!
 S DIR(0)="SO^1:INCLUSIONARY (secure devices in list);2:EXCLUSIONARY (non-secure devices in list);0:EXIT (no device security requested)"
 S DIR("A")=$C(10)_"     Your choice"
 D ^DIR K DIR
 I Y=0 Q
 I Y=U Q
 D CHK I $D(AMQQQUIT) K AMQQQUIT Q
 I Y=2 G M2EX
 S DIR(0)="SO^1:ALL devices outside of your set are not secure;2:ONLY printers outside of your set are not secure;0:EXIT"
 S DIR("A")=$C(10)_"     Your choice"
 D ^DIR K DIR
 I Y=0!(Y=U) G M2
 D CHK I $D(AMQQQUIT) K AMQQQUIT G M2
 S AMQQMGRS=$S(Y=1:1,1:2) W !!
 G SECURE
M2EX S DIR(0)="SO^1:ALL devices outside of your set are secure;2:ONLY printers outside of your set are secure;0:EXIT"
 S DIR("A")=$C(10)_"     Your choice"
 D ^DIR K DIR
 I Y=0!(Y=U) G M2
 D CHK I $D(AMQQQUIT) K AMQQQUIT G M2
 S AMQQMGRS=$S(Y=1:3,1:4) W !!
SECURE S DR=".1////"_$S(AMQQMGRS<3:"I",1:"E")_";.09////"_$S(AMQQMGRS#2:"A",1:"P")
 S DA=DUZ(2),DIE="^AMQQ(8," D ^DIE K DIE,DA,DR,DIC
 D ED
 Q
 ;
OLD ;
 W @IOF,!!,?20,"*****  DEVICE MANAGEMENT  *****",!!!,"Current status =>",!!
 S %=^AMQQ(8,DUZ(2),0)
 I $P(%,U,10)="I" W !,"INCLUSIONARY PROTOCOL (All devices on the list are secure)",!
 E  W !,"EXCLUSIONARY PROTOCOL (All devices on the list are NOT secure)",!
 I $P(%,U,9)="A" W !,"ALL DEVICES (terminals and printers) NEED SECURITY CLEARANCE",!
 E  W !,"ONLY PRINTERS NEED SECURITY CLEARANCE",!
 W !,"CURRENT LIST OF ",$S($P(%,U,10)="I":"",1:"NON-"),"SECURE DEVICES: ",!
 S N=0 F X=0:0 S X=$O(^AMQQ(8,DUZ(2),1,X)) Q:'X  D STOP S (Y,%)=^(X,0),%=$P(^%ZIS(1,%,0),U) W ?3,%,?20,$P(^%ZIS(2,^%ZIS(1,Y,"SUBTYPE"),0),U),?48,$P($G(^%ZIS(1,Y,1)),U) ;IHS/OHPRD/JCM 9/13/93
 S DIR(0)="SO^1:CLEAR the device list and start over;2:EDIT the device list;0:EXIT",DIR("A")="What do you want to do now",DIR("B")="EXIT" D ^DIR K DIR
 I $D(DIRUT)+$D(DUOUT)+$D(DTOUT)+'Y K DIRUT,DTOUT,DUOUT G EXIT
 I Y=1 D CLEAR Q
 I Y=2 D EDIT
 Q
 ;
CLEAR D WAIT^DICD
 S DA(1)=DUZ(2),DIK="^AMQQ(8,"_DA(1)_",1,"
 F DA=0:0 S DA=$O(^AMQQ(8,DA(1),1,DA)) Q:'DA  D ^DIK W "."
 S DR=".1///@;.09///@",DIE="^AMQQ(8,",DA=DUZ(2) D ^DIE
 K DIK,DA,DR,DIC,D,D0,DI,DIE,DQ
 Q
 ;
EDIT I '$D(^AMQQ(8,DUZ(2),1,1)) W !!,"Sorry, there are no devices in the file to edit.",!!,*7 Q
ED S DA(1)=DUZ(2),DIC("P")=$P(^DD(9009078,1,0),U,2),DIC="^AMQQ(8,"_DA(1)_",1,",DIC(0)="AEQLM"
 D ^DIC K DIC,DA
 I (Y=-1)+$D(DTOUT)+$D(DUOUT)+($E(X)=U) K DUOUT,DTOUT Q
 I $P(Y,U,3) D SCREEN G ED
 W !,?3,"This device is already in the file.  Want to remove it" S %=2 D YN^DICN
 I $D(DTOUT)+$D(DUOUT) K DTOUT,DUOUT Q
 I "Nn"[$E(%Y) G ED
 S DA=+Y,DA(1)=DUZ(2),DIK="^AMQQ(8,"_DA(1)_",1," D ^DIK W !!,"DEVICE REMOVED FROM LIST"
 K %Y,Y,X,DIK,DA,DIC,D0,DI,DISYS
 G ED
 ;
CHK I $D(DTOUT)+$D(DUOUT)+(Y=-1)+(Y="") K DIRUT,DUOUT,DTOUT S AMQQQUIT="" Q
 Q
 ;
STOP N X S N=N+1 W !
 I N=15 S N=0 R "<>",X:DTIME W *13,?79,*13
 Q
 ;
SCREEN I $P(^AMQQ(8,DUZ(2),0),U,9)'="P" Q
 I $P(^%ZIS(2,^%ZIS(1,$P(Y,U,2),"SUBTYPE"),0),U)["P-" Q
 W !!,"SORRY...This device must be a printer!",!!,*7
 S DA(1)=DUZ(2),DA=+Y,DIK="^AMQQ(8,"_DA(1)_",1," D ^DIK
 K DIK,DA,DIC,D0,DI,DQ S Y=-1
 Q
 ;

AMQQMUL1
AMQQMUL1 ; IHS/OHPRD/JCM - COLLECTS MULTIPLE VALUES FOR POVS, PROCEDURES, RXS, ADAS ETC. ; [ 04/26/2000  6:13 PM ]
 ;;2;PCC QUERY UTILITY;**7,16**;JUN 10, 1993
VAR F I=1:1:19 S X=$P("GR;ID;ST;FIN;LAST;VAL1;SPEC;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I) S @("AMQQ"_X)=$P(AMQQX,";",I)
 I '$D(AMQQAG) S AMQQAG="AG"
 I '$D(AMQQSQVN) S AMQQ=U_AMQQGR_"(""A"_$S(AMQQGR="AUPNVPRV":"C",1:"A")_""",AMQP(0))"
 E  S AMQQ=U_AMQQGR_"(""AD"","_AMQQSQVN_")",%=+^AUPNVSIT(AMQQSQVN,0) G:'% EXIT S AMQQVDAT=(9999999-%)\1,AMQQVSIT=AMQQSQVN
 S AMQQVAL1=+AMQQVAL1
 S AMQQMSS=+AMQQMSS,AMQQMPC=AMQQMPC+'AMQQMPC
 S AMQQHOLD=0,AMQT(AMQQT)=0,AMQQLCNT=0
 K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
 I $E(AMQQST)?1P,'$D(AMQQSQVN) D REL^AMQQMULS
 I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
 I '$D(AMQQSQVN),'$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
 I $G(AMQQSPEC)="EXISTS",AMQQSTRT=2,'AMQQST,'AMQQUSQN,AMQQFIN=9999999,AMQQLAST=9999999 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="+",AMQP(AMQQFVAR)="+",AMQT(AMQQT)=1 G EXIT
RUN I '$D(AMQQSQVN),AMQQGR="AUPNVHF" D HINC G SQ ;IHS/OHPRD/GS 3/20/95
 I '$D(AMQQSQVN),AMQQGR'="AUPNVPRV" D INC G SQ
 S AMQQVNO=0 D VINC ;IHS/OHPRD/GS 3/20/95
SQ I $D(AMQV("SQ")) D ^AMQQMULS
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL"!(AMQQSPEC="INVERSE") K ^(AMQQUATN) G EXIT
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC'="NULL",AMQQSPEC'="ANY",AMQQSPEC'="INVERSE"
 E  S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="-",AMQP(AMQQFVAR)="-",AMQT(AMQQT)=1
 G EXIT
TRUE I AMQQSPEC="EXISTS" K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)="+",AMQP(AMQQFVAR)="+"
 S AMQT(AMQQT)=1
EXIT I AMQQAG="SAG" K ^UTILITY("AMQQ",$J,"SAG",AMQQUATN)
 D EXIT3^AMQQKILL
 Q
 ;
INC S AMQQVDAT=9999999-AMQQFIN
INCDATE S AMQQVDAT=$S(AMQQGR'["AUPNVRAD"&(AMQQGR'["AUPNVCPT"):$O(@AMQQ@(AMQQVDAT)),1:$O(@AMQQ@(AMQP(.1),AMQQVDAT))) ;IHS/CMI/THL PATCH 16
 I AMQQVDAT'=+AMQQVDAT Q
 I (9999999-AMQQVDAT)'>AMQQST Q
 S AMQQVNO=0
INCITEM S AMQQVNO=$S(AMQQGR'["AUPNVRAD"&(AMQQGR'["AUPNVCPT"):$O(@AMQQ@(AMQQVDAT,AMQQVNO)),1:$O(@AMQQ@(AMQP(.1),AMQQVDAT,AMQQVNO))) ;IHS/CMI/THL PATCH 16
 I 'AMQQVNO G INCDATE
 I AMQQGR="AUPNVPOV",'$D(AMQP(3)) S AMQP(3)=AMQQVNO
 S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
 I $D(@%),$D(^(0)) S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC),AMQQVSIT=$P(^(0),U,3) D SET I 1
 E  G INCITEM
 I AMQQLCNT=AMQQLAST Q
 I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1 Q
 G INCITEM
 ;
SET I AMQQVALU="" Q
 I '$D(^UTILITY("AMQQ TAX",$J,AMQQVAL1,AMQQVALU)),'$D(^("*")),'$D(^("-")) Q
S1 S AMQQHOLD=AMQQHOLD+1,AMQQLCNT=AMQQLCNT+1
 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-AMQQVDAT)_U_AMQQVSIT_U_AMQQVNO
 K AMQQOK
 Q
 ;
VINC S AMQQVNO=$O(@AMQQ@(AMQQVNO))
 I 'AMQQVNO Q
 S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
 I $D(@%),$D(^(0)) S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC) S:AMQQGR="AUPNVPRV" AMQQVSIT=$P(^(0),U,3),AMQQVDAT=9999999-(+^AUPNVSIT(AMQQVSIT,0)) D SET I 1
 E  G VINC
 I AMQQLCNT=AMQQLAST Q
 I AMQQSPEC="NULL"!(AMQQSPEC="EXISTS")!(AMQQSPEC="INVERSE") Q
 G VINC
 ;
HINC N AMQQHFNO,AMQQOLD S AMQQOLD=AMQQ N AMQQ ;IHS/OHPRD/GS 3/20/95
 S AMQQ=U_AMQQGR_"(""AA"",AMQP(0),AMQQHFNO)"
 F AMQQHFNO=0:0 S AMQQHFNO=$O(@AMQQOLD@(AMQQHFNO)) Q:'AMQQHFNO  D INC
 Q
 ;
CHS ; ENTRY POINT FROM METADICTIONARY
 I '$D(AMQQAG) S AMQQAG="AG"
 N Y,Z,% S X=""
 S %=^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD),Z=^AUPNVCHS($P(%,U,4),0) I %=""!(Z="") S X="??" Q
 S Y=$P(%,U,4) I Y'="" S X="#"_Y_" "
 S Y=$P(%,U,2) I Y X ^DD("DD") S X=X_Y_" "
 S Y=$P(Z,U,14) I Y S Y=$P(^AUTTVNDR(Y,0),U),Y=$E(Y,1,12) I Y'="" S X=X_Y_"  "
 D LOS I Y'="" S X=X_"("_Y_" days) "
 S Y=$P(Z,U,6) I Y'="" S X=X_"$"_Y
 Q
 ;
LOS S Y=% N H,%,%H,%Y,%T,X,Z S %=Y
 S Y=$P(%,U,2),Z=$P(%,U,4),Z=$P(^AUPNVCHS(Z,0),U,7)
 I 'Z!('Y) S Y="" Q
 F X=Z,Y D H^%DTC S:$D(Z) H=+%H S:'$D(Z) Y=H-(+%H) K Z
 Q
 ;

AMQQMUL2
AMQQMUL2 ; IHS/OHPRD/JCM - COLLECTS MULTIPLE VALUES FOR VISITS ; [ 09/06/95 10:14 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
VAR F I=1:1:19 S X=$P("GR;ID;ST;FIN;LAST;VAL1;VAL2;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I) S @("AMQQ"_X)=$P(AMQQX,";",I)
 S AMQQ=U_AMQQGR_"(""AA"","_AMQP(0)_")",AMQQSPEC=""
 I '$D(AMQQAG) S AMQQAG="AG"
 I '$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
 S AMQQMSS=+AMQQMSS,AMQQMPC=AMQQMPC+'AMQQMPC,AMQQHOLD=0,AMQT(AMQQT)=0,AMQQLCNT=0,AMQQSPEC=""
 I AMQQVAL1["~~" S AMQQSPEC=AMQQVAL2,AMQQVAL2=$P(AMQQVAL1,"~~",2),AMQQVAL1=$P(AMQQVAL1,"~~")
 K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
 I $E(AMQQST)?1P,'$D(AMQQSQVN) D REL^AMQQMULS
 I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
RUN D INC
SQ I $D(AMQV("SQ")) D ^AMQQMULS
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL" K ^(AMQQUATN) G EXIT
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)) S AMQP(AMQQFVAR)=$P(^(1),U)
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC="NULL"!(AMQQSPEC="ANY") S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="-",AMQP(AMQQFVAR)="-",AMQT(AMQQT)=1
 G EXIT
TRUE I AMQQSPEC="EXISTS" K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)="+",AMQP(AMQQFVAR)="+"
 S AMQT(AMQQT)=1
EXIT I AMQQAG="SAG" K ^UTILITY("AMQQ",$J,"SAG",AMQQUATN)
 D EXIT3^AMQQKILL
 Q
 ;
INC I AMQQ["AUPNVSIT" S AMQQVDAT=9999999-$P(AMQQFIN,".") ;IHS/OHPRD/JCM 1/27/94
 E  S AMQQVDAT=9999999-AMQQFIN ;IHS/OHPRD/JCM 1/27/94
INCDATE S AMQQVDAT=$O(@AMQQ@(AMQQVDAT))
 I AMQQVDAT'=+AMQQVDAT Q
 I AMQQ["AUPNVSIT" Q:(9999999-$P(AMQQVDAT,"."))<$P(AMQQST,".")  G:$P(AMQQVDAT,".",2)']$P(AMQQST,".",2)&((9999999-$P(AMQQVDAT,"."))=$P(AMQQST,".")) INCDATE
 E  I (9999999-AMQQVDAT)'>AMQQST Q
 S AMQQVSIT=0
INCITEM S (AMQQVNO,AMQQVSIT)=$O(@AMQQ@(AMQQVDAT,AMQQVSIT))
 I 'AMQQVSIT G INCDATE
 I $P($G(^AUPNVSIT(AMQQVSIT,0)),U,11) G INCITEM ; IHS/ORPRD/TMJ 7/13/95
 I 'AMQQMSS,AMQQMPC=1 S AMQQVALU=(9999999-$P(AMQQVDAT,".")) D S1 G CNT
 S %=U_AMQQGR_"("_AMQQVSIT_","_AMQQMSS_")"
 I $D(@%) S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC) D SET I 1
 E  G INCITEM
CNT I AMQQLCNT=AMQQLAST Q
 I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1 Q
 G INCITEM
 ;
SET I AMQQVALU="",$L(AMQQVAL1)>1,AMQQNNA'=5 Q
 I AMQQITR'="" S X=AMQQVALU X AMQQITR S AMQQVALU=X
 I $D(AMQQNNA),AMQQNNA>1 X "I 0" D ^AMQQMULN D:$T S1 Q
 I AMQQVAL2'=+AMQQVAL2 D TEXT^AMQQFAN D:$T S1 Q
 S AMQQVALU=+AMQQVALU
 I AMQQVAL1>AMQQVAL2,AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1) D S1 Q
 I AMQQVALU=AMQQVAL1,AMQQVALU=AMQQVAL2 D S1 Q
 I AMQQVALU>AMQQVAL1,AMQQVALU<AMQQVAL2 D S1
 Q
 ;
S1 S AMQQLCNT=AMQQLCNT+1,AMQQHOLD=AMQQHOLD+1
 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-$P(AMQQVDAT,"."))_U_AMQQVSIT_U_AMQQVNO
 Q
 ;

AMQQMUL3
AMQQMUL3 ; IHS/OHPRD/JCM - ICD MATCH FROM VISIT OR PROBLEM LIST ; [ 12/22/94 4:56 PM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**2,4,6**;JUN 10, 1993
 D MULT
 Q
 ;
ICD ; ENTRY POINT FROM METADICTIONARY
 S AMQP(3.1)=AMQP(.3)
 I '$D(AMQP("ICD")) S AMQP("ICD")=1
 I AMQP("ICD")=2 G PROB
VISIT S AMQP(.3)=$O(^AUPNVPOV("B",AMQP(.1),AMQP(.3)))
 I 'AMQP(.3) S AMQP("ICD")=2,AMQP(.2)=0 G PROB
 S %=$P($G(^AUPNVPOV(AMQP(.3),0)),U,2) I '% G VISIT
 I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=% Q
 G VISIT
 ;
PROB ; ENTRY POINT FROM METADICTIONARY
 S AMQP(.2)=$O(^AUPNPROB("B",AMQP(.1),AMQP(.2)))
 I 'AMQP(.2) K AMQP("ICD") S AMQP(.3)=0 Q
 S AMQP(3.1)=AMQP(.2),%=$P($G(^AUPNPROB(AMQP(3.1),0)),U,2) I '% G PROB
 I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=%,AMQP(.3)=1 Q
 G PROB
 ;
FAMHX ; ENTRY POINT FROM METADICTIONARY
 S AMQP(.2)=$O(^AUPNFH("B",AMQP(.1),AMQP(.2)))
 I 'AMQP(.2) K AMQP("ICD") Q
 S AMQP(3.1)=AMQP(.2),%=$P($G(^AUPNFH(AMQP(3.1),0)),U,2) I '% G FAMHX
 I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=% Q
 G FAMHX
 Q
 ;
PERSHX ; ENTRY POINT FROM METADICTIONARY
 S AMQP(.2)=$O(^AUPNPH("B",AMQP(.1),AMQP(.2)))
 I 'AMQP(.2) K AMQP("ICD") Q
 S AMQP(3.1)=AMQP(.2),%=$P($G(^AUPNPH(AMQP(3.1),0)),U,2) I '% G PERSHX
 I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=% Q
 G PERSHX
 Q
 ;
HLTHSTAT ; ENTRY POINT FROM METADICTIONARY
 S AMQP(.2)=$O(^AUPNHF("B",AMQP(.1),AMQP(.2)))
 I 'AMQP(.2) Q
 S AMQP(3.1)=AMQP(.2),%=$P($G(^AUPNHF(AMQP(3.1),0)),U,2) I '% G HLTHSTAT
 I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=% Q
 G HLTHSTAT
 Q
 ;
TEST ; ENTRY POINT FROM METADICTIONARY
 F AMQQY="^AUPNPROB","^AUPNVPOV" Q:$D(AMQQSTP)  F AMQP(3.1)=0:0 Q:$D(AMQQSTP)  S AMQP(3.1)=$O(@AMQQY@("AC",AMQP(0),AMQP(3.1))) Q:'AMQP(3.1)  S %=+@AMQQY@(AMQP(3.1),0) I % D
 . I $D(^UTILITY("AMQQ TAX",$J,AMQQX,%))+$D(^("*")),'$D(^("--")) S AMQQSTP=1 Q
 . I $D(^UTILITY("AMQQ TAX",$J,AMQQX,%)),$D(^("--")) S AMQQSTP=0 Q
 I '$D(AMQQSTP),$D(^UTILITY("AMQQ TAX",$J,AMQQX,"--")) S AMQQSTP=1
 I $G(AMQQSTP)
TEXIT K AMQQX,AMQQY,AMQQSTP
 Q
 ;
WEED ; ENTRY POINT FROM METADICTIONARY
 S AMQQY="^AUPNPROB" F AMQP(3.1)=0:0 Q:$D(AMQQSTP)  S AMQP(3.1)=$O(@AMQQY@("AC",AMQP(0),AMQP(3.1))) Q:'AMQP(3.1)  S %=+@AMQQY@(AMQP(3.1),0) I % D
 . I $D(^UTILITY("AMQQ TAX",$J,AMQQX,%))+$D(^("*")),'$D(^("--")) S AMQQSTP=1 Q
 . I $D(^UTILITY("AMQQ TAX",$J,AMQQX,%)),$D(^("--")) S AMQQSTP=0 Q
 I '$D(AMQQSTP),$D(^UTILITY("AMQQ TAX",$J,AMQQX,"--")) S AMQQSTP=1
 I $G(AMQQSTP)
WEXIT K AMQQX,AMQQY,AMQQSTP
 Q
 ;
MULT ;
VAR F I=1:1:19 S X=$P("GR;ID;ST;FIN;LAST;VAL1;SPEC;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I) S @("AMQQ"_X)=$P(AMQQX,";",I)
 I '$D(AMQQAG) S AMQQAG="AG"
 S AMQQ="^"_$S($P(AMQQX,";")="AUPNPROB":"AUPNPROB",$P(AMQQX,";")="AUPNPH":"AUPNPH",$P(AMQQX,";")="AUPNHF":"AUPNHF",1:"AUPNFH")_"(""AC"",AMQP(0))" D
 . S AMQQVAL1=+AMQQVAL1,AMQQMSS=+AMQQMSS,AMQQMPC=AMQQMPC+'AMQQMPC,AMQQAG="AG",AMQQHOLD=0,AMQT(AMQQT)=0,AMQQLCNT=0
 K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
 I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
 I '$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
 I AMQQSPEC="NULL" G EXIT ;IHS/OHPRD/GIS 9/10/94
RUN D INC
SQ I $D(AMQV("SQ")) D ^AMQQMULS
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL"!(AMQQSPEC="INVERSE") K ^(AMQQUATN) G EXIT
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC'="NULL",AMQQSPEC'="ANY",AMQQSPEC'="INVERSE"
 E  S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="-",AMQP(AMQQFVAR)="-",AMQT(AMQQT)=1
 G EXIT
TRUE I AMQQSPEC="EXISTS" K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)="+",AMQP(AMQQFVAR)="+"
 S AMQT(AMQQT)=1
EXIT I AMQQAG="SAG" K ^UTILITY("AMQQ",$J,"SAG",AMQQUATN)
 D EXIT3^AMQQKILL
 Q
 ;
INC F AMQQVNO=0:0 S (AMQQVNO,AMQP(3.1))=$O(@AMQQ@(AMQQVNO)) Q:'AMQQVNO  D SETAG I AMQQLCNT=-1 Q
 Q
 ;
SETAG S AMQQGLOR="^"_$P(AMQQX,";")
 S %=+@AMQQGLOR@(AMQQVNO,0)
 I $D(^UTILITY("AMQQ TAX",$J,AMQQVAL1,%))+$D(^("*"))+$D(^("-")) S AMQQHOLD=AMQQHOLD+1,AMQQLCNT=AMQQLCNT+1,^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVNO_"^^^"_AMQQVNO ;IHS/OHPRD/JCM 10/13/93
 I AMQQSPEC="NULL"!(AMQQSPEC="EXISTS"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1
 Q
 ;
NARR ; ENTRY POINT FROM METADICTIONARY
 N %,Y,Z
 I '$D(^AUPNPROB(X,0)) S X="??" Q
 S %=^AUPNPROB(X,0),X=""
 S Y=$P(%,U,6),Y=$P($G(^AUTTLOC(Y,0)),U,7),X=Y_$P(%,U,7)_"("_$P(%,U,12)_")  "
 S Y=$P(%,U,5),Y=$P($G(^AUTNPOV(Y,0)),U),Y=$S($L(Y)>37:($E(Y,1,35)_"..."),1:$E(Y,1,37)),X=X_Y
 S Y=$P(%,U),Y=$P($G(^ICD9(Y,0)),U) I Y'="" S Y=" ["_Y_"]"
 S X=X_Y
 Q
 ;
NOTE(S,C,V,L) ; CHECK PROBLEM NOTE ;IHS/OHPRD/JCM 1/25/94  ADDED THIS SUBROUTINE
 N X,Y,Z
 S AMQT(L)=0 I '$D(^AUPNPROB(AMQP(S),11)) Q
 S X=0 F  S X=$O(^AUPNPROB(AMQP(S),11,X)) Q:'X  S Y=0 F  S Y=$O(^AUPNPROB(AMQP(S),11,X,11,Y)) Q:'Y  S Z=$P(^(Y,0),U,3) D  I AMQT(L) S (X,Y)="~" Q
 . X ("I Z"_C_""""_V_""" S AMQT(L)=1")
 . Q
 Q

AMQQMUL4
AMQQMUL4 ; IHS/OHPRD/JCM - HOSPITALIZATIONS ; [ 10/14/93 11:43 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**2**;JUN 10, 1993
VAR F I=1:1:19 S X=$P("GR;ID;ST;FIN;LAST;VAL1;VAL2;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I) S @("AMQQ"_X)=$P(AMQQX,";",I)
 I '$D(AMQQAG) S AMQQAG="AG"
 S AMQQ="^AUPNVSIT(""AAH"","_AMQP(0)_")"
 S AMQQMSS=+AMQQMSS,AMQQMPC=AMQQMPC+'AMQQMPC,AMQQHOLD=0,AMQT(AMQQT)=0,AMQQLCNT=0,AMQQSPEC=""
 S AMQQSPEC="" I AMQQVAL1["~~" S AMQQSPEC=AMQQVAL2,AMQQVAL2=$P(AMQQVAL1,"~~",2),AMQQVAL1=$P(AMQQVAL1,"~~")
 I '$D(AMQQAG) S AMQQAG="AG"
 K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
 I '$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
 I $E(AMQQST)?1P,'$D(AMQQSQVN) D REL^AMQQMULS
 I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
RUN D INC
SQ I $D(AMQV("SQ")) D ^AMQQMULS
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL" K ^(AMQQUATN) G EXIT
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)) S AMQP(AMQQFVAR)=$P(^(1),U)
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC="NULL"!(AMQQSPEC="ANY") S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="-",AMQP(AMQQFVAR)="-",AMQT(AMQQT)=1
 G EXIT
TRUE I AMQQSPEC="EXISTS" K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)="+",AMQP(AMQQFVAR)="+"
 S AMQT(AMQQT)=1
EXIT I AMQQAG="SAG" K ^UTILITY("AMQQ",$J,"SAG",AMQQUATN)
 D EXIT3^AMQQKILL
 Q
 ;
INC S AMQQVDAT=9999999-AMQQFIN
INCDATE S AMQQVDAT=$O(@AMQQ@(AMQQVDAT))
 I AMQQVDAT'=+AMQQVDAT Q
 I (9999999-AMQQVDAT)'>AMQQST Q
 S AMQQVSIT=0
INCVIS S AMQQVSIT=$O(@AMQQ@(AMQQVDAT,AMQQVSIT))
 I 'AMQQVSIT G INCDATE
 I '$D(^AUPNVSIT(AMQQVSIT)) G INCVIS
 S AMQQVNO=0
INCINP S AMQQVNO=$O(^AUPNVINP("AD",AMQQVSIT,AMQQVNO))
 I 'AMQQVNO G INCVIS
 S AMQQVALU=9999999-(AMQQVDAT\1),AMQQLCNT=AMQQLCNT+1,AMQQHOLD=AMQQHOLD+1 ;IHS/OHPRD/JCM 10/14/93
 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-AMQQVDAT)_U_AMQQVSIT_U_AMQQVNO
CNT I AMQQLCNT=AMQQLAST Q
 I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1 Q
 G INCINP
 ;
SUMMARY ; ENTRY POINT FROM METADICTIONARY
 I '$D(AMQQAG) S AMQQAG="AG"
 N Y,Z,% S X=""
 S %=^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)
 S Y=+% I Y S Z(1)=Y X ^DD("DD")
 I Y=0 S Y="??"
 S X=X_Y_"=>"
 S Y=$P(%,U,4),Y=+$G(^AUPNVINP(Y,0)) I Y S Z(2)=Y X ^DD("DD")
 I Y=0 S Y="??"
 S X=X_Y
 I Z(2),Z(1) D LOS I 1
 E  G SERVICE
 S X=X_" ("_Y_" days)  "
SERVICE S Y=$P(%,U,4),Y=$P($G(^AUPNVINP(Y,0)),U,4) I Y S Y=$P($G(^DIC(45.7,Y,0)),U) S Y=$E(Y,1,20)
 S X=X_Y
 Q
 ;
LOS N X,%H,%T,%Y,%
 S X=Z(1) D H^%DTC S Z=+%H
 S X=Z(2) D H^%DTC S Y=+%H-Z
 Q
 ;

AMQQMULP
AMQQMULP ; IHS/OHPRD/JCM - PROVIDER CRITERIA ; [ 09/06/95 7:25 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**1,2,4,8**;SEP 5, 1993
VAR S %=AMQQX,AMQQSQPS=+%,AMQQSQP1=$P(%,";",2),AMQQSQP2=$P(%,";",3),AMQQSQPZ=$P(%,";",4)
 S AMQQSQPG="^UTILITY(""AMQQ"",$J,""PRO"")" K @AMQQSQPG
RUN K AMQP(5) I '$G(AMQP(1)) S AMQT(AMQQSQPZ)=0 G EXIT ;IHS/OHPRD/JCM 9/13/93
 N X,A,B,C
 I '$D(^AUPNVPRV("AD",AMQP(1))) D  I 1
 . I '$D(AMQQGR) Q  ;IHS/OHPRD/JCM 10/12/93
 . I $G(AMQQGR)'["VMED",$G(AMQQGR)'["VLAB" D  I 1
 .. S A=0,B="^"_AMQQGR
 .. F  Q:$D(X)  S A=$O(@B@("AD",AMQP(1),A)) Q:'A  I +@B@(A,0)=AMQQVALU S X=$P(^(0),U,$S(B["VMED":9,1:7))
 .. Q
 . E  S X=$S(AMQQGR["VMED":$P($G(^AUPNVMED(+$G(AMQP(.11)),0)),U,9),1:$P($G(^AUPNVLAB(+$G(AMQP(.2)),0)),U,7))
 . I $G(X)]"" S @AMQQSQPG@(X)="",AMQP(5)=X
 . Q
 E  F AMQQSQPD=0:0 S AMQQSQPD=$O(^AUPNVPRV("AD",AMQP(1),AMQQSQPD)) Q:'AMQQSQPD  S X=^AUPNVPRV(AMQQSQPD,0) D PASS1
 I $D(@AMQQSQPG) D PASS2
CK S AMQT(AMQQSQPZ)=$D(@AMQQSQPG)
 I AMQT(AMQQSQPZ),'$D(AMQP(5)) D PRIME
EXIT K @AMQQSQPG,AMQQSQPS,AMQQSQP1,AMQQSQP2,AMQQSQPT,AMQQSQPN,AMQQSQPG,AMQQSQPZ,AMQQSQPD
 Q
 ;
PASS1 I AMQQSQPS=3 G SET1
 S Y=$P(X,U,4)
 I AMQQSQPS=1,Y'="P" Q
 I AMQQSQPS=2,Y'="S" Q
SET1 S @AMQQSQPG@(+X)=""
 Q
 ;
PASS2 N AMQP S AMQQSQPN=AMQQSQP1-.001
 F  S AMQQSQPN=$O(AMQV("QQ",AMQQSQPN)) Q:'AMQQSQPN  Q:AMQQSQPN>AMQQSQP2  S AMQQSQPT=AMQV("QQ",AMQQSQPN,1) D TEST
 Q
 ;
TEST F AMQP(5)=0:0 S AMQP(5)=$O(^UTILITY("AMQQ",$J,"PRO",AMQP(5))) Q:'AMQP(5)  X AMQQSQPT I  K ^UTILITY("AMQQ",$J,"PRO",AMQP(5))
 Q
 ;
POV ; ENTRY POINT FROM METADICTIONARY
 N X,Y,Z,%,A
 S X=+AMQQX,Y=$P(AMQQX,";",4),Z=0,A=$P(AMQQX,";",5)
 I $D(^UTILITY("AMQQ TAX",$J,X,"--")) D POV1 Q
 I $D(^UTILITY("AMQQ TAX",$J,X,"-")) S AMQT(Y)='$D(^AUPNVPOV("AD",AMQP(1))),AMQP(A)="-" Q  ;IHS/OHPRD/JCM 1/20/94
 F  S Z=$O(^AUPNVPOV("AD",AMQP(1),Z)) Q:'Z  S %=$P($G(^AUPNVPOV(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%))+$D(^("*")) S AMQP(A)="+" G POVEXIT
 S AMQT(Y)=0 Q
POVEXIT S AMQT(Y)=1
 Q
 ;
POV1 F  S Z=$O(^AUPNVPOV("AD",AMQP(1),Z)) Q:'Z  S %=$P($G(^AUPNVPOV(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%)) G POVEXIT1
 S AMQT(Y)=1,AMQP(A)="-" Q
POVEXIT1 S AMQT(Y)=0
 Q
 ;
PRIME N %,X S AMQP(5)="??"
 F %=0:0 S %=$O(^AUPNVPRV("AD",AMQP(1),%)) Q:'%  S X=$G(^AUPNVPRV(%,0)) I $P(X,U,4)="P" S AMQP(5)=+X Q
 Q
 ;
PRC ; ENTRY POINT FROM METADICTIONARY ;IHS/OHPRD/JCM 3/10/94
 N X,Y,Z,%,A
 S X=+AMQQX,Y=$P(AMQQX,";",4),Z=0,A=$P(AMQQX,";",5)
 I $D(^UTILITY("AMQQ TAX",$J,X,"--")) D PRC1 Q
 I $D(^UTILITY("AMQQ TAX",$J,X,"-")) S AMQT(Y)='$D(^AUPNVPRC("AD",AMQP(1))),AMQP(A)="-" Q  ;IHS/OHPRD/JCM 1/20/94
 F  S Z=$O(^AUPNVPRC("AD",AMQP(1),Z)) Q:'Z  S %=$P($G(^AUPNVPRC(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%))+$D(^("*")) S AMQP(A)="+" G PRCEXIT
 S AMQT(Y)=0 Q
PRCEXIT S AMQT(Y)=1
 Q
 ;
PRC1 F  S Z=$O(^AUPNVPRC("AD",AMQP(1),Z)) Q:'Z  S %=$P($G(^AUPNVPRC(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%)) G PRCEXIT1
 S AMQT(Y)=1,AMQP(A)="-" Q
PRCEXIT1 S AMQT(Y)=0
 Q
 ;
CPT ;EP METADICTIONARY; IHS/OHPRD/TMJ 8/8/95
 N X,Y,Z,%,A
 S X=+AMQQX,Y=$P(AMQQX,";",4),Z=0,A=$P(AMQQX,";",5)
 I $D(^UTILITY("AMQQ TAX",$J,X,"--")) D CPT1 Q
 I $D(^UTILITY("AMQQ TAX",$J,X,"-")) S AMQT(Y)='$D(^AUPNVCPT("AD",AMQP(1))),AMQP(A)="-" Q  ;IHS/OHPRD/JCM 1/20/94
 F  S Z=$O(^AUPNVCPT("AD",AMQP(1),Z)) Q:'Z  S %=$P($G(^AUPNVCPT(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%))+$D(^("*")) S AMQP(A)="+" G POVEXIT
 S AMQT(Y)=0 Q
 ;
CPTEXIT ;
 S AMQT(Y)=1
 Q
 ;
CPT1 ;
 F  S Z=$O(^AUPNVCPT("AD",AMQP(1),Z)) Q:'Z  S %=$P($G(^AUPNVCPT(Z,0)),U) I %,$D(UTILITY("AMQQ TAX",$J,X,%)) G CPTEXIT1
 S AMQT(Y)=1,AMQP(A)="-" Q
 ;
CPTEXIT1 ;
 S AMQT(Y)=0
 Q
 ;

AMQQMULT
AMQQMULT ; OHPRD/DG - COLLECTS MULTIPLE VALUES ; [ 04/07/97  3:30 PM ]
 ;;2;PCC QUERY UTILITY;**6,10**;APR 5, 1997
VAR F I=1:1:19 S X=$P("GR;ID;ST;FIN;LAST;VAL1;VAL2;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I) S @("AMQQ"_X)=$P(AMQQX,";",I)
 I '$D(AMQQAG) S AMQQAG="AG"
 I '$D(AMQQSQVN) S AMQQ=U_AMQQGR_"(""AA"",AMQP(0))"
 E  S AMQQ=U_AMQQGR_"(""AD"","_AMQQSQVN_")",%=+^AUPNVSIT(AMQQSQVN,0) G:'% EXIT S AMQQVDAT=(9999999-%)\1
 S AMQQSPEC="" I AMQQVAL1["~~" S AMQQSPEC=AMQQVAL2,AMQQVAL2=$P(AMQQVAL1,"~~",2),AMQQVAL1=$P(AMQQVAL1,"~~")
 I AMQQVAL2="ANY"!((AMQQVAL1=-999999999)&(AMQQVAL2=999999999)) S AMQQAAFL=""
 S AMQQMSS=+AMQQMSS,AMQQMPC=$S(AMQQMPC:AMQQMPC,1:4)
 S AMQQHOLD=0,AMQT(AMQQT)=0,AMQQIDN=0,AMQQLCNT=0
 K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
 I $E(AMQQST)?1P,'$D(AMQQSQVN) D REL^AMQQMULS
 I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
 I $D(AMQQB) S %=AMQQB,AMQQBOOL=$P(%,";"),AMQQVAL3=$P(%,";",2),AMQQVAL4=$P(%,";",3)
 I $D(AMQQSQVN),AMQQID[":" G:$D(@AMQQ) RUN S AMQT(AMQQT)=0 G NULL
 I '$D(AMQQSQVN),AMQQID'[":",'$D(@AMQQ@(AMQQID\1)),AMQQ["VLAB" S AMQT(AMQQT)=0 G NULL
 I $G(AMQQSPEC)="EXISTS",AMQQSTRT=2,'AMQQST,'AMQQUSQN,AMQQFIN=9999999,AMQQLAST=9999999 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="+",AMQP(AMQQFVAR)="+",AMQT(AMQQT)=1 G EXIT
RUN D ID
SQ I $D(AMQV("SQ")) D ^AMQQMULS
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL" K ^(AMQQUATN) G EXIT
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)) S AMQP(AMQQFVAR)=$P(^(1),U)
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC'="NULL",AMQQSPEC'="ANY",AMQQVAL2'="ANY"
 E  S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="-",AMQP(AMQQFVAR)="-",AMQT(AMQQT)=1
 G EXIT
TRUE I AMQQSPEC="EXISTS" K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)="+",AMQP(AMQQFVAR)="+"
 S AMQT(AMQQT)=1
EXIT I AMQQAG="SAG" K ^UTILITY("AMQQ",$J,"SAG",AMQQUATN)
 D EXIT3^AMQQKILL
 Q
 ;
ID I AMQQID'[":" S AMQQIDX=AMQQID D INC Q
 F  S AMQQIDN=AMQQIDN+1,AMQQIDX=$P(AMQQID,":",AMQQIDN) Q:AMQQIDX=""  D INC I AMQQLCNT=-1 Q
 Q
 ;
INC I AMQQGR="AUPNVLAB",AMQQIDX["." S AMQQLSS=+$P(AMQQIDX,".",2,99),AMQQIDX=AMQQIDX\1
 I $D(AMQQSQVN) S AMQQVNO=0 D VINC Q
 I '$D(@AMQQ@(AMQQIDX)) Q
 S AMQQVDAT=9999999-AMQQFIN
INCDATE S AMQQVDAT=$O(@AMQQ@(AMQQIDX,AMQQVDAT))
 I AMQQVDAT'=+AMQQVDAT Q
 I (9999999-AMQQVDAT)<AMQQST Q  ;IHS/OHPRD/TMJ Patch #10 3/5/97
 S AMQQVNO=0
INCITEM S AMQQVNO=$O(@AMQQ@(AMQQIDX,AMQQVDAT,AMQQVNO))
 I 'AMQQVNO G INCDATE
 S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")" G:'$D(@%) INCITEM G:'$D(^(0)) INCITEM I AMQQGR="AUPNVLAB" D LABSITE ;IHS/OHPRD/JCM 8/20/94
 S AMQQVALU=$P(@%,U,AMQQMPC),AMQQVSIT=$P(^(0),U,3) D SET
 I AMQQLCNT=AMQQLAST Q
 I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1 Q
 G INCITEM
 ;
SET I AMQQVAL1="A",AMQQGR="AUPNVIMM",AMQQVALU="" S AMQQVALU=$P($G(^AUTTIMM(AMQQIDX,0)),U,2)_" +" G S1
 I AMQQVALU="",$D(AMQQAAFL) S AMQQVALU=" " D S1 Q  ;IHS/OHPRD/JCM 8/20/94
 ;I AMQQVALU="",$L(AMQQVAL1)>1,AMQQNNA'=5 Q  ;IHS/OHPRD/JCM 8/4/94
 I "<>"[$E(AMQQVALU) S AMQQGTLT=$E(AMQQVALU),AMQQVALU=$E(AMQQVALU,2,99)
 I AMQQITR'="" S X=AMQQVALU X AMQQITR S AMQQVALU=X
 I $D(AMQQNNA),AMQQNNA>1 X "I 0" D ^AMQQMULN D:$T S1 Q
 I $D(AMQQB) X "I 0" D BP^AMQQMULN D:$T S1 Q
 I AMQQVAL2'=+AMQQVAL2 D TEXT^AMQQFAN D:$T S1 Q
 S AMQQVALU=$S(AMQQVALU="":" ",1:+AMQQVALU) ;IHS/OHPRD/JCM 8/4/94
 I AMQQVAL1>AMQQVAL2,AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1) D S1 Q
 I AMQQVALU=AMQQVAL1,AMQQVALU=AMQQVAL2 D S1 Q
 I AMQQVALU>AMQQVAL1,AMQQVALU<AMQQVAL2 D S1
 Q
 ;
S1 S AMQQLCNT=AMQQLCNT+1,AMQQHOLD=AMQQHOLD+1,%=""
 I AMQQGR="AUPNVLAB" S %=$P($G(^AUPNVLAB(AMQQVNO,0)),U,5) ;_"  "_AMQQLSS1 ;IHS/OHPRD/JCM 8/21/94
 I AMQQGR="AUPNVDXP" S %=$P($G(^AUPNVDXP(AMQQVNO,0)),U,5)
 I AMQQVALU'=" " S AMQQVALU=AMQQVALU_" "_% S AMQQLDFN=AMQQIDX ;IHS/OHPRD/JCM 10/20/94
 I $D(AMQQGTLT) S AMQQVALU=AMQQGTLT_AMQQVALU K AMQQGTLT
 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-AMQQVDAT)_U_AMQQVSIT_U_AMQQVNO
 Q
 ;
VINC S AMQQVNO=$O(@AMQQ@(AMQQVNO))
 I 'AMQQVNO Q
 S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
 I $D(@%),$D(^(0)),$P(^(0),U)=AMQQIDX S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC),AMQQVSIT=$P(^(0),U,3) D SET I 1
 E  G VINC
 I AMQQLCNT=AMQQLAST Q
 I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT S AMQQLCNT=-1 Q
 G VINC
 ;
LABSITE ;
 N %,X
 ;I 0 ;IHS/OHPRD/JCM 8/21/94
 S AMQQLSS1="NO SITE SPECIMEN"
 Q:'$D(AMQQLSS)  ;IHS/OHPRD/JCM 8/23/94
 F %=1:1 S X=+$P(AMQQLSS,".",%) Q:'X  I X=$P($G(^AUPNVLAB(AMQQVNO,11)),U,3) S:$G(^LAB(61,X,0))'="" AMQQLSS1=$P(^LAB(61,X,0),U) Q  ;IHS/OHPRD/JCM 8/21/94
 Q
 ;

AMQQMULW
AMQQMULW ; CMI/MIC/GIS - COLLECTS MULTIPLE VALUES FOR WOMEN'S HEALTH PROCEDURES [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
VAR F I=1:1:19 S X=$P("GR;ID;ST;FIN;LAST;VAL1;SPEC;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I) S @("AMQQ"_X)=$P(AMQQX,";",I)
 I '$D(AMQQAG) S AMQQAG="AG"
 S AMQQVAL1=+AMQQVAL1,AMQQMPC=4,AMQQMSS=0
 S AMQQ=U_AMQQGR_"(""AA"",AMQP(0))"
 S AMQQHOLD=0,AMQT(AMQQT)=0,AMQQLCNT=0
 K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
 I $E(AMQQST)?1P,'$D(AMQQSQVN) D REL^AMQQMULS
 I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
 I '$D(AMQQSQVN),'$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
 I $G(AMQQSPEC)="EXISTS",AMQQSTRT=2,'AMQQST,'AMQQUSQN,AMQQFIN=9999999,AMQQLAST=9999999 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="+",AMQP(AMQQFVAR)="+",AMQT(AMQQT)=1 G EXIT
RUN S AMQQVNO=0 D INC
SQ I $D(AMQV("SQ")) D ^AMQQMULS
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL"!(AMQQSPEC="INVERSE") K ^(AMQQUATN) G EXIT
 I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC'="NULL",AMQQSPEC'="ANY",AMQQSPEC'="INVERSE"
 E  S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="-",AMQP(AMQQFVAR)="-",AMQT(AMQQT)=1
 G EXIT
TRUE I AMQQSPEC="EXISTS" K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)="+",AMQP(AMQQFVAR)="+"
 S AMQT(AMQQT)=1
EXIT I AMQQAG="SAG" K ^UTILITY("AMQQ",$J,"SAG",AMQQUATN)
 D EXIT3^AMQQKILL
 Q
 ;
INC S AMQQVDAT=9999999-AMQQFIN
INCDATE S AMQQVDAT=$O(@AMQQ@(AMQQVDAT))
 I AMQQVDAT'=+AMQQVDAT Q
 I (9999999-AMQQVDAT)'>AMQQST Q
 S AMQQVNO=0
INCITEM S AMQQVNO=$O(@AMQQ@(AMQQVDAT,AMQQVNO))
 I 'AMQQVNO G INCDATE
 S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
 I $D(@%),$D(^(0)) S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC),AMQQVSIT=+$P($G(^("PCC")),U) D SET I 1 ; CMI/MIC/GIS 11/24/98
 E  G INCITEM
 I AMQQLCNT=AMQQLAST Q
 I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1 Q
 G INCITEM
 ;
SET I AMQQVALU="" Q
 I '$D(^UTILITY("AMQQ TAX",$J,AMQQVAL1,AMQQVALU)),'$D(^("*")),'$D(^("-")) Q
S1 S AMQQHOLD=AMQQHOLD+1,AMQQLCNT=AMQQLCNT+1
 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-AMQQVDAT)_U_AMQQVSIT_U_AMQQVNO
 K AMQQOK
 Q
 ;

AMQQN0
AMQQN0 ; OHPRD/DG - NATL LANGUAGE PRELIMINARY SETUP ; [ 04/06/99  11:55 AM ]
 ;;2;PCC QUERY UTILITY;**12,13**;JUN 10, 1993
 ;2/9/1999 - patch 12,13 Y2K fixes
PREP F %=" DURING "," IN " I X[% D DUR Q
 I X[" BORN " D BORN
 I X'[" BETWEEN " F  Q:X'[" AND "  S X=$P(X," AND ")_" &"_$P(X," AND ",2,99)
 I X["&" D AND G EXIT
 I X["BETWEEN" S %=$P(X,"BETWEEN",2) I %[" AND " S AMQQNV2=$P(X," AND ",2),X=$P(X,(" AND "_AMQQNV2))
RUN D SPEC,STRIP,UNITS,PRELIM
EXIT K Y
 Q
 ;
SPEC N A,B,C,%,N,I
 I ($E(X,1,6)="WOMEN "!($E(X,1,6)="WOMEN")),X'["CHILD" S X="FEMALES "_$E(X,7,999)
 S %="PTS'^CLIENTS'^CLIENT'S^EVERYONE'S^EVERYBODY'S^PTS^CLIENTS^EVERYONE^EVERYBODY^PEOPLE^FOLKS"
 F I=1:1 S A=$P(%,U,I) Q:A=""  S A=A_" " I X[A S X=$P(X,A)_"PATIENTS "_$P(X,A,2) Q
 F %=" WHO ARE "," WHO IS "," WHO WERE " F  Q:X'[%  S X=$P(X,%)_" "_$P(X,%,2,99)
 S %=" WHO HAVE " I X[% S X=$P(X,%)_" WITH "_$P(X,%,2)
 S %="ALL OF " I X[% S X=$P(X,%)_"ALL "_$P(X,%,2)
 I X'["AGE" G SP1
 S %=" THE AGE OF " I X[% S X=$P(X,%)_" AGE "_$P(X,%,2)
 S %="ABOVE^GREATER THAN^MORE THAN^OVER^BEYOND^>^LESS THAN^BELOW^HIGHER THAN^UNDER^<"
 F I=1:1 S A=$P(%,U,I) Q:A=""  S Y=" "_A_" AGE " I X[Y S X=$P(X,Y)_" AGE "_A_" "_$P(X,Y,2) Q
SP1 S %=" WITH " I X[%,$L($P(X,%,2)," ")<3 S X=$P(X,%)_" DX OF "_$P(X,%,2)
 F %="WHAT IS ","WHAT WAS " I X[% S X=$P(X,%)_$P(X,%,2,99)
 S %=" OF " I X["PATIENT" F  Q:X'[%  S X=$P(X,%,1)_" = "_$P(X,%,2,99)
 S %="FROM^LIVING IN^LIVE IN^LIVES IN"
 F I=1:1 S A=$P(%,U,I) Q:A=""  S A=" "_A_" " I X[A S X=$P(X,A)_" CURRENT COMMUNITY = "_$P(X,A,2) Q
 S %="WHO ARE TAKING^WHO TAKE^TAKING^ON"
 F I=1:1 S A=$P(%,U,I) Q:A=""  S A=" "_A_" " I X[A S X=$P(X,A)_" RX = "_$P(X,A,2) Q
 I X'["DEAD" Q
 F I=1:1 S A=$P(X," ",I) I A="DEAD" S X="PATIENTS WHO DIED AFTER 1800" Q
 Q
 ;
STRIP S Y(1)=";SEE;GIVE;FIND;PRINT;LIST;GET;SHOW;I;ME;FOR;DISPLAY;TO;WANT;WOULD;LIKE;NEED;REQUEST;ALL;LET;VIEW;SEARCH;WHAT;KNOW;A;AN;TELL;MUCH;DOES;"
 S Y(2)=";THE;THEIR;THAN;REPORT;LIST;LISTING;BRING;WHOSE;WHO;EVERY;PRINT;MAKE;EVERY;EACH;WITH;FIND;NOW;HIS;HER;A;YOU;COULD;PLEASE;"
STP F  Q:X'["."  S %=$E(X,$F(X,".")) S X=$P(X,".")_$S(%=+%:"~~~",1:"")_$P(X,".",2,99)
 F  Q:X'["~~~"  S X=$P(X,"~~~")_"."_$P(X,"~~~",2,99)
 F I=1:1 S Z=$P(X," ",I) Q:Z=""  F J=0:0 S J=$O(Y(J)) Q:'J  D ST1
 Q
 ;
ST1 I I=1,Y(J)[(";"_Z_";") S X=$P(X," ",2,99),I=I-1,J=99 Q
 I Y(J)[(";"_Z_";") S X=$P(X," ",1,I-1)_" "_$P(X," ",I+1,99),I=I-1,J=99
 Q
 ;
UNITS N %,Y,Z
 F %="WEIGH","WT" I X[% F Y="LBS.","lbs.","LBS","lbs","POUNDS","LB.","LB","lb.","lb" I X[Y S Z="WTL" D INSERT G UXIT
 F %="WEIGH","WT" I X[% F Y="KBS.","kgs.","KGS","kgs","KILOGRAMS","KG.","KG","kg.","kg" I X[Y S Z="WTK" D INSERT G UXIT
 F %="HEIGH","HT" I X[% F Y="INS.","ins.","INS","ins","INCHES","IN.","IN","in.","in" I X[Y S Z="HTI" D INSERT G UXIT
 F %="HEIGH","HT" I X[% F Y="CMS.","cms.","CMS","cms","CENTIMETERS","CM.","CM","cm.","cm" I X[Y S Z="HTC" D INSERT G UXIT
UXIT Q
 ;
PRELIM F  Q:X'["  "  S X=$P(X,"  ")_S_$P(X,"  ",2,99)
 I $E(X)=" " S X=$E(X,2,999)
 I $E(X,$L(X))=" " S X=$E(X,1,$L(X)-1)
 Q
 ;
INSERT N A,B
 S A=$P(X,%),B=$P(X,%,2),B=$P(B," ",2,99),X=A_Z_" "_B
 Q
 ;
AND F I=1:1 S %=$P(X,"&",I) Q:%=""  S AMQQNAP(I)=%
 F AMQQNAP=0:0 S AMQQNAP=$O(AMQQNAP(AMQQNAP)) Q:'AMQQNAP  S X=AMQQNAP(AMQQNAP) D RUN S AMQQNAP(AMQQNAP)=X
 S X=AMQQNAP(1)
 Q
 ;
BORN S %=" BORN ON " I X[% S X=$P(X,%)_" DOB = "_$P(X,%,2) Q
 S %=" BORN DURING " I X[% D IN Q
 S %=" BORN IN " I X[% D IN Q
 S %=" BORN " I X[% S X=$P(X,%)_" DOB "_$P(X,%,2)
 Q
 ;
IN S A=$P(X,%,2)
 I A'?4N Q
 S X=$P(X,%)_" DOB BETWEEN "_A_" AND "_(A+1)
 Q
 ;
DUR N Y,Z,A,B,C S Y=$P(X,%,2),C=%
 ;beginning Y2K fixes
 ;I Y?2N S Y=19_Y ;Y2000 commented out
 I Y?1.2N S Y=$$YEAR^AMQQN0(Y) ;Y2000
 ;end Y2K fixes
 I Y?4N S X=$P(X,%)_" BETWEEN 1/1/"_Y_" AND 12/31/"_Y Q
 D DUR1 I Y=-1 Q
 I $E(Y,6,7)'="00" Q
 S A=$E(Y,1,3)+1700,A=+$E(Y,4,5)_"/1/"_A
 S Z=+$E(Y,4,5),Z=$E("303232332323",Z)+28,B=+$E(Y,4,5)_"/"_Z_"/"_($E(Y,1,3)+1700)
 S X=$P(X,%)_" BETWEEN "_A_" AND "_B
 Q
 ;
DUR1 N X,% S X=Y,%DT="" D ^%DT
 Q
 ;
 ;beginning Y2K fixes
 ;added this subroutine for Y2K
 ;Y2000
YEAR(X) ; CONVERTS 2 DIGIT YEAR INTO A FOUR DIGIT YEAR
 NEW Y,%,%DT ;Y2000
 S:$L(X)<2 X="0"_X ;Y2000
 S %DT="P" D ^%DT ;Y2000
 Q Y\10000+1700 ;Y2000
 ;
 ;end Y2K fixes

AMQQN1
AMQQN1 ; IHS/OHPRD/JCM - NATL LANGUAGE PRELIMINARY PASS ; [ 01/31/94 9:44 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
RUN D SUBJ W *13,?79,*13
 I '$D(AMQQFAIL),$D(AMQQNSBJ),$D(AMQQFEN2) W !!,"Sorry...You cannot change the subject of your search",!!,*7 H 3 S AMQQQUIT="",AMQQFAIL=-1 G EXIT
 I '$D(AMQQNSBJ),$D(AMQQSAUT),'$D(AMQQFAIL) I $L(AMQQSAUT,U)>3 S (AMQQNSBJ,Y)=AMQQSAUT D AUTO1^AMQQ1
 I $D(AMQQQUIT) G EXIT
 I '$D(AMQQNSBJ) S AMQQFAIL=4 G EXIT
 S AMQQSAUT=AMQQNSBJ,AMQQCCLS="P"
EXIT ;
 Q
 ;
SUBJ S %="LIVING PATIENTS^PATIENTS^INFANTS^FEMALES^MALES^BOYS^GIRLS^MEN^WOMEN"
 F I=1:1 S A=$P(%,U,I) Q:A=""  I X[A D PAT G SUBEXIT
 I X'["OF " G SUBJ1
 F Y=1:1 S Z=$P(X," ",Y) I Z="OF" Q
 I $P(X," ",Y+3)'="" S Z=$P(X," ",Y+1,Y+3) D SB1 I $D(AMQQNSBJ) D SB2 Q
 I $P(X," ",Y+2)'="" S Z=$P(X," ",Y+1,Y+2) D SB1 I $D(AMQQNSBJ) D SB2 Q
SUBJ1 I X'["'S",X'["S'" Q
 F Y=1:1 S Z=$P(X," ",Y) I Z["S'"!(Z["'S") Q
 I Y>2 S Z=$P(X," ",Y-2,Y) D SB1 I $D(AMQQNSBJ) D SB2 Q
 S Z=$P(X," ",Y-1,Y) D SB1 I $D(AMQQNSBJ) D SB2
 Q
 ;
SB1 S %=Z I %["'S" S %=$P(%,"'S")_$P(%,"'S",2) G SB10
 I %["S'" S %=$P(%,"S'")_"S"_$P(%,"S'",2)
SB10 W ! N X,Y,Z S X=%,AMQQXX="" D ^AMQQ2
 I '$D(Y) W:'$D(AMQQNECO) !!,"Sorry, I'm unable to determine the SUBJECT of the query...The search is aborted",!!,*7 S AMQQFAIL=1 Q
 S AMQQNSBJ=Y D AUTO1^AMQQ1
SUBEXIT K %,A,Z
 Q
 ;
SB2 S Z=Z_" ",X=$P(X,Z)_$P(X,Z,2,99)
 I X["OF " S X=$P(X,"OF ")
 Q
 ;
PAT S X=$P(X,A)_" "_$P(X,A,2)
 F  Q:X'["  "  S X=$P(X,"  ")_" "_$P(X,"  ",2,99)
 I $E(X)=" " S X=$E(X,2,240)
 I X[" OF " S X=$P(X," OF ",1)_" "_$P(X," OF ",2,99) ;IHS/OHPRD/JCM 1/10/94
 S AMQQNSBJ=A,AMQQCCLS="P"
 N X S X=A,AMQQXX="" D AUTO^AMQQ1
 Q
 ;

AMQQN2
AMQQN2 ; IHS/OHPRD/JCM - TEMP ; [ 10/18/94 6:51 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4,6**;JUN 10, 1993
VAR N A,S S A=X,S=" " N %,X,Y,Z
RUN D ATT I $G(Y)=-1 S AMQQFAIL=5 G EXIT
 I A="",$D(AMQQONE),"GL"[$P(^AMQQ(4,AMQQNTYP,0),U) S A="= ALL"
 I A="" S AMQQNCND="",AMQQNVAL=""
 E  D COND I Y=-1 S AMQQFAIL=5 G EXIT
 I $G(AMQQNSUB)'="" D SUB I Y=-1 S AMQQFAIL=6 G EXIT
EXIT K AMQQNI,AMQQNOTF,AMQQNTYP,AMQQNII,%,A,S
 Q
 ;
ATT S DIC="^AMQQ(5,",DIC(0)="ES",DIC("S")="I $P(^(0),U,2)=AMQQCCLS"
 F AMQQNI=1:1:$L(A,S)-1 S X=$P(A,S,AMQQNI,AMQQNI+1) Q:X=""  S:$E(X,$L(X))="S" X=$E(X,1,$L(X)-1) S D="C" I X'=+X D IX^DIC I Y'=-1 S X=$P(A,S,AMQQNI,AMQQNI+1) D ATTSET G ATTEXIT ;IHS/OHPRD/JCM 1/10/94
 F AMQQNI=1:1 S X=$P(A,S,AMQQNI) Q:X=""  S:$E(X,$L(X))="S" X=$E(X,1,$L(X)-1) S D="C" I X'="LAST",X'=+X D IX^DIC I Y'=-1 S X=$P(A,S,AMQQNI) D ATTSET Q
ATTEXIT K DIC
 Q
 ;
ATTSET D ^AMQQSEC I Y=-1 S AMQQNSF="" H 2 Q
 S AMQQNSUB=$P(A,X),%=$L(AMQQNSUB) I $E(AMQQNSUB,%)=" " S AMQQNSUB=$E(AMQQNSUB,1,%-1)
 S A=$P(A,X,2,99) I $E(A)=S S A=$E(A,2,999)
 S AMQQNATT=Y,AMQQATN=+Y,AMQQATNM=$P(Y,U,2),AMQQLINK=$P(^AMQQ(5,+Y,0),U,5)
 I 'AMQQLINK S Y=-1 Q  ;IHS/OHPRD/JCM 10/15/94
 I AMQQATN>1000 D ^AMQQATAL
 W *13,?79,*13
 S %=$P(^AMQQ(5,+Y,0),U,5) S:%=9 %=+Y+($J/100000)
 S AMQQNTYP=$P(^AMQQ(1,%,0),U,5),AMQQCTXS=$P(^(0),U,7)
 Q
 ;
COND S %=$P(^AMQQ(4,AMQQNTYP,0),U) I "GL"[% D TAX Q
 S %=$P(A,S) I "^IS^WAS^ARE^WERE^"[(U_%_U) S AMQQNISF="",A=$P(A,S,2,99) G COND
 I "^`^NOT^"[% S AMQQNOTF="",A=$P(A,S,2,99)
C1 S DIC="^AMQQ(5,",DIC(0)="ES"
 I 'AMQQCTXS S DIC("S")="I $P(^(0),U,3)=AMQQNTYP" G C2
 I $G(AMQQNSUB)'="" S DIC("S")="I $P(^(0),U,21)="_AMQQNTYP G C2
 S AMQQSQST=$P(^AMQQ(4,AMQQNTYP,0),U) D DICS^AMQQSQAC
C2 S %=$L(A,S) I %>3 S %=3
 S AMQQNII=% F AMQQNI=AMQQNII:-1:1 S X=$P(A,S,1,AMQQNI),D="C" D IX^DIC I Y'=-1 Q
 W *13,?79,*13 K DIC
 I Y=-1,$D(AMQQNISF) K AMQQNISF S A="= "_A G C1
 I Y=-1 Q
 S AMQQNVAL=$P(A," ",AMQQNI+1,99),AMQQNCND=Y
 S %=$L(AMQQNVAL,S) I %>1,$P(AMQQNVAL,S,%-1)=+$P(AMQQNVAL,S,%-1) S AMQQNVAL=$P(AMQQNVAL,S,1,%-1)
 I $D(AMQQNOTF) K AMQQNOTF S $P(AMQQNCND,U,3)="'"
 I $G(AMQQNVAL)'="" D VAL
 Q
 ;
TAX F %="IS","WAS","ARE","WERE" I $P(A," ")=% S A="= "_$P(A," ",2,99)
 S AMQQNVAL=$P(A,"= ",2),AMQQNTAX=AMQQNVAL K AMQQTAX
 S %=^AMQQ(5,+Y,0),AMQQLINK=$P(%,U,5),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
 W *13,?79,*13
 I '$D(AMQQTAX) S AMQQFAIL=8 Q
 S AMQQNCND=$S(AMQQCTXS:"MTAX",1:"TAX"),AMQQNVAL=AMQQTAX
 I $D(AMQQXXXX),AMQQXXXX["'="!(AMQQXXXX[" NOT ") S ^UTILITY("AMQQ TAX",$J,AMQQTAX,"--")=""
 Q
 ;
SUB S A=AMQQNSUB,DIC="^AMQQ(5,",DIC(0)="ES",DIC("S")="I $P(^(0),U,20)=""C""!($P(^(0),U,20)=""O""),$P(^(0),U,21)="_AMQQNTYP_"!($P(^(0),U,21)=16)",%=$L(A,S) I %>3 S %=3
 S AMQQNII=% F AMQQNI=AMQQNII:-1:1 S X=$P(A,S,1,AMQQNI),D="C" D IX^DIC I Y'=-1 Q
 W *13,?79,*13 K DIC
 I Y=-1 S AMQQFAIL=10 Q
 S X=$P(A,S,1,AMQQNI),%=$P(A,X,2),AMQQNSTP=$P(^AMQQ(5,+Y,0),U,20),%=$TR(%," ","")
 I AMQQNSTP="C",%'="" S AMQQFAIL=10 Q
 I AMQQNSTP="C",$G(AMQQNCND)="MTAX" S AMQQFAIL=10 Q
 I AMQQNSTP="C" S AMQQNSCD=Y Q
 I %="" S %=1
 I %'=+% S AMQQFAIL=10 Q
 S AMQQNSCD=Y,AMQQNSVL=%
 Q
 ;
VAL K AMQQCOMP
 S X=AMQQNVAL,AMQQFTYP=$P(^AMQQ(4,AMQQNTYP,0),U),AMQQNOCO=1,AMQQSYMB=$P(^AMQQ(5,AMQQATN,0),U,6)
 I AMQQCTXS S %=$P(^AMQQ(5,+AMQQNCND,0),U,21),AMQQFTYP=$P(^AMQQ(4,%,0),U)
 I $D(AMQQNV2) S X=X_";"_AMQQNV2,AMQQNOCO=2 K AMQQNV2
 D ^AMQQAV
 I $G(AMQQCOMP)="" S AMQQFAIL=6 Q
 S AMQQNVAL=AMQQCOMP K AMQQCOMP
 Q
 ;

AMQQOPT
AMQQOPT ; IHS/OHPRD/JCM - QUERY OPTIONS ; [ 01/31/94 9:45 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
ADAM I $D(AMQQADAM) D SEL G EXIT
 I $D(AMQQAGIN) D SEL G EXIT
HELLO W @IOF,!!,?12,"*****  WELCOME TO Q-MAN: THE PCC QUERY UTILITY  *****"
RUN D WARN,SEC I $D(AMQQQUIT) G EXIT
 S DIR(0)="E" D ^DIR K DIR
 I $D(DUOUT)+$D(DTOUT) K DTOUT,DIRUT,DUOUT S AMQQQUIT="" G EXIT
 D SEL
EXIT K X,%,Y
 Q
 ;
WARN S X="",$P(X,"*",80)="" W !!!,X,!
W1 W "**         WARNING...Q-Man produces confidential patient information.        **"
 W !,"**     View only in private.  Keep all printed reports in a secure area.     **",!
 W "**          Ask your site manager for the current Q-Man Users Guide.         **",!,X,!!!
 Q
 ;
SEC I '($D(DUZ)#2) D NOUSER Q
 I 'DUZ D NOUSER Q
 I '$D(DUZ(2)) D NOSITE Q
 I 'DUZ(2) D NOSITE Q
 W !,"Query utility: IHS Q-MAN Ver. ",AMQQVER
 S %=$P(@AMQQ200(3)@(DUZ,0),U),%=$P(%,",",2,9)_" "_$P(%,",") W !,"Current user: ",% ;VA/SLC ISC/GIS 11/24/93
 W !,"Chart numbers will be displayed for: ",$P(^DIC(4,DUZ(2),0),U)
 W !,"Access to demographic data: PERMITTED",!,"Access to clinical data: "
 S %=$$KEYCHECK^AMQQUTIL("AMQQZCLIN")
 W $S(%:"PERMITTED",1:"DENIED"),!
 S %=$$KEYCHECK^AMQQUTIL("AMQQZPROG")
 W "Programmer privileges: ",$S(%:"YES",1:"NO"),!!!
 Q
 ;
NOUSER W !!,"USER NOT IDENTIFIED...SESSION ABORTED",!!,*7 G NO1
NOSITE W !!,"LOCATION NOT IDENTIFIED...SESSION ABORTED",!!,*7
NO1 S AMQQQUIT="" H 3
 Q
 ;
CHECK S %=$$KEYCHECK^AMQQUTIL("AMQQZPROG")
 I '% K AMQQOPT W "Sorry...Programmer privileges are required for this option",!!,*7 H 3 W @IOF
 Q
 ;
SEL W @IOF,!!?25,"*****  Q-MAN OPTIONS  *****",!!!
SEL1 S DIR(0)="SO^1:SEARCH PCC Database (dialogue interface);2:FAST Facts (natural language interface);3:RUN Search Logic;4:VIEW/DELETE Taxonomies and Search Templates;5:FILEMAN Print;9:HELP;0:EXIT"
 S DIR("A")=$C(10)_"     Your choice",DIR("B")="SEARCH",DIR("?")="Select an option or type '??' for more information",DIR("??")="AMQQMENU" D ^DIR K DIR
 I $G(DUOUT)+$G(DTOUT)+'Y K DTOUT,DIRUT,DUOUT S AMQQQUIT="" Q
OUT1 W !!
 I Y=1 S AMQQOPT="SEARCH" Q
 I Y=2 S AMQQOPT="FAST" Q
 I Y=3 S AMQQOPT="SAVE" D CHECK G:'$D(AMQQOPT) SEL1 Q
 I Y=4 S AMQQOPT="VIEW" D VIEW G SEL Q
 I Y=5 S %=$$KEYCHECK^AMQQUTIL("AMQQZCLIN") I '% W "Sorry...Clinical privileges are required for this option",!!,*7 H 3 G SEL
 I Y=5 D ^DIP G SEL
 I Y=9 S XQH=$O(^DIC(9.2,"B","AMQQMENU","")),DIC(0)="X" D EN^XQH G SEL
 Q
 ;
OUT ; ENTRY POINT FROM AMQQCMPL
 I $D(AMQQEN31) S AMQV("OPTION")="COHORT" Q
 K AMQV("OPTION") D OUTPUT I $D(AMQQQUIT) G OUTEXIT
 I Y=-1 D  Q
 . I $D(AMQV("OPTION")),$D(AMQQQUIT),"AGEHSUMMAILMONTHTIMEWORK"[AMQV("OPTION") S AMQQOPT("SPEC")=""
 S AMQV("OPTION")=$P("LIST^PRINT^COUNT^COHORT^STORE^RMAN",U,Y)
OUTEXIT K X,POP,DTOUT
 S AMQQ("AGIN")=""
 Q
 ;
OUTPUT ; - EP - FROM AMQQQE1
 I $D(AMQQOPT("ASCII")) S Y=6 K AMQQOPT("ASCII") G RMAN
 I $D(AMQQOPT("SPEC")) S Y=6 G RMAN
 W @IOF,!!,?20,"*****  Q-MAN OUTPUT OPTIONS  *****",!!
OS S DIR(0)="SO^1:DISPLAY results on the screen;2:PRINT results on paper;3:COUNT 'hits';4:STORE results of a search in a FM search template;5:SAVE search logic for future use;6:R-MAN special report generator;9:HELP;0:EXIT"
 S DIR("??")="AMQQOUTPUT",DIR("?")="Enter a code from the list or '??' for more information on each choice",DIR("A")=$C(10)_"     Your choice",DIR("B")="DISPLAY" D ^DIR K DIR
 I $D(DUOUT)+$D(DTOUT) K DIRUT,DUOUT,DTOUT S AMQQQUIT="" Q
 I Y=9 S XQH="AMQQOUTPUT",DIC(0)="X" D EN^XQH G OUTPUT
 I 'Y S AMQQQUIT="" Q
 I Y=5,$D(AMQQCPLF) W "  (Already selected...try again)",*7,! G OS
RMAN I Y=6 D RMAN^AMQQOPT1 G:'$D(AMQV("OPTION")) OS I '$D(AMQQQUIT) D @(AMQV("OPTION")_"^AMQQRMAN") S Y=-1 I $D(AMQQRERF) K AMQQRERF D  G OUTPUT
 . I $D(AMQV("OPTION")),$D(AMQQQUIT),"AGEHSUMMAILMONTHTIMEWORK"[AMQV("OPTION") S AMQQOPT("SPEC")=""
 Q
 ;
VIEW D VIEW^AMQQOPT1
 Q
 ;

AMQQPOST
AMQQPOST ; IHS/OHPRD/JCM - PATCH 16 POST PATCH ROUTINE; [ 05/16/2000  3:44 PM ]
 ;;2;PCC QUERY UTILITY;**16**;MAR 11, 1997
 Q
P16 ;EP;FOR P16 POST
 K ^AMQQ(1,"B")
 S DIK="^AMQQ(1,",D="B",DA=0
 F  S DA=$O(^AMQQ(1,DA)) Q:'DA   D IX1^DIK W "."
 K ^AMQQ(5,"B"),^AMQQ(5,"C")
 S DIK="^AMQQ(5,"
 S DA=0
 F  S DA=$O(^AMQQ(5,DA)) Q:'DA   D
 .F D="B","C" D IX1^DIK W "."
 Q

AMQQREG
AMQQREG ; IHS/CMI/THL - QUERY CMS REGISTER INTERFACE ; [ 10/14/1999  10:05 PM ]
 ;;2;PCC QUERY UTILITY;**14,15**;OCT 5, 1993
 ;;UTILITY TO SELECT AND UTILIZE CMS REGISTER AS SUBJECT OF A QMAN
 ;;SEARCH
 ;
EN N Y,AMQQ
 D EN1
EXIT K AMQQQUIT
 Q
EN1 D REG
 Q:$D(AMQQQUIT)
 D ACTIVE
 Q:$D(AMQQQUIT)
 D COHORT
 Q
REG ;EP;TO SELECT A REGISTER
 N Y
 K AMQQRDA
 S DIC="^ACM(41.1,"
 S DIC(0)="AEMQZ"
 S DIC("S")="I $D(^ACM(41.1,+Y,""AU"",""B"",DUZ))" ;IHS/CMI/THL - SCREEN FOR AUTHORITY TO ACCESS REGISTER - PATCH 15
 S DIC("A")="Which CMS REGISTER: "
 W !
 D DIC
 Q:$D(AMQQQUIT)
 S AMQQRDA=+Y
 S AMQQCNAM=$P(Y,U,2)_" REGISTER"
 Q
ACTIVE ;EP;TO SELECT PATIENT STATUS
 K DIR
 W !!,"Select the Patient Status for this report"
 S DIR(0)="SO^A:Active;I:Inactive;T:Transient;U:Unreviewed;D:Deceased;Z:All Register Patients"
 S DIR("A")="Which patients"
 S DIR("B")="Active"
 D ^DIR
 K DIR
 I Y]"","AITUDZ"[Y S AMQQ("CMS STATUS")=Y Q
 E  S AMQQQUIT=""
 Q
COHORT ;CREATE SEARCH TEMPLATE COHORT WITH REGISTER PATIENTS
 N X,Y,Z,AMQQDA
 D C1
 Q:$D(AMQQQUIT)
 K ^DIBT(AMQQDA,1)
 S X=0
 F  S X=$O(^ACM(41,"B",AMQQRDA,X)) Q:'X  D
 .S Z=$E($G(^ACM(41,X,"DT")))
 .Q:Z=""
 .S Y=$P($G(^ACM(41,X,0)),U,2)
 .Q:'Y
 .I AMQQ("CMS STATUS")="Z"!(Z=AMQQ("CMS STATUS")) D
 ..S ^DIBT(AMQQDA,1,Y)=""
 ..W "."
 W !
 Q
C1 ;CREATE SEARCH TEMPLATE
 S X=AMQQ("CMS STATUS")
 S X=$S(X="A":"Active",X="I":"Inactive",X="T":"Transient",X="U":"Unreviewed",X="D":"Deceased",1:"All Patients")
 S X=$E(AMQQCNAM,1,25)_"-"_$J
 S AMQQCHRT=X
 S DIC="^DIBT("
 S DIC(0)="L"
 I $D(^DIBT("B",X)) S Y=$O(^DIBT("B",X,0)) I Y
 E  D FILE^DICN
 K DIC,DD,DINUM,DR
 I +Y<1 S AMQQQUIT="" Q
 S AMQQDA=+Y
 S $P(^DIBT(+Y,0),U,2)=DT
 S $P(^DIBT(+Y,0),U,4)=2
 S $P(^DIBT(+Y,0),U,5)=DUZ
 S ^UTILITY("AMQQ",$J,"Q",1)="40^COHORT^C^1^238^1^IS A MEMBER OF^'=^"_+Y_"^^0.00^^^0^"_+Y_";;^0"
 S ^UTILITY("AMQQ",$J,"LIST",.1)="W ?3,@AMQQRV,""Subject of search: PATIENTS"",@AMQQNV"
 S ^UTILITY("AMQQ",$J,"LIST",2)="W ?6,""MEMBER OF '"_AMQQCHRT_"' COHORT   [SER = 99.00]"""
 S ^UTILITY("AMQQ",$J,"WEIGHT",-99,1)=""
 S AMQQILIN=2
 S AMQQNOET=""
 S AMQQUATN=2
 S AMQQUNB=1
 Q
NEWREG ;EP;TO CREATE REGISTER IN QMAN DICTIONARY OF TERMS
 Q:$O(^AMQQ(5,"B","REGISTER",0))
 I $D(^AMQQ(5,"B","CMS REGISTER")) D  Q
 .S DA=$O(^AMQQ(5,"B","CMS REGISTER",0))
 .Q:'DA
 .S DIE="^AMQQ(5,"
 .S DR=".01////REGISTER"
 .D ^DIE
 .S Y=DA
 .K ^AMQQ(5,DA,1)
 .K DA,DR,DIE
 .D NR1
 S X="REGISTER"
 S DIC="^AMQQ(5,"
 S DIC(0)="L"
 S DIC("DR")="3////52;4////40;10////P"
 D FILE^DICN
 K DIC,DA,DD,DR,DINUM,D,DLAYGO
NR1 S X="CMS REGISTER"
 S DA(1)=+Y
 S DIC="^AMQQ(5,"_+Y_",1,"
 S DIC(0)="L"
 S $P(^AMQQ(5,+Y,1,0),U,2)="9009075.01"
 D FILE^DICN
 K DIC,DA,DD,DR,DINUM,D,DLAYGO
 Q
DIC ;FM DIC INTERFACE
 Q:$D(AMQQOUT)
 K DTOUT,DUOUT,AMQQQUIT,AMQQOUT
 D ^DIC
 I +Y<1 S AMQQQUIT=""
 S:$D(DUOUT) AMQQQUIT=""
 S:$D(DTOUT)!(X="^^") (AMQQQUIT,AMQQOUT)=""
 K DIC,DA,DD,DR,DINUM,D,DLAYGO
 Q

AMQQRMA
AMQQRMA ; IHS/OHPRD/JCM - RMAN AGE BUCKET REPORT ; [ 03/17/94 6:19 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
 ; CALLS TASKMAN
RUN D CURR I $D(AMQQQUIT) G EXIT
 S AMQV("OPTION")="AGE"
EXIT K %Y,A,B,C,I,X,Y,Z,N
 Q
 ;
CURR W @IOF
 I $D(^AMQQ(8,DUZ(2),3)) S AMQQRMB=^(3) W !!,"CURRENT SET UP"
 W ! D LIST
ASK W !,"Do you want to define a new set of age buckets" S %=2 D YN^DICN
 I $E(%Y)=U S AMQQQUIT="" G CEXIT
 I %=0 W !,"Answering yes will allow you to define a new set of age buckets.",! G ASK
 I "Nn"'[%Y D NEWAGE
AGIN W !,"Do you want to have ages calculated as of a date other than today's date" S %=2 D YN^DICN
 I %=0 W !,"QMAN will detemine the ages of patients based on the date you enter subsequent",!,"to answering yes to this question.",! G AGIN
 I $E(%Y)=U S AMQQQUIT="",AMQQRERF="" G CEXIT
 I "Nn"'[%Y D NEWDATE I 1
 E  S AMQQDTE=DT
 I '$G(^AMQQ(8,DUZ(2),3))="" Q
CEXIT K DUOUT,DTOUT
 Q
 ;
NEWDATE ; Get new date
 S %DT="AEX",%DT("A")="Enter date relative to which age will be calculated: " D ^%DT Q:U[X  S AMQQDTE=Y I Y<0,X]"" G NEWDATE
 Q
 ;
NEWAGE S %="",A=-1 W !,"If you exceed 8 buckets, the display will wrap...",!!
 F N=1:1 D AGE Q:X=""  I $D(AMQQQUIT) G EXIT
 D CLOSE I $D(AMQQQUIT) G NEXIT
 D LIST
NEXIT K X,Y,Z,%,I,L,A
 Q
 ;
AGE W !,"Enter the starting age of the ",$S(%="":"first",1:"next")," age group: "
 R X:DTIME I '$T S X=U
 I X=U S AMQQQUIT="" Q
 I X="" Q
 I X?1."?" D HELP G AGE
 I X?1.3N,X>A D SET Q
 W "  ??",*7 G AGE
 ;
SET S A=X
 I %="" S %=X Q
 S %=%_":"_(X-1)_";"_X
 Q
 ;
CLOSE I %="" Q
GC W !,"Enter the highest age for the last group: "
 R X:DTIME I '$T S X=U
 I X=U S AMQQQUIT="" Q
 I X?1."?" D HELP G GC
 I X="" S X=199
 I X>199 S X=199
 I X?1.3N,X'<A S %=%_":"_X,^AMQQ(8,DUZ(2),3)=%,AMQQRMB=% Q
 W "  ??",*7 G GC
 ;
HELP W !,"Enter an age between 0 and 199.  Ages must be entered in ascending order.",!
 Q
 ;
LIST I $G(^AMQQ(8,DUZ(2),3))="" W !!,"At the present time, no set of age buckets is on file",!! Q
 W !,"AGE GROUPS =>",!
 S %=^AMQQ(8,DUZ(2),3)
 F I=1:1 S X=$P(%,";",I) Q:X=""  W !,$P(X,":"),$S($P(X,":",2)=199:"+",1:" - ") I $P(X,":",2)'=199 W $P(X,":",2)
 W !!
 Q
 ;
BUCKET ; ENTRY POINT FROM AMQQCMPL
 D VAR I $D(AMQQQUIT) Q
 D DEV I $D(AMQQQUIT) Q
 I '$D(AMQQRMA)!('$D(AMQQRMB)) S AMQQQUIT="" Q
 S AMQQRMFL="^AMQQRMA1"
 I $D(IO("Q")) D AGETASK Q
 U IO D AGERUN D ^%ZISC
 Q
 ;
VAR K ^UTILITY("AMQQ",$J,"AGE")
 F X=0:0 S X=$O(^UTILITY("AMQQ",$J,"VAR NAME",X)) Q:'X  S Y=+^(X) D V1
 I '$D(^UTILITY("AMQQ",$J,"AGE")) S %="" G VARQ
 S (%,Z)="" F I=1:1 S Z=$O(^UTILITY("AMQQ",$J,"AGE",1,Z)) Q:Z=""  S C=^(Z) D V2
VARQ ;
 D CLIN
 S DIR(0)="SO^"_$S(%="":%,1:(%_";"))_"8:NONE;9:HELP;0:EXIT"
 K AMQQBUCV,AMQQBUCC,AMQQTMPM,AMQQCNTP
 S DIR("B")="NONE",DIR("A")=$C(10)_"     Your choice",DIR("?")="Select an option or type '??' for instructions",DIR("??")="AMQQAGE" D ^DIR K DIR
 I $G(DUOUT)+$G(DTOUT)+'Y K DTOUT,DIRUT,DUOUT S AMQQQUIT="",AMQQOPT("SPEC")="" K AMQQPCE Q
 I Y<8,$D(AMQQPCE(Y)) S Y=AMQQPCE(Y)
 I Y<8 S AMQQRMA=^UTILITY("AMQQ",$J,"AGE",2,Y)
 I Y=8 S AMQQRMA=""
 I Y=9 S XQH="AMQQAGE" D EN^XQH G VAR
 K A,B,C,X,Y,Z,%,^UTILITY("AMQQ",$J,"AGE")
 Q
 ;
CLIN ;
 NEW AMQQI,AMQQNCHK,AMQQDFN
 F AMQQI=1:1 Q:'$D(^UTILITY("AMQQ",$J,"Q",AMQQI))  S AMQQDFN=$O(^AMQQ(5,"B",$P(^(AMQQI),U,2),"")) I AMQQDFN,^UTILITY("AMQQ",$J,"Q",AMQQI)'["EXISTS",$P(^AMQQ(5,AMQQDFN,0),U,19)="C" S AMQQNCHK="" Q
 Q:$D(AMQQNCHK)
 S AMQQBUCC=0 F AMQQPCE=1:1 Q:$P(%,";",AMQQPCE)=""  S AMQQBUCV=$P($P(%,";",AMQQPCE),":",2) I AMQQBUCV]"" S AMQQBUCV=$O(^AMQQ(5,"B",AMQQBUCV,"")) I AMQQBUCV D
 . I $P(^AMQQ(5,AMQQBUCV,0),U,19)="C" D
 .. S AMQQBUCC="C"
 .. S $P(%,";",AMQQPCE)=""
 I AMQQBUCC="C",AMQQPCE>2 D
 . S AMQQTMP="",AMQQCNTP=0 F AMQQPCE=1:1:10 I $P(%,";",AMQQPCE)]"" S AMQQCNTP=AMQQCNTP+1,AMQQPCE(AMQQCNTP)=AMQQPCE S AMQQTMP=AMQQTMP_AMQQCNTP_":"_$P($P(%,";",AMQQPCE),":",2)_";"
 . S %=AMQQTMP I $E(%,$L(AMQQTMP))=";" S %=$E(%,1,($L(%)-1))
 Q
 ;
V1 F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"Q",%)) Q:'%  I +^(%)=Y S Y=^(%) Q
 I '% Q
 S A=$P(Y,U,2),B=$P(Y,U,3),C=+Y
 S C=$G(^AMQQ(1,C,4,1,1))
 I A=""!(B="") Q
 I "SLG"'[B Q
 ;S ^UTILITY("AMQQ",$J,"AGE",1,A)=X_";"_C_";"_A
 Q:$D(^UTILITY("AMQQ",$J,"AGE",1,A))  S ^(A)=X_";"_C_";"_A
 Q
 ;
V2 I %'="" S %=%_";"
 S %=%_I_":"_Z,^UTILITY("AMQQ",$J,"AGE",2,I)=C
 Q
 ;
DEV W ! S %ZIS="Q",%ZIS("B")="" D ^%ZIS S AMQQIOP=IO
 I POP K POP S AMQQQUIT="" Q
 D PRINT^AMQQSEC E  W "  <= Not a secure device!!",*7 G DEV
 I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G DEV
 Q
 ;
AGETASK S ZTRTN="AGERUN^AMQQRMA",ZTIO=ION,ZTDTH="NOW"
 S ZTDESC="QUERY UTILITY AGE BUCKET UTILITY"
 F I=1:1 S %=$P("AMQQRM*;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQDTE;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)="" ;IHS/OHPRD/JCM 3/17/94
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3 W @IOF
 Q
 ;
AGERUN I IOST'["P" W @IOF
 X AMQV(0)
 D PRINT^AMQQRMA1
 I IOST["P-" W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 Q
 ;

AMQQRMD
AMQQRMD ; IHS/OHPRD/JCM - DATE BUCKETS ; [ 03/17/94 6:21 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
 ; CALLS TASKMAN
 I AMQQCCLS="V" G:$D(AMQP(1)) START Q
 I '$D(AMQQHOLD)!('$D(AMQQUATN)) Q
 S %=$P($G(^UTILITY("AMQQ",$J,"AG",AMQQUATN,AMQQHOLD)),U,3) I '% Q
 S AMQP(1)=%
START I '$D(AMQQDZ) S (AMQQDZ,AMQQDX)=0
 S AMQQDZ=AMQQDZ+1
 I IOST["C-",AMQQDZ>1 W *13,AMQQDZ I AMQQDX W "  (",AMQQDX,")"
 I AMQQDZ>1 D SET Q
 I IOST["C-" W !!!!,"CRUNCH, CRUNCH....",!!
 D PRE,SET
EXIT K %,%H,%T,%Y,A,G,I,J,N,Z
 Q
 ;
FAIL S AMQQDX=AMQQDX+1
 I AMQQDZ>1 W *13,AMQQDZ,"  (",AMQQDX,")"
 Q
 ;
COUNT S (D1,AMQQDDS)=AMQQDDS\1,(D2,AMQQDDF)=AMQQDDF\1
 S Y=AMQQDDS X ^DD("DD") S AMQQDDS=Y,Y=AMQQDDF X ^DD("DD") S AMQQDDF=Y
 I (D2-D1)<8 K D1,D2 Q
 F Y=2,1 S X=@("D"_Y) D H^%DTC S X(Y)=%H
 S X(0)=%Y,X=X(2)-X(1)+1,Y=X\7,Z=X#7
 S %=$E("01234560123456",%Y+1,%Y+Z)
 S X="" F I=1:1:7 S X=X_(Y+(%[(I-1)))_U
 S AMQQDD=X K D1,D2
 Q
 ;
PRE K ^UTILITY("AMQQ",$J,"DOW")
 S AMQQDGR="^UTILITY(""AMQQ"",$J,""DOW"")"
 F I=0:1:23 S @AMQQDGR@("B",I)=0
 F I=0:1:6 S @AMQQDGR@("C",I)=0
 S AMQQDTOT=0
 Q
 ;
SET S %=+^AUPNVSIT(AMQP(1),0),AMQQDAY=%\1
 I %'["." D FAIL Q
 I '$D(AMQQDDS) S AMQQDDS=%
 I '$D(AMQQDDF) S AMQQDDF=%
 I %<AMQQDDS S AMQQDDS=%
 I %>AMQQDDF S AMQQDDF=%
 S %=$P(%,".",2),%="."_%,%=$J(%,1,4),AMQQDTIM=(%*100)\1
 S X=AMQQDAY D H^%DTC S AMQQDAY=%Y
 S %=$G(@AMQQDGR@("A",AMQQDTIM,AMQQDAY)),^(AMQQDAY)=%+1
 S %=$G(@AMQQDGR@("B",AMQQDTIM)),^(AMQQDTIM)=%+1
 S %=$G(@AMQQDGR@("C",AMQQDAY)),^(AMQQDAY)=%+1
 S AMQQDTOT=AMQQDTOT+1
 Q
 ;
PRINT I '$D(AMQQDDS) G PEXIT
 D COUNT,HEADER
 S AMQQDGR="^UTILITY(""AMQQ"",$J,""DOW"")"
 F AMQQDLIN=0:1:23 D:AMQQDLIN&'(AMQQDLIN#(IOSL-4)) PAUSE G:AMQQDLIN=999999 PEXIT D B1
 W !!,"TOTAL"
 S I=0
 F J=16:8 W ?J,@AMQQDGR@("C",I) S I=I+1 I I=7 W ?(J+8),AMQQDTOT Q
 I $D(AMQQDD) W !,"DAYS" S (I,N)=0 F J=16:8 S I=I+1 W ?J,$P(AMQQDD,U,I) S N=N+$P(AMQQDD,U,I) I I=7 W ?(J+8),N Q
 I $D(AMQQDD) W !,"AVERAGE" S I=0 F J=16:8 D AVE I I=7 W ?(J+8) S %=AMQQDTOT/N,%=$J(%,1,1) W % Q
 I IOST'?1"C-".E W @IOF D ^%ZISC G PEXIT
 D ^%ZISC R !!,"<>",AMQQDY:DTIME
PEXIT K X,Y,Z,A,G,AMQQDZ,AMQQDX,AMQQDLIN,N,AMQQDAY,AMQQDTIM,AMQQDTOT,%H,%Y,%T,AMQQDY,AMQQDGR,AMQQDDS,AMQQDDF,AMQQDD,AMQQRMFL
 Q
 ;
AVE S I=I+1
 I '$P(AMQQDD,U,I) S %=0
 E  S %=@AMQQDGR@("C",I-1)/$P(AMQQDD,U,I)
 S %=$J(%,1,1)
 W ?J,%
 Q
 ;
B1 S %=AMQQDLIN,%=%*100,X=%,Y=%+59,I=0
 I %<1000 S X="0"_X,Y="0"_Y
 I X="00" S X="0000",Y="0059"
 W !,X,"-",Y
 F J=16:8 W ?J,$S($D(@AMQQDGR@("A",AMQQDLIN,I)):^(I),1:".") S I=I+1 I I=7 W ?(J+8),@AMQQDGR@("B",AMQQDLIN) Q
 Q
 ;
PAUSE I IOST["C-" R !,"<>",AMQQRQ:DTIME S:'$T!(AMQQRQ=U) AMQQDLIN=999999 K AMQQRQ
 I AMQQDLIN=999999 Q
 D HEADER
 Q
 ;
HEADER W @IOF
 W !,"WORKLOAD DISTRIBUTION REPORT: ",AMQQDDS," to ",AMQQDDF,!
 W "VISIT TIME"
 S I=0 F J=14:8 S I=I+1 W ?J,$P("SUN^MON^TUE^WED^THU^FRI^SAT",U,I) I I=7 W ?(J+8),"TOT" Q
 S AMQQDY="",$P(AMQQDY,"-",80)="" W !,AMQQDY
 K AMQQRI,AMQQRJ,AMQQDY
 Q
 ;
WORKTASK S ZTRTN="WORKRUN^AMQQRMD",ZTIO=ION,ZTDTH="NOW"
 S ZTDESC="Q-MAN WORKLOAD DISTRIBUTION REPORT"
 F I=1:1 S %=$P("AMQQRMFL;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)="" ;IHS/OHPRD/JCM 3/17/94
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3
 Q
 ;
WORK ; ENTRY POINT FROM AMQQCMPL
 D DEV I $D(AMQQQUIT) Q
 S AMQQRMFL="^AMQQRMD"
 I $D(IO("Q")) D WORKTASK D ^%ZISC W @IOF Q
 U IO D WORKRUN D ^%ZISC
 Q
 ;
DEV W !!! S %ZIS="Q" D ^%ZIS
 I POP K DUOUT,DTOUT,POP S AMQQQUIT=""
 D PRINT^AMQQSEC E  W "  <= Not a secure device!!",*7 G DEV
 I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G DEV
 Q
 ;
WORKRUN W @IOF
 X AMQV(0)
 D PRINT
 I IOST["P-" W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 Q
 ;

AMQQRMH
AMQQRMH ; IHS/OHPRD/JCM - HEALTH SUMMARY GENERATOR ; [ 03/17/94 6:22 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
 ; CALLS TASKMAN
HSUM ; - EP - FROM ^AMQQCMPL
 W ! S DIC="^APCHSCTL(",DIC(0)="AEQ",DIC("A")="HEALTH SUMMARY TYPE: "
 S DIC("B")="ADULT REGULAR"
 D ^DIC K DIC
 I Y=-1 S AMQQQUIT="",AMQQOPT("SPEC")="" Q
 S APCHSTYP=+Y
 D DEV I $D(AMQQQUIT) Q
 S AMQQRMFL="OUTPUT^AMQQRMH"
 I $D(IO("Q")) D HSUMTASK D ^%ZISC W @IOF Q
 U IO D HSUMRUN D ^%ZISC
EXIT K %,I
 Q
 ;
DEV W !!! S %ZIS="Q" D ^%ZIS
 I POP K DUOUT,DTOUT,POP S AMQQQUIT=""
 D PRINT^AMQQSEC E  W "  <= Not a secure device!!",*7 G DEV
 I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G DEV
 Q
 ;
HSUMRUN W @IOF
 X AMQV(0)
 I IOST["P-" W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 K AMQQRMFL,APCHSTYP,APCHSPAT
 Q
 ;
HSUMTASK S ZTRTN="HSUMRUN^AMQQRMH",ZTIO=ION,ZTDTH="NOW"
 F I=1:1 S %=$P("AMQQRMFL;APCHSTYP;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)="" ;IHS/OHPRD/JCM 3/17/94
 S ZTDESC="Q-MAN HEALTH SUMMARY GENERATOR"
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3
 Q
 ;
OUTPUT ; ENTRY POINT
 I $D(AMQP(0)),$D(APCHSTYP) S X="",APCHSPAT=AMQP(0) D EN^APCHS
 I $G(X)=U S AMQQQUIT="" F %=AMQQOV,.1,1,2,3,5,10 S AMQP(%)=99999999999
 Q
 ;

AMQQRML
AMQQRML ; IHS/OHPRD/JCM - MAILING LABEL GENERATOR ; [ 03/02/2000  11:13 PM ]
 ;;2;PCC QUERY UTILITY;**4,16**;JUN 10, 1993
 ; CALLS TASKMAN
VAR K AMQQQUIT,AMQQLJB
RUN D EXIT F AMQQL("RUN")=1:1 S %=$P("FORMAT^TEST^SET",U,AMQQL("RUN")) Q:%=""  D @% Q:$D(AMQQQUIT)
EXIT K AMQQLHO,AMQQLCW,AMQQLLM,AMQQLTF,AMQQLLC,AMQQLLN,AMQQLCF,AMQQL,AMQQLDA,I,%
 Q
 ;
FORMAT W @IOF,!!,?15,"*****  ADDRESS LABEL UTILITY  *****",!!
 S DA(1)=DUZ(2) I '$D(^AMQQ(8,DA(1),2)) S ^(2,0)="^9009078.02P^^"
 S DIE="^AMQQ(8,",DA=DUZ(2),DR=20,DR(2,9009078.02)="S AMQQLLP=D1;.02//6;.03//30;.04//7;2;.05//1" K AMQQLLP D ^DIE
 K DIE,DA,DR,DIC,D,D0,DI,DQ,D1
 I $D(DUOUT)!($D(DTOUT))!('$G(AMQQLLP)) S AMQQRERF="" D OUT Q
 S %=+$G(^AMQQ(8,DUZ(2),2,AMQQLLP,0)) I '% D OUT Q
 I $G(^%ZIS(1,%,0))="" D OUT Q
 S AMQQLDA=AMQQLLP,AMQQLLP=%
 W !!
 Q
 ;
TEST W "Want to do a test print" S %=1 D YN^DICN
 I $D(DUOUT)!($D(DTOUT))!($E(%Y)=U) Q
 S AMQQL("RUN")=2
 I "Yy"[$E(%Y) S AMQQLTF="" Q
 K AMQQLTF
 Q
 ;
OUT K DUOUT,DTOUT,POP S AMQQQUIT=""
 W !!,"Query terminated...",*7,!! H 2
 Q
 ;
SET I $D(AMQQLTF) G SET1
 S %=+^%ZIS(1,AMQQLLP,"SUBTYPE"),%=$P(^%ZIS(2,%,0),U) I %'["P-" G SET1
 W !!,"Want to run this print job in the background" S %=1 D YN^DICN I $D(DUOUT)!($D(DTOUT))!($E(%Y)=U) D OUT Q
 I "Yy"[$E(%Y) S AMQQLJB=""
SET1 ;
 S %=^AMQQ(8,DUZ(2),2,AMQQLDA,0)
 F X=1:1:5 S @("AMQQL"_$P("LP^HO^CW^RH^LL",U,X))=$P(%,U,X)
 S %=AMQQLHO F X=1:1:(AMQQLLL-1) S %=%_U_(AMQQLHO+(AMQQLCW*X))
 S AMQQLHT=%,AMQQLBC=0,AMQQLGR="^UTILITY(""AMQQ"",$J,""LABEL"")"
 I $D(AMQQLTF) W ! D  S:$D(AMQQLPTR) %IS("B")=AMQQLPTR D ^%ZIS Q:POP  U IO W @IOF D EXAMPLE K %IS("B") Q
 . I $D(AMQQLLP) S AMQQLPTR=$P(^%ZIS(1,AMQQLLP,0),U)
PRINT S AMQQRMFL="OUTPUT^AMQQRML"
 Q
 ;
EXAMPLE F AMQQLTF=1:1:(AMQQLLL*3) S %="JOHN SMITH^1234 S. MAIN ST.^^^TUCSON^3^85745" D OUTPUT
 X ^%ZIS("C")
 W !,"Want to reset label settings" S %=1 D YN^DICN
 I $D(DUOUT)!($D(DTOUT))!($E(%Y)=U) D OUT Q
 I "Yy"[$E(%Y) S AMQQL("RUN")=0 Q
 K AMQQLTF S AMQQL("RUN")=2
 Q
 ;
OUTPUT I $D(AMQQLTF) G S1
 I 'AMQP(0) Q
 I '$D(^DPT(AMQP(0),.11)) Q
 S %=^DPT(AMQP(0),.11),Z=$P(^DPT(AMQP(0),0),U),Z=$P(Z,",",2,9)_" "_$P(Z,","),%=Z_U_%
S1 S Y=0,AMQQLLN=0,AMQQLBC=AMQQLBC+1
 ;IHS/CMI/THL 03/01/2000 PATCH 16
 S $P(%,U,4)=$P(%,U,5)
 S $P(%,U,5)=$P(%,U,6)
 S $P(%,U,6)=$P(%,U,7)
 I $P(%,U,2)="" S $P(%,U,2)="NO ADDRESS LISTED"
 I $P(%,U,4)="" S $P(%,U,4)="NO CITY"
 I $P(%,U,5)="" S $P(%,U,5)="NO STATE"
 E  S $P(%,U,5)=$P($G(^DIC(5,+$P(%,U,5),0)),U,2)
 I $P(%,U,6)="" S $P(%,U,6)="NO ZIP"
 S $P(%,U,4)=$P(%,U,4)_", "_$P(%,U,5)
 S $P(%,U,5)=$P(%,U,6)
 I $P(%,U,3)="" D
 .S $P(%,U,3)=$P(%,U,4)
 .S $P(%,U,4)=$P(%,U,5)
 .S $P(%,U,5)="   "
 S $P(%,U,6)="   "
 ;I $P(%,U,5)=""!('$P(%,U,6)) S $P(%,U,5,6)="*** VOID ***" G S2
 ;S $P(%,U,5,6)=$P(%,U,5)_","_$P($G(^DIC(5,$P(%,U,6),0)),U,2)
S2 F X=1:1:6 S Z=$E($P(%,U,X),1,21) D GET
 ;IHS/CMI/THL 03/01/2000 PATCH 16
 I AMQQLBC=AMQQLLL D FLUSH
 Q
 ;
GET I Z="",X'=3,X'=4 S Z="*** VOID ***"
 I Z="" Q
 S Y=Y+1,@AMQQLGR@(AMQQLBC,Y)=Z
 Q
 ;
FLUSH ; - EP - FROM AMQQRML
 F AMQQLCT=1:1:6 D
 .F AMQQLBF=1:1:AMQQLLL I $D(@AMQQLGR@(AMQQLBF,AMQQLCT)) D
 ..W ?$P(AMQQLHT,U,AMQQLBF),@AMQQLGR@(AMQQLBF,AMQQLCT)
 ..I AMQQLCT>AMQQLLN S AMQQLLN=AMQQLCT
 ..I AMQQLBF=AMQQLLL W !
 ..Q
 .Q
 F X=1:1:(AMQQLRH-AMQQLLN) W !
 K @AMQQLGR S AMQQLBC=0
 Q
 ;
MAILX ; ENTRY POINT FROM AMQQCMPL
 S AMQQRMFL="OUTPUT^AMQQRML"
 I '$D(AMQQLLP) Q
 S IOP=$P(^%ZIS(1,AMQQLLP,0),U) D ^%ZIS
 I $D(AMQQLJB) D MAILTASK Q
 U IO D MAILRUN D ^%ZISC
 K AMQQRMFL,AMQQLJB,AMQQLGR,AMQQLLL,AMQQLRH,AMQQLHT,AMQQLLP,AMQQLLN,AMQQLHO,AMQQLCW,AMQQLCT,AMQQLBF,AMQQLBC
 Q
 ;
MAILRUN X AMQV(0)
 S AMQQLLL=0 F X=0:0 S X=$O(@AMQQLGR@(X)) Q:'X  S AMQQLLL=X
 I AMQQLLL D FLUSH^AMQQRML
 I IOST["P-" W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 Q
 ;
MAILTASK S ZTRTN="MAILRUN^AMQQRML",ZTIO=ION,ZTDTH="NOW"
 S ZTDESC="QUERY UTILITY MAILING LABELS"
 F I=1:1 S %=$P("AMQQRMFL;AMQQL*;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)="" ;IHS/OHPRD/JCM 3/17/94
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3 W @IOF
 Q
 ;
HELP ; ENTRY POINT
 ;N (DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED)
 S XQH="AMQQLABEL" D EN1^XQH
 R !,"<>",X:DTIME
 Q
 ;

AMQQRMM
AMQQRMM ; IHS/OHPRD/JCM - MONTH BUCKETS ; [ 11/13/98  2:12 PM ]
 ;;2;PCC QUERY UTILITY;**4,11**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 11 for Y2K
 ; CALLS TASKMAN
 I AMQQCCLS="V" G:$D(AMQP(1)) START Q
 I '$D(AMQQHOLD)!('$D(AMQQUATN)) Q
 S %=$P($G(^UTILITY("AMQQ",$J,"AG",AMQQUATN,AMQQHOLD)),U,3) I '% Q
 S AMQP(1)=%
START I '$D(AMQQMZ) S (AMQQMZ,AMQQMX)=0
 S AMQQMZ=AMQQMZ+1
 I IOST["C-",AMQQMZ>1 W *13,AMQQMZ I AMQQMX W "  (",AMQQMX,")"
 I AMQQMZ>1 D SET Q
 I IOST["C-" W !!!!,"CRUNCH, CRUNCH....",!!
 D PRE,SET
EXIT K %,%H,%T,%Y,A,G,I,J,M,N,Z
 Q
 ;
FAIL S AMQQMX=AMQQMX+1
 I AMQQMZ>1 W *13,AMQQMZ,"  (",AMQQMX,")"
 Q
 ;
RANGE S AMQQMDS=AMQQMDS\1,AMQQMDF=AMQQMDF\1
 S (Z(1),Y)=AMQQMDS\1 X ^DD("DD") S AMQQMDS=Y,(Z(2),Y)=AMQQMDF\1 X ^DD("DD") S AMQQMDF=Y
 S AMQQMDS=$P(AMQQMDS," ")_" "_$P(AMQQMDS,",",2),AMQQMDF=$P(AMQQMDF," ")_" "_$P(AMQQMDF,",",2)
 S Y(1)=+$E(Z(1),1,3),Y(2)=+$E(Z(2),1,3),M(1)=+$E(Z(1),4,5),M(2)=+$E(Z(2),4,5)
 S %=1+(M(2)-M(1))+((Y(2)-Y(1))*12),X=%\12,Y=%#12
 F I=1:1:12 S $P(AMQQMCS,U,I)=X
 F I=M(1):1:(M(1)+Y-1) S Z=$P("1^2^3^4^5^6^7^8^9^10^11^12^1^2^3^4^5^6^7^8^9^10^11^12",U,I) S $P(AMQQMCS,U,Z)=X+1
 K X,Y,Z,%,M,I
 Q
 ;
PRE K ^UTILITY("AMQQ",$J,"MON")
 S AMQQMGR="^UTILITY(""AMQQ"",$J,""MON"")"
 F I=0:1:12 S @AMQQMGR@(I)=0
 S AMQQMTOT=0
 Q
 ;
SET S %=+^AUPNVSIT(AMQP(1),0)
 I %'["." D FAIL Q
 I '$D(AMQQMDS) S AMQQMDS=%
 I '$D(AMQQMDF) S AMQQMDF=%
 I %<AMQQMDS S AMQQMDS=%
 I %>AMQQMDF S AMQQMDF=%
 ;beginning Y2K - CMI/TUCSON/LAB - fixed line below for Y2K
 ;S AMQQMON=+$E(%,4,5),AMQQMYR=1900+$E(%,2,3) ;Y2000 commented out and replaced with line below IHS/CMI/LAB
 S AMQQMON=+$E(%,4,5),AMQQMYR=1700+$E(%,1,3) ;Y2000 IHS/CMI/LAB
 ;end Y2K changes IHS/CMI/LAB
 S @AMQQMGR@(AMQQMON,AMQQMYR)=""
 S %=$G(@AMQQMGR@(AMQQMON)),^(AMQQMON)=%+1
 S AMQQMTOT=AMQQMTOT+1
 Q
 ;
PRINT I '$D(AMQQMDS) G PEXIT
 D RANGE,HEADER
 F AMQQMON=1:1:12 D
 .W !,$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,AMQQMON)
 .S X=^UTILITY("AMQQ",$J,"MON",AMQQMON) W ?8,$J(X,6)
 .S Y=$P(AMQQMCS,U,AMQQMON) W ?18,Y
 .W ?24,$S(Y=0:0,1:$J((X/Y),8,2))
 .Q
 I IOST'?1"C-".E W @IOF D ^%ZISC G PEXIT
 D ^%ZISC R !!,"<>",AMQQMY:DTIME
PEXIT K X,Y,Z,A,G,AMQQMZ,AMQQMX,AMQQMLIN,N,AMQQMAY,AMQQMTIM,AMQQMTOT,%H,%Y,%T,AMQQMY,AMQQMGR,AMQQMDS,AMQQMDF,AMQQMCS,AMQQMON,AMQQMYR,AMQQRMFL
 Q
 ;
AVE S I=I+1
 I '$P(AMQQMD,U,I) S %=0
 E  S %=@AMQQMGR@("C",I-1)/$P(AMQQMD,U,I)
 S %=$J(%,1,1)
 W ?J,%
 Q
 ;
B1 S %=AMQQMLIN,%=%*100,X=%,Y=%+59,I=0
 I %<1000 S X="0"_X,Y="0"_Y
 I X="00" S X="0000",Y="0059"
 W !,X,"-",Y
 F J=16:8 W ?J,$S($D(@AMQQMGR@("A",AMQQMLIN,I)):^(I),1:".") S I=I+1 I I=7 W ?(J+8),@AMQQMGR@("B",AMQQMLIN) Q
 Q
 ;
PAUSE I IOST["C-" R !,"<>",AMQQRQ:DTIME S:'$T!(AMQQRQ=U) AMQQMLIN=999999 K AMQQRQ
 I AMQQMLIN=999999 Q
 D HEADER
 Q
 ;
HEADER W @IOF
 W !,"MONTH BUCKET REPORT: ",AMQQMDS," to ",AMQQMDF,!!
 W "MONTH",?9,"TOTAL",?16,"MONTH",?27,"AVG",!?16,"COUNT",?24,"PER MONTH"
 S AMQQMY="",$P(AMQQMY,"-",35)="" W !,AMQQMY
 K AMQQRI,AMQQRJ,AMQQMY
 Q
 ;
MONTASK S ZTRTN="MONRUN^AMQQRMM",ZTIO=ION,ZTDTH="NOW"
 F I=1:1 S %=$P("AMQQRMFL;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)="" ;IHS/OHPRD/JCM 3/17/94
 S ZTDESC="Q-MAN MONTHLY WORKLOADLOAD REPORT"
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3
 Q
 ;
MON ; ENTRY POINT FROM AMQQCMPL
 D DEV I $D(AMQQQUIT) Q
 S AMQQRMFL="^AMQQRMM"
 I $D(IO("Q")) D MONTASK D ^%ZISC W @IOF Q
 U IO D MONRUN D ^%ZISC
 Q
 ;
DEV W !!! S %ZIS="Q" D ^%ZIS
 I POP K DUOUT,DTOUT,POP S AMQQQUIT=""
 D PRINT^AMQQSEC E  W "  <= Not a secure device!!",*7 G DEV
 I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G DEV
 Q
 ;
MONRUN W @IOF
 X AMQV(0)
 D PRINT
 I IOST["P-" W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 Q
 ;

AMQQRMT
AMQQRMT ; IHS/OHPRD/JCM - TIME SERIES REPORT ; [ 11/13/98  2:42 PM ]
 ;;2;PCC QUERY UTILITY;**4,11**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 11 Y2K
 ; CALLS TASKMAN
 I AMQQCCLS="V" G:$D(AMQP(1)) START Q
 I '$D(AMQQHOLD)!('$D(AMQQUATN)) Q
 S %=$P($G(^UTILITY("AMQQ",$J,"AG",AMQQUATN,AMQQHOLD)),U,3) I '% Q
 S AMQP(1)=%
START I '$D(AMQQTZ) S (AMQQTZ,AMQQTX)=0
 S AMQQTZ=AMQQTZ+1
 I IOST["C-",AMQQTZ>1 W *13,AMQQTZ I AMQQTX W "  (",AMQQTX,")"
 I AMQQTZ>1 D SET Q
 I IOST["C-" W !!!!,"CRUNCH, CRUNCH....",!!
 D PRE,SET
EXIT K %,%H,%T,%Y,A,G,I,J,N
 Q
 ;
FAIL S AMQQTX=AMQQTX+1
 I AMQQTZ>1 W *13,AMQQTZ,"  (",AMQQTX,")"
 Q
 ;
RANGE S AMQQTDS=AMQQTDS\1,AMQQTDF=AMQQTDF\1
 S (Z(1),Y)=AMQQTDS\1 X ^DD("DD") S AMQQTDS=Y,(Z(2),Y)=AMQQTDF\1 X ^DD("DD") S AMQQTDF=Y
 S Z(3)=Z(2)-Z(1)+1
 S AMQQTDS=$P(AMQQTDS,",",2),AMQQTDF=$P(AMQQTDF,",",2)
 ;beginning Y2K IHS/CMI/LAB
 ;S (Z,AMQQTY2)=1900+$E(Z(2),2,3),AMQQTY1=1900+$E(Z(1),2,3) ;Y2000 IHS/CMI/LAB - commented out this line and replaced with line below
 S (Z,AMQQTY2)=1700+$E(Z(2),1,3),AMQQTY1=1700+$E(Z(1),1,3) ;Y2000 IHS/CMI/LAB
 ;end Y2K IHS/CMI/LAB
 I Z(3)>6 S Z(3)=6
 F I=1:1:Z(3) S $P(AMQQTCS,U,I)=(Z-I+1)
 S AMQQTST=(+$E(Z(2),1,3)-5)*10000,AMQQTNM=Z(3)*12
 K Z
 Q
 ;
PRE K ^UTILITY("AMQQ",$J,"TS")
 S AMQQTGR="^UTILITY(""AMQQ"",$J,""TS"")"
 ; F I=1980:1:2000 F J=1:1:12 S @AMQQTGR@("AMQQ",$J,"TS",I,J)=""
 S AMQQTTOT=0
 Q
 ;
SET S %=+^AUPNVSIT(AMQP(1),0)
 I %'["." D FAIL Q
 I '$D(AMQQTDS) S AMQQTDS=%
 I '$D(AMQQTDF) S AMQQTDF=%
 I %<AMQQTDS S AMQQTDS=%
 I %>AMQQTDF S AMQQTDF=%
 ;beginning Y2K IHS/CMI/LAB
 ;S AMQQTMON=+$E(%,4,5),AMQQTYR=1900+$E(%,2,3) ;Y2000 - IHS/CMI/LAB - commented out this line and replaced with line below
 S AMQQTMON=+$E(%,4,5),AMQQTYR=1700+$E(%,1,3) ;Y2000 - IHS/CMI/LAB
 ;end Y2K IHS/CMI/LAB
 S %=$G(@AMQQTGR@(AMQQTYR,AMQQTMON)),^(AMQQTMON)=%+1
 S %=$G(@AMQQTGR@(AMQQTYR)),^(AMQQTYR)=%+1
 S %=$G(@AMQQTGR@(AMQQTMON)),^(AMQQTMON)=%+1
 S AMQQTTOT=AMQQTTOT+1
 Q
 ;
PRINT I '$D(AMQQTDS) G PEXIT
 D RANGE,HEADER
 F AMQQTMON=1:1:12 D
 .W !,$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER",U,AMQQTMON)
 .S AMQQTAB=11 F AMQQTYR=AMQQTY2:-1:AMQQTY1 D
 ..W ?AMQQTAB,$J(+$G(@AMQQTGR@(AMQQTYR,AMQQTMON)),6) S AMQQTAB=AMQQTAB+11
 ..I AMQQTYR=AMQQTY1 W ?66,$J(+$G(@AMQQTGR@(AMQQTMON)),6)
 W !!,"TOTAL" S AMQQTAB=11 F AMQQTYR=AMQQTY2:-1:AMQQTY1 W ?AMQQTAB,$J(+$G(@AMQQTGR@(AMQQTYR)),6) S AMQQTAB=AMQQTAB+11 I AMQQTYR=AMQQTY1 W ?66,$J(AMQQTOT,6)
 W !,"CUMUL." S X=0,AMQQTAB=11 F AMQQTYR=AMQQTY2:-1:AMQQTY1 S X=X+$G(@AMQQTGR@(AMQQTYR)) W ?AMQQTAB,$J(X,6) S AMQQTAB=AMQQTAB+11 I AMQQTYR=AMQQTY1 W ?66,$J(X,6)
 W !,"AVG/MONTH" S AMQQTAB=11 F AMQQTYR=AMQQTY2:-1:AMQQTY1 S X=+$G(@AMQQTGR@(AMQQTYR))\12 W ?AMQQTAB,$J(X,6) S AMQQTAB=AMQQTAB+11 I AMQQTYR=AMQQTY1 W ?66,$J((AMQQTOT\AMQQTNM),6)
 I IOST'?1"C-".E W @IOF D ^%ZISC G PEXIT
 D ^%ZISC R !!,"<>",AMQQTY:DTIME
PEXIT K X,Y,Z,A,G,AMQQTZ,AMQQTX,AMQQTLIN,N,AMQQTAY,AMQQTTIM,AMQQTTOT,%H,%Y,%T,AMQQTY,AMQQTGR,AMQQTDS,AMQQTDF,AMQQTCS,AMQQTST,AMQQTY1,AMQQTY2,AMQQTNM,AMQQTMON,AMQQTYR,AMQQTAB,AMQQRMFL
 Q
 ;
AVE S I=I+1
 I '$P(AMQQTD,U,I) S %=0
 E  S %=@AMQQTGR@("C",I-1)/$P(AMQQTD,U,I)
 S %=$J(%,1,1)
 W ?J,%
 Q
 ;
B1 S %=AMQQTLIN,%=%*100,X=%,Y=%+59,I=0
 I %<1000 S X="0"_X,Y="0"_Y
 I X="00" S X="0000",Y="0059"
 W !,X,"-",Y
 F J=16:8 W ?J,$S($D(@AMQQTGR@("A",AMQQTLIN,I)):^(I),1:".") S I=I+1 I I=7 W ?(J+8),@AMQQTGR@("B",AMQQTLIN) Q
 Q
 ;
PAUSE I IOST["C-" R !,"<>",AMQQRQ:DTIME S:'$T!(AMQQRQ=U) AMQQTLIN=999999 K AMQQRQ
 I AMQQTLIN=999999 Q
 D HEADER
 Q
 ;
HEADER W @IOF
 W !,"TIME SERIES REPORT: ",AMQQTDS," to ",AMQQTDF,!!
 S I=0 F X=13:11:60 S I=I+1 W ?X,$P(AMQQTCS,U,I)
 W ?66,"TOTAL"
 S AMQQTY="",$P(AMQQTY,"-",75)="" W !,AMQQTY
 K AMQQRI,AMQQRJ,AMQQTY
 Q
 ;
TIMETASK S ZTRTN="TIMERUN^AMQQRMT",ZTIO=ION,ZTDTH="NOW"
 F I=1:1 S %=$P("AMQQRMFL;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)="" ;IHS/OHPRD/JCM 3/17/94
 S ZTDESC="Q-MAN TIME-SERIES REPORT"
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3
 Q
 ;
TIME ; ENTRY POINT FROM AMQQCMPL
 D DEV I $D(AMQQQUIT) Q
 S AMQQRMFL="^AMQQRMT"
 I $D(IO("Q")) D TIMETASK D ^%ZISC W @IOF Q
 U IO D TIMERUN D ^%ZISC
 Q
 ;
DEV W !!! S %ZIS="Q" D ^%ZIS
 I POP K DUOUT,DTOUT,POP S AMQQQUIT=""
 D PRINT^AMQQSEC E  W "  <= Not a secure device!!",*7 G DEV
 I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G DEV
 Q
 ;
TIMERUN W @IOF
 X AMQV(0)
 D PRINT
 I IOST["P-" W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 Q
 ;

AMQQSQA
AMQQSQA ; OHPRD/DG - AMQQSQ SUBROUTINE GETS FUNCTIONS ; [ 10/17/95  5:00 PM ]
 ;;2;PCC QUERY UTILITY;**8**;SEPT 18, 1995
VAR K AMQQSQNT,AMQQSQQT,AMQQSQDV
 I $D(AMQQYYMI) D AUTO G F1
RUN S AMQQSQQQ=$S(AMQQSQFN=1:"First",1:"Next")_$S($D(AMQQGVF):" generic visit condition",1:(" condition of """_AMQQSQSJ_""""))_": " ;/IHS/OHPRD/TMJ 9/15/95
FUN W:'$D(AMQQXX) ! D ^AMQQSQA0
F1 I $G(AMQQSQQT)'="QUIT",$D(Y),+Y=0 S AMQQQUIT="" W:'$D(AMQQXX) "  ??",*7
 I $D(AMQQSQQT)!$D(AMQQQUIT) G EXIT
 I ((+Y=306)&(AMQQSQSN'=253))!(+Y=307) S AMQQSQQQ="Condition: ",AMQQSQDV=+Y G FUN
 D SET
 I $D(AMQQSQVV) K AMQQSQVV G EXIT
 I AMQQSQN=306,AMQQSQSN=253 D ^AMQQSQBP S AMQQSQCT="B" G EXIT
 I AMQQSQSN=258!(AMQQSQSN=257),AMQQSQN=306 D ^AMQQSQVS S AMQQSQCT="B" G EXIT
 I "NC"[AMQQSQCT S AMQQSQCV="" G EXIT
 D ^AMQQSQA1 I $D(AMQQQUIT) K AMQQQUIT G RUN
EXIT K %,AMQQSQDV,AMQQZSQL,AMQQSQRD,AMQQLCOF,%A,%B,A,B,C,D,I,S,Z
 Q
 ;
SET S AMQQSQN=+Y,AMQQSQNM=$P(Y,U,2),AMQQSQCT=$P(^AMQQ(5,+Y,0),U,20),AMQQSQTP=$P(^(0),U,21),AMQQSQFL=$P(^(0),U,22),AMQQSQBS=$P(^(0),U,6),AMQQSQNC=$P(^(0),U,8),%=$P(^(0),U,7),AMQQSQF1=$P(%,";"),AMQQSQF2="AMQQF"_$P(%,";",2)
 I AMQQSQN=402 S AMQQSQCT="V" ; VISIT;POV
 I $D(AMQQSQNT) S AMQQSQNM=$S(AMQQSQNM="IS":"IS NOT",1:("NOT "_AMQQSQNM))
 I '$D(AMQQXX),"TO"[AMQQSQCT,'$D(AMQQSVAL) W !,"Enter the value which goes with ",AMQQSQNM,"; e.g., ",AMQQSQNM," 3, ",AMQQSQNM," 10, etc."
 Q
 ;
AUTO ; ENTER SUBQUERY BY SCRIPT
 S AMQQYYMI=$O(@AMQQXXND@(AMQQYYMI))
 I 'AMQQYYMI S AMQQSQQT="" Q
 S AMQQMMMM=@AMQQXXND@(AMQQYYMI,1),(Y,AMQQMMCC)=$P(AMQQMMMM,";"),AMQQMMVV=$P(AMQQMMMM,";",2,3)
 N X S X=AMQQMMMM D SCK^AMQQSQA0
 I $D(AMQQYYMS) K AMQQYYMS S AMQQSQQT="" Q
 Q
 ;

AMQQSQA0
AMQQSQA0 ; OHPRD/DG - AMQQSQA SUBROUTINE...GETS ATTRIBUTE ; [ 11/30/95  12:45 PM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
FUNQ W !,AMQQSQQQ R X:DTIME E  S X=U
 K AMQQSVAL
 I $E(X)="\" S X=$E(X,2,999),AMQQLCOF=""
 I X="",AMQQSQFN=1,"ILG"'[AMQQSQST D WHAT
 I X="AGAIN" W ! G FUNQ
 I X="ALL",AMQQSQFN=1,AMQQSQST="I" S X=""
 I X="" S AMQQSQQT="QUIT" Q
 I $E(X)=U S AMQQQUIT="" Q
 I X?1."?",AMQQSQSN=378 S X="AF^29" D EN1^AMQQHELP G FUNQ
 I $D(AMQQSQDV),X?1."?" D EN2^AMQQHEL2 G FUNQ
 I $D(AMQQGVF)!($G(AMQQSQSN)=226),X?1."?" S X="AF^17" D ^AMQQHELP G FUNQ
 I X="?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQHELP","")) D EN1^XQH G FUNQ
 I X?4."?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQANAL","")) D EN1^XQH G FUNQ
 I X?2.3"?",$D(AMQQSQCF) N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQBOOL","")) D EN1^XQH G FUNQ
 I X="??" D EN1^AMQQHEL2 G FUNQ
TEMPLOOK I X="????",AMQQCCLS="P" D ITEM^AMQQHELP G FUNQ
 I X[" ",$E(X,$L(X))?1N S AMQQSVAL=$P(X," ",$L(X," ")),X=$P(X," ",1,$L(X," ")-1)
 I "><="[$E(X) S X=$TR(X," ","") I +$E(X,2,9) S AMQQSVAL=$E(X,2,99),X=$E(X)
EN1 ; ENTRY POINT FROM AMQQQ1
 I X["NOT"!(X["'") D NOT I X="" G FUNQ
 I X="VISIT" W !!,"Enter a specific VISIT characteristic like: LOCATION, CLINIC, PROVIDER etc.",!! G FUNQ
ADIC S DIC="^AMQQ(5,",DIC(0)="ES",D="C"
 I $D(AMQQXX),$D(AMQQNECO) S DIC(0)=""
 D ^AMQQSQAC,IX^DIC K DIC
SY I +Y=315!(+Y=35) D ^AMQQSQP Q:$D(AMQQQUIT)  G FUNQ
 I Y'=-1,AMQQCCLS="V",'$D(AMQQXX),$P(^AMQQ(5,+Y,0),U,20)="M" D NOVM G FUNQ
 I $D(AMQQSQNT),"EV"[AMQQSQST,$P(^AMQQ(5,+Y,0),U,20)="B",Y["BETWEEN" S X="",Y=-1,AMQQSQFN=1 K AMQQSQNT
 I Y=-1 D SPEC I '$D(Y) Q
 I Y=-1,$D(AMQQXX) S AMQQFAIL=10 Q
 I Y=-1 W "  ??",*7,! K AMQQSQNT G FUNQ
 I $P(Y,U,2)="VALUE" W !,"OK, enter the logical condition to be applied to the attribue ""VALUE""...",! G FUNQ
 I $P(^AMQQ(5,+Y,0),U,4)=99 W !,"Enter the specific name of the ",$P($P(Y,U,2),",") W !! G FUNQ
 I $P(^AMQQ(5,+Y,0),U,5)=9 D EN1^AMQQATAL I $D(AMQQNOL) K AMQQNOL S Y=-1 K AMQQSQNT G FUNQ
 S %=^AMQQ(5,+Y,0),%=$P(%,U,5) I % S:%=9 %=+Y+($J/100000) S %=^AMQQ(1,%,0),%=$P(%,U,5) I %=7 S AMQQSQRD=""
 I $D(AMQQZSQL),+Y S %=AMQQZSQL K AMQQSQZL S ^UTILITY("AMQQ",$J,"SQXL",+%,$P(%,U,2),$P(%,U,3))=""
 I AMQQSQST="V",$P(^AMQQ(5,+Y,0),U,20)="B" D ^AMQQSQVS G:('$D(AMQQQUIT)&($G(AMQQSQCV)="")) FUNQ Q
 I AMQQSQST="E",$P(^AMQQ(5,+Y,0),U,20)="B" S AMQQDISV=$P(Y,U,2) D ^AMQQSQBP G:('$D(AMQQQUIT)&($G(AMQQSQCV)="")) FUNQ Q
 Q
 ;
NOT I $E(X,1,4)="NOT " S X=$E(X,5,99),AMQQSQNT="" Q
 I $E(X)="'" S X=$E(X,2,99),AMQQSQNT="" Q
 S %=$L(X) I $E(X,%-3,%)=" NOT" S X=$E(X,1,%-4),AMQQSQNT=""
 Q
 ;
SPEC I X="*" W "  (All values)"
 I X="@" W "  (Null)"
SCK ; ENTRY POINT FROM AMQQSQA
 S Z="ANY;*;ALL;EXISTS;BLANK;EMPTY;NULL;@" F I=1:1 S %=$P(Z,";",I) Q:%=""  I X=$E(%,1,$L(X)) W $E(%,$L(X)+1,99) S X=% D S1 G SCKEXIT
 I $G(AMQQSQST)="Q",$L(X)>2 S %=$E(X,1,3) F I=1:1 S Z=$P("POS^ABN^NEG^NML^NOR",U,I) Q:Z=""  I Z=% S AMQQSVAL=$S($E(Z)="N":"NEG",1:"POS"),Y="72^IS" G SCKEXIT
 I $G(AMQQSQST)="S",$L(X)>2 D SET^AMQQSQA1 G SCKEXIT
SCKEXIT I $D(AMQQRECV),$G(AMQQCOMP)'="" S $P(AMQQRECV,U,11)=$P(AMQQCOMP,";",4)
 Q
 ;
S1 S X=$S(I=1:"ANY",I<5:"ALL",1:"NULL") K Y
 I AMQQSQST="I" S $P(AMQQCOMP,";",5)=X,AMQQSQQT="" Q
 I X'="NULL",$G(AMQQCOMP)'=";;"!($G(AMQQSQFN)>1) S Y=-1 Q
 I $D(AMQQSQNT),X="NULL" S X="EXISTS" K AMQQSQNT W " = ",X
 I $D(AMQQSQNT),X="EXISTS" S X="NULL" K AMQQSQNT W " = ",X
 I $D(AMQQNMAS),X'="NULL" S Y=-1 Q
 I $G(AMQQCOMP)?1.";",'$D(^UTILITY("AMQQ",$J,"SQ",$S($D(AMQQSQNN):AMQQSQNN,1:"ZZZ"))) S $P(AMQQCOMP,";",4)=X,AMQQSQCV=AMQQCOMP,AMQQSQQT="" Q
 S AMQQSQCV=AMQQCOMP,AMQQSQQT=""
 S AMQQSQNN=+$G(AMQQSQNN)
 S:$D(AMQQFSQN) ^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,X)="" I X="NULL",'$D(AMQQFSQN) S AMQQFSQX=""
 I X="NULL",$G(AMQQSQAA),$D(AMQQSQGF) S ^UTILITY("AMQQ",$J,$S(AMQQUSQL>1:"SQXS",1:"SQXQ"),AMQQSQAA,AMQQSQNN)=""
 ; I X="NULL",'$D(AMQQSQGF) S $P(AMQQCOMP,";",6)=1
 I $D(AMQQYYMI) S AMQQYYMS="" Q
 I '$D(AMQQXX) D ^AMQQSQL
 Q
 ;
NOVM W !!,"Sorry, """,$P(Y,U,2),""" should be entered as a new attribute of VISIT",!,"and not a subquery of """,AMQQATNM,""""
 W !!,*7
 Q
 ;
WHAT S DIR(0)="SO^1:WHOOPS...let me try again;2:"_$S($G(AMQQONE)="":("FIND ALL "_AMQQCNAM_" who have a "_AMQQSQAN_" recorded"),1:("SHOW every "_AMQQSQAN_" for "_AMQQONE))_";3:EXIT" ;IHS/OHPRD/GIS 5/14/94
 S DIR("A")=$C(10)_"     What do you want to do",DIR("B")=1,DIR("?")="" D ^DIR K DIR ;IHS/OHPRD/GIS 5/14/94
 I $D(DUOUT)+$D(DTOUT)+$D(DIRUT) K DTOUT,DIRUT,DTOUT S X="" Q
 S X=$S(Y=1:"AGAIN",Y=2:"ALL",Y=3:"^",1:"")
 Q
 ;

AMQQSQA1
AMQQSQA1 ; IHS/OHPRD/JCM - LINK SUBQUERY ; [ 05/16/94 11:32 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**2,4**;JUN 10, 1993
RUN N AMQQSQST,AMQQNOCO,AMQQCOMP,AMQQSYMB,AMQQFTYP,AMQQCOND
 I AMQQSQCT="R" D ^AMQQAVR Q
 I AMQQSQCT="L",'$D(AMQQSQLF) D NEW Q
 I AMQQSQCT="V" D NEW Q
 I AMQQSQCT="M"!($D(AMQQSQLF)) D ^AMQQSQA2 Q
SETCOND S AMQQNOCO=AMQQSQNC,AMQQSYMB=AMQQSQBS,AMQQFTYP=$P(^AMQQ(4,AMQQSQTP,0),U),AMQQCOND=AMQQSQN
 S (AMQQSQST,AMQQFTYP)=$S("TO"[AMQQSQCT:"N",AMQQSQCT="D":"D",1:$P(^AMQQ(4,AMQQSQTP,0),U))
GETVAL K AMQQCOMP
 I $D(AMQQMMVV) S (AMQQCOMP,AMQQSQCV)=AMQQMMVV K AMQQMMVV Q
 D ^AMQQAV
 I $D(AMQQQUIT) K AMQQQUIT,AMQQCOMP S AMQQSQNV="" Q
 I '$D(AMQQCOMP) K AMQQCOMP
 I '$D(AMQQCOMP) W !!,"You must enter a value.  Try again...",!!,*7 G GETVAL
 S AMQQSQCV=AMQQCOMP
EXIT K %,Z
 Q
 ;
NEW N AMQQLINK,AMQQATNM,AMQQCTXS,AMQQCOND,AMQQCONM,AMQQVCL,AMQQSER,AMQQORTX,AMQQSQFR,AMQQNVAR,AMQQFILT,AMQQSNOT,AMQQTAX,AMQQATN,AMQQSQCT,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX
 D VAR
 I $D(AMQQQUIT) Q
 S AMQQSQQF=""
 K %
 Q
 ;
VAR S %=^AMQQ(5,+Y,0),AMQQATNM=$P(Y,U,2),AMQQLINK=$P(%,U,5),AMQQATN=+Y,AMQQSBCT=$P(%,U,20) I AMQQLINK=9 S AMQQLINK=+Y+($J/100000)
 S Z=$P(^AMQQ(1,AMQQLINK,0),U,5),Z=$P(^AMQQ(4,Z,0),U)
 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)  G:'$D(AMQQTAX) VAR
 S %=^AMQQ(1,AMQQLINK,0),AMQQCTXS=$P(%,U,7),AMQQVCL=$P(%,U,6),AMQQFTYP=$P(^AMQQ(4,$P(%,U,5),0),U)
 I $D(AMQQTAX) D SET^AMQQAT Q
CND N AMQQCOND,AMQQMULT
 I $D(AMQQYYMI) D AUTO Q
CND1 D GETCOND^AMQQAC
 I X="" W "You must enter a condition or '^'",!,*7 S X=AMQQSQNM G CND1 ;IHS/OHPRD/JCM 10/13/93
 I $D(AMQQQUIT) Q
 I Y>0 S AMQQCOND=+Y,AMQQNOCO=$P(^AMQQ(5,+Y,0),U,8),AMQQCONM=$P(Y,U,2),AMQQSYMB=$P(^AMQQ(5,+Y,0),U,6) G VAL
 I Y=-1,X="NULL" S AMQQCOND="",AMQQCOMP="NULL" D SPEC Q
 I Y=-1,$E(X,1,3)="EXI" W $E("EXISTS",$L(X)+1,6) S AMQQCOND="",AMQQCOMP="EXISTS" D SPEC Q
 I Y=-1,$D(AMQQXX) S AMQQFAIL=10 Q
 I Y=-1 W "  ??",*7 G CND1
 I '$D(AMQQCOND) Q
VAL K AMQQCOMP D ^AMQQAV
 I $G(X)="" G CND1
 I $D(AMQQQUIT) Q
 I '$D(AMQQCOMP) G CND
 D SET^AMQQAT I (AMQQSQN=59!((AMQQSQN>315)&(AMQQSQN<319))) S AMQQSQCV=AMQQCOMP ;IHS/OHPRD/GIS 5/16/94
 Q
 ;
SPEC S AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^'=^;;;"_AMQQCOMP_"^^^^^1"
 Q
 ;
AUTO ;
 S AMQQMMLL=@AMQQXXND@(AMQQYYMI,1,1,1),Y=$P(AMQQMMLL,";") D EN1^AMQQAC
 S AMQQCOMP=$P(AMQQMMLL,";",2,3) D SET^AMQQAT
 K AMQQMMLL
 Q
 ;
SET ; ENTRY POINT FROM AMQQSQA0
 N A,B,I,S,% K AMQQSVAL
 S %=$P($G(^AMQQ(5,AMQQSQSN,0)),U,5) I % S:%=9 %=AMQQSQSN+($J/100000) S %=$P($G(^AMQQ(1,%,0)),U,6) I % S %="^DD("_%_",0)" I $D(@%) S S=$P(^(0),U,3)
 I '$D(S) Q
 F I=1:1 S A=$P(S,";",I) Q:A=""  S C=$P(A,":"),B=$P(A,":",2) I $E(B,1,$L(X))=X S AMQQSVAL=C,Y="11^IS" W:'$D(AMQQXX) $E(B,$L(X)+1,99) Q
 Q
 ;

AMQQSQAC
AMQQSQAC  ; OHPRD/DG - CONTEXT MANAGER FOR ATTRIBUTES ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
 ; &&& NEW ROUTINE
SPEC ; I $D(^(5)) D PARENT Q
 I AMQQSQSN=378 S DIC("S")="I $P(^(0),U,4)=29" Q
 I $D(AMQQSQCF) S DIC("S")="I $P(^(0),U,21)=9,'$P(^(0),U,10)" Q  ;IHS/CMI/GIS  PATCHED BY GIS 3/15/92
 I $D(AMQQGVF)!($G(AMQQSQSN)=226) S DIC("S")="I $P(^(0),U,4)=17!($P(^(0),U,21)=16)" Q
 I $G(AMQQSQSN)=35 S DIC("S")="I $P(^(0),U,4)=16" Q
 ; I $G(AMQQSQSN)=617 S DIC("S")="I $P(^(0),U,4)=51" Q  ; IHS/CMI/GIS 3/22/98 ; CMI/MIC/GIS 5/18/98
 I $D(AMQQSQDV) S DIC("S")="I $P(^(0),U,21)="_$S(AMQQSQDV=306:18,1:7) Q
 ; I $D(AMQQSQCF) S DIC("S")="I $P(^(0),U,21)=9,'$P(^(0),U,10)" Q
DICS ; ENTRY POINT FROM AMQQN2
 N X,Y,% S Y=U
 S %=$P($G(^AMQQ(5,+$G(AMQQSQSN),5)),U,3) I %'="" S X=% G DICS1
 F  S %=$O(^AMQQ(7,"B",%)) Q:%=""  I %[" ATTRIBUTES" S Z=$O(^(%,"")),Y=Y_Z_U
 S %=$P($G(^AMQQ(5,+$G(AMQQSQSN),0)),U,4) I Y[(U_(%+1)_U) S X=%+1
DICS1 S AMQQSQZF(1)=$O(^AMQQ(4,"B",AMQQSQST,"")),AMQQSQZF(2)=$S($D(X):X,1:-1)
 S DIC("S")="D EVAL^AMQQSQAC"
 Q
 ;
EVAL ; ENTRY POINT FOR DIC("S") OF ^AMQQ(5) LOOKUP
 I "^59^316^317^318^"[(U_Y_U) X "I 0" Q
 I $G(AMQQSQSN)=617,$P(^(0),U,4)=51 Q  ; IHS/CMI/GIS 11/19/98
 I $P(^AMQQ(5,Y,0),U,20)="M",'$D(AMQQSQSN)!('$D(^(5))) Q
 ;I $P(^AMQQ(5,Y,0),U,20)="L",'$D(AMQQSQSN)!('$D(^(5))) X "I 0" Q  ; 
 I $P(^AMQQ(5,Y,0),U,20)="V" Q
 I $P(^AMQQ(5,Y,0),U,20)="M",$G(AMQQSQSN)'=$P(^AMQQ(5,Y,5),U) Q
 I $P(^AMQQ(5,Y,0),U,20)="L",$P($G(^MCAR(690.99,+$G(AMQQSQSN),2)),U,4)=7,$P($G(^AUTTDXPR(Y,0)),U,6),$P($G(^AMQQ(5,Y,5)),U,2),$P(^AMQQ(5,Y,5),U,2)=$P($G(^AMQQ(5,AMQQSQSN,5)),U,2),$P(^AMQQ(1,$P(^AMQQ(5,Y,0),U,5),0),U,2)=2 S AMQQSQLF="" Q
 I $P(^AMQQ(5,Y,0),U,20)="L",+$G(^AMQQ(5,Y,5))=AMQQSQSN,$P(^AMQQ(1,$P(^AMQQ(5,Y,0),U,5),0),U,2)'=2 Q
 I $P(^AMQQ(5,Y,0),U,21)=16 Q
 I $P(^AMQQ(5,Y,0),U,21)=AMQQSQZF(1) Q
 I $P(^AMQQ(5,Y,0),U,21)=7 Q
 I $P(^AMQQ(5,Y,0),U,4)=AMQQSQZF(2) Q
 Q
 ;

AMQQSQIM
AMQQSQIM ; OHPRD/DG - IMMUNIZATION INFO ; [ 07/24/1999  3:21 PM ]
 ;;2;PCC QUERY UTILITY;*10,15*;FEB 20, 1998
RUN D SER I $D(AMQQQUIT) G EXIT
 S X=AMQQSQSJ,AMQQCOMP=";;;"_$G(AMQQISR)
 I $D(AMQQRECV) S $P(AMQQRECV,U,11)=$G(AMQQISR)
EXIT K AMQQISR,AMQQIMMS,Y,AMQQIV1,AMQQIV2,AMQQIMDT,%
 Q
 ;
SER I AMQQSQSJ'["MR",AMQQSQSJ'["DTP",AMQQSQSJ'["VAR",AMQQSQSJ'["HIB V",AMQQSQSJ'["HEPATITIS",AMQQSQSJ'["OPV",AMQQSQSJ'["IPV",AMQQSQSJ'["DPT",AMQQSQSJ'["DT",AMQQSQSJ'["Td",AMQQSQSJ'["TD",AMQQSQSJ'["TETANUS TOXOID" S AMQQISR="A" Q
 ;IHS/OHPRD/TMJ
 ;IHS/CMI/THL - PATCH 15
 I '$D(AMQQIMMS) S AMQQIMMS=AMQQSQSJ
 S %=$E(AMQQIMMS,$L(AMQQIMMS)) K AMQQISR
 I "12345BA"[% S AMQQISR=% K AMQQIMMS
 I '$D(AMQQISR) D SERIES
 Q
 ;
SERIES W !!,"Select series (1-5, BOOSTER, COMPLETE, ALL, UNSPECIFIED): ALL// "
 R X:DTIME E  S X=U
 I X=U S AMQQQUIT="" Q
 I X="" S X="ALL"
 I X?1."?" D SHELP G SERIES
 S X=$E(X) I "12345ABCU"'[X W " ??",*7 G SERIES
 S AMQQISR=X
 Q
 ;
SHELP W !!,"Select from one of the following =>",!!
 W ?3,"1-5  Primary series number",!
 W ?3,"A    Display ALL immunizations in the series",!
 W ?3,"B    BOOSTER",!
 W ?3,"C    Series COMPLETED",!
 W ?3,"U    Series number UNSPECIFIED",!!!
 Q
 ;

AMQQSQL
AMQQSQL ; OHPRD/DG - SUBQUERY DESCRIPTIVE LIST ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
 ; &&& MANY CHANGES MADE TO THIS ROUTINE FOR BETTER CONTEXT MGMT
 I $D(AMQQXX) Q
 N AMQQSQLS
LIST S AMQQSQLS="W ?"_$S($D(AMQQGVF):6,1:(3*AMQQUSQL+6))_","""
EN1 ; ENTRY POINT FROM AMQQSQP
 I '$D(AMQQSQCT),$D(AMQQSBCT) S AMQQSQCT=AMQQSBCT ; &&&
 I $D(^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,"NULL"))!($G(X)="NULL") S AMQQSQLS=AMQQSQLS_"'NULL' (None meet criteria)" G LS
 I AMQQSQCT="B","EV"[AMQQSQST,AMQQSQST'="" D BP G LS
 S %=AMQQSQCT D @$S($D(AMQQSQLF):"MULT",%="D":"DT^AMQQSQL1",%="B":"VAL",%="C":"COMP",%="O":"ORD",%="T":"LEAST",%="R":"REL",%="L":"LINK",%="V":"VIS",%="M":"MULT",%="S":"SET",1:"NOSQL")
 I $D(AMQQNOSQ)!($G(AMQQSQLS)[";*;") K AMQQNOSQ Q  ; &&&
LS I '$D(AMQQNOSQ) S ^UTILITY("AMQQ",$J,"SQL",AMQQSQNN,AMQQSQFN)=AMQQSQLS_""""
EXIT K %,A,B,C,E,F,G,H,S,T,Z,AMQQNOSQ
 Q
 ;
NOSQL S AMQQNOSQ=""
 Q
 ;
VAL N X,Y,Z,A S X=AMQQSQCV
 I AMQQSQCV["~",AMQQSQTP="E" D BP Q
 I AMQQSQCV[";" S:$D(AMQQSQNT) AMQQSQLS=AMQQSQLS_"NOT " S AMQQSQLS=AMQQSQLS_"BETWEEN "_$P(AMQQSQCV,";")_" and "_$P(AMQQSQCV,";",2) Q
 S A=$S($E(AMQQSQBS)="'":$E(AMQQSQBS,2,99),1:AMQQSQBS)
 S Y=$F("[]=?$#><",A)-1,Z=$P("CONTAINS^FOLLOWS^EQUALS^PATTERN MATCH^STARTS WITH^ENDS WITH^GREATER THAN^LESS THAN",U,Y)
 I $D(AMQQSQNT) S Z=$S(Y<7:"DOES ",1:"")_"NOT "_$P("CONTAIN^FOLLOW^EQUAL^PATTERN MATCH^START WITH^END WITH^GREATER THAN^LESS THAN",U,Y)
 S AMQQSQLS=AMQQSQLS_Z_" " S:AMQQSQST="T" AMQQSQLS=AMQQSQLS_"1:" S AMQQSQLS=AMQQSQLS_AMQQSQCV
 Q
 ;
 ;
BP N A,B,C,E,X,F,G,H,T,Z
 S Y=AMQQSQCV
 I Y=">:0~>:0~!" S AMQQSQLS=AMQQSQLS_"all values""" Q
 I AMQQSQSN=253 S F="S",G="D",T="" G BP1
 S F="R",G="L",T="20/"
BP1 S Z=$P(Y,"~"),A=$P(Z,":"),B=$P(Z,":",2),C=$P(Z,":",3),E=$P(Z,":",4)
 S AMQQSQLS=AMQQSQLS_F S:C="" AMQQSQLS=AMQQSQLS_A_T_B S:C'="" AMQQSQLS=AMQQSQLS_" "_T_B_"-"_E
 S H=$S($P(Y,"~",3)="&":" and ",1:" or "),AMQQSQLS=AMQQSQLS_H_G
 S Z=$P(Y,"~",2),A=$P(Z,":"),B=$P(Z,":",2),C=$P(Z,":",3),E=$P(Z,":",4)
 S:C="" AMQQSQLS=AMQQSQLS_A_T_B S:C'="" AMQQSQLS=AMQQSQLS_" "_T_B_"-"_E
 Q
 ;
LEAST I AMQQSQNM["_" S AMQQSQLS=AMQQSQLS_$P(AMQQSQNM,"_")_AMQQSQCV_$P(AMQQSQNM,"_",2) Q
ORD S AMQQSQLS=AMQQSQLS_AMQQSQNM_" "_AMQQSQCV
 Q
 ;
COMP S AMQQSQLS=AMQQSQLS_AMQQSQNM
 Q
 ;
REL S AMQQSQLS=AMQQSQLS_"DURING THE SPECIFIED AGE WINDOW"
 Q
 ;
LINK N X S X=AMQQQ,Y=$P(X,U,3)
 I X[";;;NULL" S AMQQSQLS=AMQQSQLS_$P(X,U,2)_" IS 'NULL'" Q
 I X[";;;EXIST" S AMQQSQLS=AMQQSQLS_$P(X,U,2)_" IS NOT 'NULL'" Q
 D VIS1
 Q
 ;
VIS N X,Y S X=AMQQQ,Y=$P(X,U,3)
 I AMQQQ["NULL" S AMQQSQLS=AMQQSQLS_$P(X,U,2)_" IS 'NULL'" Q
VIS1 I "GL"[Y D ZSET^AMQQATL1 S AMQQSQLS=AMQQSQLS_$P(X,U,2)_$G(Z) Q  ; IHS/CMI/GIS 11/19/98
 I Y="D" D DATE^AMQQSQL1 Q
 I Y="S" D SET^AMQQSQL1 Q
 I Y="F" D FREE^AMQQSQL1 Q
 I $P(X,U,8)="><" S AMQQSQLS=AMQQSQLS_$P(X,U,2)_" BETWEEN "_+$P(X,U,9)_" AND "_$P($P(X,U,9),";",2) Q
 S AMQQSQLS=AMQQSQLS_$P(X,U,2)_" "_$P(X,U,8)_" "_$P(X,U,9)
 ; INSERT OTHER TYPES HERE
 Q
 ;
MULT S AMQQZSQL=AMQQSQNN_U_AMQQSQFN_U_(AMQQUSQN+1) K AMQQSQLF
 S AMQQSQLS=AMQQSQLS_$P(AMQQSQSQ,U,6)_" ENTERED "
 I $P(AMQQSQSQ,U,7),$G(AMQQSQN),$G(AMQQSQSN),$D(^AMQQ(5,AMQQSQN,5)),$D(^AMQQ(5,AMQQSQSN,5)),$P(^(5),U,2),$P(^(5),U,2)=$P(^AMQQ(5,AMQQSQN,5),U,2) S AMQQSQLS=AMQQSQLS_"DURING THIS "_$P(AMQQSQSQ,U,5) Q
 I $P(AMQQSQSQ,U,7) S AMQQSQLS=AMQQSQLS_"ON THE SAME VISIT AS EA. "_$P(AMQQSQSQ,U,5) Q
 N X,Y S X=$P(AMQQSQSQ,U,3),Y=$P(AMQQSQSQ,U,4)
 I X["0 DAY " S X="THE SAME DAY"
 I Y["0 DAY " S Y="THE SAME DAY AS"
 S AMQQSQLS=AMQQSQLS_"FROM "_X_" TO "_Y_" EA. "_$P(AMQQSQSQ,U,5)
 Q
 ;
SET N %,S,A,B
 I AMQQLINK>1000!((AMQQLINK>689.9999)&(AMQQLINK<706)) S S=$G(^AMQQ(1,AMQQLINK,4,1,1)),S=$P(S,"S Y=""",2),S=$P(S,""",X=$F") G SET1
 S %=$P($G(^AMQQ(5,AMQQSQSN,0)),U,5) I % S:%=9 %=AMQQSQSN+($J/100000) S %=$P($G(^AMQQ(1,%,0)),U,6) I % S %="^DD("_%_",0)" I $D(@%) S S=";"_$P(^(0),U,3)
SET1 S A=";"_AMQQSQCV_":",A=$F(S,A) I A S B=$P($E(S,A,999),";")
 S AMQQSQLS=AMQQSQLS_"Result is "_$S($G(AMQQSQBS)="'=":"not ",1:"")_$G(B)
 Q
 ;

AMQQSQL1
AMQQSQL1 ; OHPRD/DG - GETS OVERFLOW FROM AMQQSQL ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**1,14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
DT ; ENTRY POINT FROM AMQQSQL
 S X=AMQQCOMP G D1
DATE ; ENTRY POINT FROM AMQQSQL
 N AMQQSQCV,AMQQSQBS S AMQQSQCV=$P(AMQQQ,U,9),AMQQSQBS=$P(AMQQQ,U,8)
 N X,Y S X=AMQQSQCV
D1 I X="" Q
 S AMQQSQLS=AMQQSQLS_$P(AMQQQ,U,2)_" " ; IHS/CMI/GIS 3/9/98
 I $D(AMQQSQNT) S AMQQSQLS=AMQQSQLS_"NOT "
 I AMQQSQBS="<" S Y=+AMQQSQCV X ^DD("DD") S AMQQSQLS=AMQQSQLS_"BEFORE "_Y Q
 I AMQQSQBS=">" S Y=+AMQQSQCV X ^DD("DD") S AMQQSQLS=AMQQSQLS_"AFTER "_Y Q
 I AMQQSQBS="=" S Y=+AMQQSQCV X ^DD("DD") S AMQQSQLS=AMQQSQLS_"ON "_Y Q
 I AMQQSQBS="%" S AMQQSQLS=AMQQSQLS_"RELATIVE TO VISIT DATE" Q
 S Y=$P(AMQQSQCV,";",2) X ^DD("DD") S Z=Y,Y=$P(AMQQSQCV,";") X ^DD("DD") S AMQQSQLS=AMQQSQLS_"BETWEEN "_Y_" and "_Z
 Q
 ;
FREE ; ENTRY POINT FROM AMQQSQL
 N AMQQSQCV,AMQQSQBS,X,AMQQSQSP
 S AMQQSQCV=$P(AMQQQ,U,9),AMQQSQBS=$P(AMQQQ,U,8)
 S %=$P(AMQQSQCV,";",4)
 I %="NULL"!(%="EXISTS")!(%="ALL") S AMQQSQSP=%
 I $D(AMQQSQNT),$G(AMQQSQSP)="NULL" K AMQQSQNT S AMQQSQSP="EXISTS"
 I $D(AMQQSQNT),$G(AMQQSQSP)="EXISTS" K AMQQSQNT S AMQQSQSP="NULL"
 S AMQQSQLS=AMQQSQLS_$P(AMQQQ,U,2)_" " ; IHS/CMI/GIS 3/9/98
 I $G(AMQQSQSP)'="" S AMQQSQLS=AMQQSQLS_$S(AMQQSQSP="NULL":"IS NULL",1:AMQQSQSP) Q
 I $D(AMQQSQNT) S AMQQSQLS=AMQQSQLS_"NOT "
 I AMQQSQBS'="-" S X=$F("[]=$#?",AMQQSQBS)-1,X=$P("CONTAINS^FOLLOWS^IS^STARTS WITH^ENDS WITH^MATCHES",U,X)_" "_AMQQSQCV,AMQQSQLS=AMQQSQLS_X Q
 Q
 ;
SET ; ENTRY POINT FROM AMQQSQL
 N X,%
 S %=$G(^AMQQ(1,+AMQQQ,4,1,1)),X=$P(AMQQQ,U,9)
 I %'="",X X % S AMQQSQLS=AMQQSQLS_$P(AMQQQ,U,2)_" "_$P(AMQQQ,U,8)_" "_X ;IHS/OHPRD/JCM 9/13/93
 Q
 ;

AMQQSQP
AMQQSQP ; OHPRD/DG - SPECIAL SUBQUERY FOR PROVIDERS ; [ 10/17/95  5:01 PM ]
 ;;2;PCC QUERY UTILITY;**1,8**;SEP 18, 1995
INTRO W @IOF,?17,"*****  PROVIDER-RELATED CRITERIA  *****"
 W !!!,"You can either specify one or more providers by NAME, or.....",!
 W "You can specify one or more PROVIDER ATTRIBUTES (affiliation, specialty, etc)",!,"to be used as selection criteria.",!!!
 S DIR(0)="SO^1:NAME(S) of providers;2:ATTRIBUTE(S) of providers",DIR("A")=$C(10)_"     Your choice",DIR("B")="NAME(S)" D ^DIR K DIR
 I $D(DUOUT)+$D(DTOUT) K DUOUT,DIRUT,DTOUT S AMQQQUIT="" G EXIT
 I Y="" Q
 S AMQQSQPY=Y
RUN D @$P("NAME^ATT",U,Y) I $D(AMQQQUIT) G EXIT
 I $D(AMQQSQPQ) K AMQQSQPQ G EXIT
 D PRIME I $D(AMQQSQPQ)!($D(AMQQQUIT)) K AMQQSQPQ G EXIT
 D @$P("SETN^SETA",U,AMQQSQPY)
 I '$D(AMQQXX),AMQQSQFN>1 W !! F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"SQL",AMQQUSQN,%)) Q:'%  W ! X ^(%)
EXIT K X,Y,AMQQSQPH,AMQQSQPL,AMQQSQPY,%,Z,AMQQSQP ; PATCHED BY GIS 11/18/91
 W !!
 Q
 ;
NAME N AMQQTAX S X=35 D EN1^AMQQTX ;IHS/OHRPD/JCM 9/13/93
 I '$D(AMQQTAX) S AMQQSQPQ="",AMQQQUIT="" Q
 S AMQQSQP=AMQQTAX,(AMQQSQP1,AMQQSQP2)=AMQQUQQN+1+('$D(AMQQVPF))
 Q
 ;
PRIME W !!,"When I check the providers from each encounter, you can limit my analysis",!,"to the PRIMARY provider only, SECONDARY providers, or ALL providers.",!!
 S DIR(0)="SO^1:PRIMARY provider only;2:SECONDARY providers only;3:ALL providers",DIR("A")=$C(10)_"     Your choice",DIR("B")="ALL" D ^DIR K DIR
 I $D(DUOUT)+$D(DTOUT) K DUOUT,DIRUT,DTOUT S (Y,AMQQQUIT)=""
 I Y="" Q
 S AMQQSQPS=Y,AMQQSQPL=$S(AMQQSQPS=1:"PRIMARY",AMQQSQPS=2:"SECONDARY",1:"") I AMQQSQPL'="" S AMQQSQPL=AMQQSQPL_" "
 Q
 ;
SETA I $D(AMQQVPF) D SETVP G SETA1
 D CHK S ^UTILITY("AMQQ",$J,"SQL",AMQQUSQN,AMQQSQFN)="W ?"_$S($D(AMQQGVF):6,1:((3*AMQQUSQL)+6))_","""_AMQQSQPL_"PROVIDER ATTRIBUTES"""
 S ^UTILITY("AMQQ",$J,"QQ",AMQQSQPH)="212^PROVIDER^Y^0^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_"^^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2
 S ^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,AMQQSQFN)="0^LINK^22^SUB^AMQQF1^V^"_AMQQSQPH
 D SQIX
SETA1 S AMQQSQFN=AMQQSQFN+1
 Q
 ;
SETN I $D(AMQQVPF) D SETVP G SETN1
 D CHK,SETZ S Z=AMQQSQPL_"PROVIDERS "_Z,^UTILITY("AMQQ",$J,"SQL",AMQQUSQN,AMQQSQFN)="W ?"_$S($D(AMQQGVF):6,1:((3*AMQQUSQL)+6))_","""_Z_""""
 S AMQQUQQN=AMQQUQQN+1,^UTILITY("AMQQ",$J,"QQ",AMQQUQQN)="212^PROVIDER^Y^0^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_"^^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2
 S ^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,AMQQSQFN)="0^LINK^22^SUB^AMQQF1^V^"_AMQQUQQN
 D SQIX
 S AMQQSQFN=AMQQSQFN+1
SETN1 S AMQQUQQN=AMQQUQQN+1,^UTILITY("AMQQ",$J,"QQ",AMQQUQQN)="203^PROVIDER^L^0^^^^^;;;"_AMQQSQP_"^^^^^1^"_AMQQSQP_";"_AMQQSQP_";^0^"_AMQQSQP
 Q
 ;
SETZ N AMQQQ S AMQQQ="203^^^^^^^^;;;"_AMQQSQP,Z="" I AMQQSQPY=1 D ZSET^AMQQATL1
 Q
 ;
SETVP S AMQQLINK=212,AMQQATNM="PROVIDER",AMQQCTXS=0,AMQQCOMP=AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_";"_$G(AMQQSQP),AMQQNVAR=1,AMQQFTYP="Y",AMQQSQFN=0 ; PATCHED BY GIS 11/18/91
 I AMQQSQPY=2 S AMQQLINK=212.1
 K AMQQTAX
 Q
 ;
CHK I AMQQSQFN=1 D SET1^AMQQSQS S AMQQSQQQ="Next"_$S($D(AMQQGVF):" generic visit condition",1:(" condition of """_AMQQSQSJ_""""))_": " ;IHS/OHPRD/TMJ 9/15/95
 Q
 ;
SQIX I '$D(AMQQGVF) S %=@$S(AMQQUSQL>1:"AMQQSQAA",1:"AMQQUATN"),X=$S(AMQQUSQL>1:"SQXS",1:"SQXQ") I '$D(^UTILITY("AMQQ",$J,X,%)) S ^(%,1)=""
 Q
 ;
ATT N AMQQSQQF,AMQQCCLS,AMQQQ,AMQQLINK,AMQQFTYP,AMQQCTXS,AMQQCOND,AMQQNOCO,AMQQCONM,AMQQSYMB,AMQQCOMP,AMQQVCL,AMQQSER,AMQQORTX,AMQQFRED,AMQQNVAR,AMQQFILT,AMQQSNOT,AMQQTAX,AMQQUATN,AMQQATNM,AMQQCNAM
 S AMQQSQPH=AMQQUQQN+('$D(AMQQVPF)),AMQQCCLS="H",AMQQCNAM="PROVIDER",AMQQUATN=1
ATT1 S AMQQQ="" W !! D ATT2
 I $G(AMQQQ)="" S AMQQSQP1=AMQQSQPH+1,AMQQSQP2=AMQQUQQN S:AMQQUQQN<AMQQSQPH AMQQSQPQ="" Q
 I AMQQUQQN<AMQQSQPH S AMQQUQQN=AMQQUQQN+1
 S (AMQQSQQF,AMQQUQQN)=AMQQUQQN+1,AMQQUATN=AMQQUATN+1 D ^AMQQATS
 I '$D(AMQQVPF) D ALIST
 G ATT1
 Q
 ;
ATT2 N AMQQVPF D ^AMQQAT
 Q
 ;
ALIST S %=AMQQSQFN N AMQQSQLS,AMQQSQCT,AMQQSQFN,AMQQSQNN
 S AMQQSQFN=+(%_"."_AMQQSQQF)
 S AMQQSQLS="W ?"_$S($D(AMQQGVF):9,$D(AMQQUSQL):(3*AMQQUSQL+6),1:9)_","""
 S AMQQSQNN=AMQQUSQN+1
 S AMQQSQCT="V"
 D EN1^AMQQSQL
 Q
 ;

AMQQSQS
AMQQSQS ; IHS/OHPRD/JCM - SETS INSTRUCTIONS FOR SUBQUERY ATTRIBUTES ; [ 05/16/94 11:31 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**4**;JUN 10, 1993
RUN I AMQQSQFN=1 D SET1
 D FLAGS
 I $G(AMQQSQNC) S AMQQNOCO=AMQQSQNC
 I $D(AMQQSQNT) S AMQQNOT=""
 I '$D(AMQQSQSC),$D(AMQQSQRC) S AMQQSQRC=AMQQSQNN
 I '$D(AMQQSQSC),$D(AMQQSQAA) D SET2
 I '$D(AMQQSQSC),"LVM"'[$E(AMQQSQCT) D SET3
 D ^AMQQSQL
EXIT K AMQQSQSC,%
 Q
 ;
SET1 ; ENTRY POINT FROM AMQQSQP
 S AMQQUSQN=AMQQUSQN+1,AMQQSQNN=AMQQUSQN,AMQQFSQN=""
 S %=AMQQSQAN I $G(AMQQSQST)="I",$P($G(AMQQCOMP),";",4)'="" S %=%_" ("_$P(AMQQCOMP,";",4)_")"
 I '$D(AMQQXX) S ^UTILITY("AMQQ",$J,"SQL",AMQQSQNN,.1)="W "_$S($D(AMQQGVF):"!!?3",1:("?"_(3*AMQQUSQL+6)))_",@AMQQRV,"""_$S($D(AMQQGVF):"Generic VISIT conditions",1:("Subject of subquery: "_%))_""",@AMQQNV"
 I '$D(AMQQLSQF) S AMQQLSQF=AMQQSQNN
 K ^UTILITY("AMQQ",$J,"SQ",AMQQSQNN)
 Q
 ;
SET2 I AMQQUSQL>1 S ^UTILITY("AMQQ",$J,"SQXS",AMQQSQAA,AMQQSQNN)="",AMQQSQDF="" Q
 S ^UTILITY("AMQQ",$J,"SQXQ",AMQQSQAA,AMQQSQNN)=""
 K AMQQSQAA
 Q
 ;
SET3 I AMQQSQCT'="B" G SETSQ
 S %=^AMQQ(4,AMQQSQTP,0),%=$P(%,U)
 I "EV"[% S AMQQSQF1="BP",AMQQSQF2="AMQQF1" G SETSQ
SETSQ S ^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,AMQQSQFN)=AMQQSQN_U_AMQQSQNM_U_AMQQSQTP_U_AMQQSQF1_U_AMQQSQF2_U_AMQQSQCT_U_AMQQSQCV_U_$D(AMQQSQNT)
 Q
 ;
FLAGS I AMQQSQCT="C" S (AMQQSQGF,AMQQSQCF)="" S:AMQQUSQL=1 AMQQFRED=1 Q
 I AMQQSQCT="T" S (AMQQSQTF,AMQQSQGF)="" Q
 I '$D(AMQQSQGF),AMQQSQCT="B",'$D(AMQQSQBF) D SETCOMPV Q
 I (AMQQSQN=59!((AMQQSQN>315)&(AMQQSQN<319))),'$D(AMQQSQGF),'$D(AMQQSQDF) K AMQQSQQF D SETCOMPD Q  ;IHS/OHPRD/GIS 5/16/94
 I '$D(AMQQSQGF),AMQQSQCT="D",'$D(AMQQSQDF) D SETCOMPD Q
 I '$D(AMQQSQGF),AMQQSQCT="S",'$D(AMQQSQBF) D SETCOMPS Q
 I '$D(AMQQSQGF),AMQQSQNM="LAST" S (AMQQSQGF,AMQQSQSC)="",$P(AMQQCOMP,";",3)=AMQQSQCV Q
 I AMQQSQCT="N" S AMQQSQNF="" Q
 I "MOL"[AMQQSQCT S AMQQSQGF="" Q
 Q
 ;
SETCOMPV S AMQQSQBF=""
 I $D(AMQQSQNT) S AMQQSQBS="'"_AMQQSQBS
 I $P(AMQQCOMP,";",4)="" S AMQQSQSC=""
 I $G(AMQQSQST)="E"!($G(AMQQSQST)="V") S $P(AMQQCOMP,";",4)=AMQQSQCV Q
 I AMQQSQCV'[";" S $P(AMQQCOMP,";",4)=AMQQSQBS_":"_AMQQSQCV S:$D(AMQQRECV) $P(AMQQRECV,U,11)=$P(AMQQCOMP,";",4) Q
 S $P(AMQQCOMP,";",4)="'<:"_$P(AMQQSQCV,";")_":'>:"_$P(AMQQSQCV,";",2)
 Q
 ;
SETCOMPS S AMQQSQBF="" I $D(AMQQSQNT) S AMQQSQBS="'"_AMQQSQBS
 I $P(AMQQCOMP,";",4)="" S AMQQSQSC=""
 S $P(AMQQCOMP,";",4)=AMQQSQBS_":"_AMQQSQCV
 S $P(AMQQRECV,U,11)=$P(AMQQCOMP,";",4)
 Q
 ;
SETCOMPD S AMQQSQDF=""
 I $P(AMQQCOMP,";")="" S AMQQSQSC=""
 I AMQQSQCV[";" F %=1,2 S $P(AMQQCOMP,";",%)=$P(AMQQSQCV,";",%) I %=2 G SETCEXIT
 I AMQQSQBS="<" S $P(AMQQCOMP,";",1)=0,$P(AMQQCOMP,";",2)=AMQQSQCV Q
 I AMQQSQBS="=" S $P(AMQQCOMP,";",1)=AMQQSQCV,$P(AMQQCOMP,";",2)=AMQQSQCV Q  ;IHS/OHPRD/JCM 12/7/93
 S $P(AMQQCOMP,";",1)=AMQQSQCV,$P(AMQQCOMP,";",2)=9999999
SETCEXIT Q
 ;

AMQQTX
AMQQTX ; OHPRD/DG - MAKES AD HOC TAXONOMY ; [ 03/20/96  11:49 AM ]
 ;;2;PCC QUERY UTILITY;**1,4,9**;MAR 20, 1996
VAR S AMQQURGN=AMQQURGN+1,AMQQTTOT=0,AMQQTAX=AMQQURGN,AMQQTAXT=$P(^AMQQ(5,AMQQATN,0),U,14),AMQQCTXS=0,AMQQTGBL=$P(AMQQTLOK,"("),AMQQHILO="^UTILITY(""AMQQ"",$J,""HILO"")"
 I $P(^AMQQ(1,AMQQLINK,0),U,7) S AMQQMULT="",AMQQCTXS=1
 K AMQQTXTR I $D(^AMQQ(1,AMQQLINK,4,1,1)) S AMQQTXTR=^(1)
 I '$D(AMQQMULT),$G(AMQQONE)'="" S AMQQTAX=AMQQURGN,AMQQCOMP=";;;"_AMQQTAX_";ALL",^UTILITY("AMQQ TAX",$J,AMQQURGN,"*")="" G EXIT
GET K AMQQSCMP
 I AMQQTAXT=4 S %=^AMQQ(1,AMQQLINK,0),%=$P(%,U,6),%=^DD(+%,$P(%,",",2),0),%=";"_$P(%,U,3),AMQQSSET=%
 D @("EN"_AMQQTAXT_"^AMQQTXG") I $D(AMQQQUIT) G EXIT
 I $D(AMQQSCMP) D SCMP G EXIT
 I '$D(^UTILITY("AMQQ TAX",$J,AMQQURGN)) K AMQQTAX S AMQQURGN=AMQQURGN-1 W !! G EXIT
SAVE I AMQQTTOT<2 S %="" F I=0:1 S %=$O(^UTILITY("AMQQ TAX",$J,AMQQURGN,%)) Q:%=""  I I=2 S AMQQTTOT=I Q
 I AMQQTTOT>1 D ^AMQQTX0 I $D(AMQQQUIT) G EXIT
 S AMQQTAX=AMQQURGN
 I $D(AMQQTLFL) K AMQQTLFL G EXIT
 S $P(AMQQCOMP,";",4)=AMQQURGN
EXIT I $G(AMQQTAX)="" K AMQQTAX,AMQQTXGR,AMQQCOMP,AMQQB
 S X=$G(AMQQATNM)
 K AMQQTNAR,AMQQTTX,AMQQTTOT,AMQQTDIC,AMQQTGNO
 K AMQQPOV1,AMQQPOV2,AMQQTLOK,AMQQTGNA,AMQQTGNO,AMQQTAXT,AMQQTXTR,DIPGM,^UTILITY("AMQQ RANGE",$J),^UTILITY("AMQQ DELETE",$J),@AMQQHILO,AMQQTGBL,AMQQSCMP,AMQQSSET,AMQQHILO,%,%Y,A,B,I,Z
 I $D(AMQQDF) S AMQQQUIT=""
 Q
 ;
SCMP ; ENTRY POINT FROM AMQQ0
 I AMQQSCMP'="NULL",AMQQSCMP'="INVERSE" K ^UTILITY("AMQQ TAX",$J,AMQQURGN) S ^(AMQQURGN,"*")=""
 S AMQQCOMP=";;;"_AMQQURGN_";"_AMQQSCMP,AMQQTAX=AMQQURGN
 F %="NULL","INVERSE" I AMQQSCMP=% S ^UTILITY("AMQQ TAX",$J,AMQQURGN,$S(%="NULL":"-",1:"--"))="" Q
 Q
 ;
WHATG ; ENTRY POINT FROM AMQQTX SUBROUTINES
 N DIC,DZ,D,A,B S DIC="^ATXAX(",DIC(0)="",D="B"
 S DIC("S")="I $P(^(0),U,12)=AMQQLINK"
 S DZ="??"
 D DQ^DICQ
 Q
 ;
LIST ; ENTRY POINT FROM AMQQTX SUBROUTINES
 I $O(^UTILITY("AMQQ TAX",$J,AMQQURGN,""))="" W !!,?($D(AMQQZNM)*5),"  You have not made a selection yet...Try again",!! Q
 ; S %=$O(^UTILITY("AMQQ TAX",$J,AMQQURGN,"")),%=$O(^(%)) I %="" Q
 S %="The following have been selected =>" W !!,%,!
 S (%,X)="" F I=1:1 S %=$O(^UTILITY("AMQQ TAX",$J,AMQQURGN,%)) Q:%=""  W ! D:'(I#(IOSL-4)) LIST1 Q:X=U  S X=% D
 . I $G(AMQQATN)=99 W ?5,X Q
 . I $G(AMQQTTX)="" X:$D(AMQQTXTR) AMQQTXTR W ?5,X Q
 . I $G(AMQQTTX)]"" X AMQQTTX W ?5,X
 S AMQQTTOT=AMQQTTOT+I
 W !!
 Q
 ;
LIST1 W "<>" R X:DTIME W *13,?5,*13
 Q
 ;
SET ; ENTRY POINT FROM AMQQTX SUBROUTINES
 S Y=1
 I $D(AMQQTXEX) W "  (DELETED)" K AMQQTXEX,^UTILITY("AMQQ TAX",$J,AMQQURGN,X) Q
 S ^UTILITY("AMQQ TAX",$J,AMQQURGN,X)=""
 I AMQQTLOK="^PSDRUG(" D DCLASS
 Q
 ;
DCLASS ; Handles drug classes
 NEW AMQQCLAS,I
 I $D(^PSDRUG(X,"ND")) S AMQQCLAS=$P(^("ND"),U,6) I AMQQCLAS
 E  Q
 I '$D(^UTILITY("AMQQ DRUG CLASS",$J,AMQQURGN,AMQQCLAS))
 E  Q
 W ! S DIR("A")="Do you want meds that are members of the same class as this medication",DIR(0)="Y" D ^DIR K DIR W !
 I Y=1
 E  Q
 S ^UTILITY("AMQQ DRUG CLASS",$J,AMQQURGN,AMQQCLAS)=""
 S I=0 F  S I=$O(^PSDRUG("VAC",AMQQCLAS,I)) Q:'I  I '$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,I)) S ^(I)=""
 Q
 ;
NULL ; ENTRY POINT FROM AMQQTX SUBROUTINES
 N AMQQNNAM S AMQQNNAM=$S($E(AMQQCNAM,$L(AMQQCNAM))="S":$E(AMQQCNAM,1,$L(AMQQCNAM)-1),1:AMQQCNAM)
 I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN)) G N0
 W !,"Do you want me to find all ",AMQQNNAM,"S with no ",AMQQTNAR," entered"
 S %=1 D YN^DICN I $D(DTOUT) S %Y=U
 I $E(%Y)=U S AMQQQUIT="" K DTOUT,DUOUT Q
 I "Yy"[$E(%Y) S AMQQSCMP="NULL" Q
 W !,"Well then..."
N0 I AMQQCTXS W !,"I take it you want me to search for only those ",AMQQNNAM,"S who DO NOT have",!,"any ",AMQQTNAR,"S in this taxonomy" G N1
 W !,"I take it you want me to find only those ",AMQQNNAM,"S whose",!,AMQQTNAR," is NOT in this taxonomy"
N1 S %=1 D YN^DICN I $D(DTOUT) S %Y=U
 I $E(%Y)=U S AMQQQUIT="" Q
 I %Y="" S %Y="Y"
 I "yY"[$E(%Y) S AMQQSCMP="INVERSE"
 W !
 Q
 ;
EN1 ; PROGRAMMER ENTRY POINT FOR TAXONOMY SYSTEM ;IHS/OHPRD/JCM 9/13/93
 N %,A,AMQQ,AMQQA,AMQQATN,AMQQB,AMQQCASE,AMQQCLAS,AMQQCNT,AMQQCOMP,AMQQCTXS,AMQQDF,AMQQDFN,AMQQDONE,AMQQECHO,AMQQHEL1,AMQQHELP,AMQQHILO,AMQQI,AMQQLINK,AMQQLKUP,AMQQLMOR,AMQQMULT,AMQQNDB,AMQQNDBC,AMQQNECO,AMQQNEXT,AMQQNNAM,AMQQNTAX
 N AMQQONE,AMQQPOV1,AMQQPOV2,AMQQQUIT,AMQQR,AMQQSAVE,AMQQSCMP,AMQQSHNO,AMQQSQSJ,AMQQSSET,AMQQSTP,AMQQSUB,AMQQTAXI,AMQQTAXT,AMQQTDIC,AMQQTGBL,AMQQTGFG,AMQQTGNA,AMQQTGNO,AMQQTJMP,AMQQTLFL,AMQQTLOK,AMQQTNAR,AMQQTTOT,AMQQTTX,AMQQTXEX
 I '$D(APCLCRIT) NEW AMQQSQNM ;IHS/OHPRD/TMJ Patch #9 3/20/96
 N AMQQTXGR,AMQQTXTR,AMQQTYP,AMQQVAL,AMQQX,AMQQXX,AMQQXXN,AMQQXXTT,AMQQZNM,B,C,D,DA,DIADD,DIC,DIE,DIK,DINUM,DIPGM,DIR,DLAYGO,DR,DTOUT,DUOUT,DZ,I,N,T,Y,Z,ATXFLG,AMQQATNM ;IHS/OHPRD/JCM 1/20/94
 S AMQQATN=X,%=^AMQQ(5,X,0),AMQQTTX=$G(^(3)),AMQQLINK=$P(%,U,5),AMQQTNAR=$P(%,U,15),AMQQTDIC=U_$P(%,U,16),AMQQTLOK=U_$P(%,U,18),AMQQATNM=$P(%,U) ;IHS/OHPRD/JCM 1/20/94
 S AMQQURGN=+$G(AMQQURGN) K ^UTILITY("AMQQ TAX",$J,AMQQURGN+1)
 I '$G(IOSL) S IOSL=24
 D AMQQTX
 I +$G(AMQQTAX),'$D(^UTILITY("AMQQ TAX",$J,AMQQTAX)) K AMQQTAX
 Q
 ;

AMQQTX0
AMQQTX0 ; IHS/OHPRD/JCM - SAVE OR RESTORE A TAXONOMY GROUP ; [ 10/18/94 6:54 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**3,6**;JUN 10, 1993
NAME I $D(AMQQXX) G EXIT
 S (%,X)="" F  S X=$O(^UTILITY("AMQQ TAX",$J,AMQQURGN,X)) Q:X=""  S %=%+1 I %=2 Q
 I %<2 G EXIT
 W !!,"Want to save this ",AMQQTNAR," group for future use"
 S %=2 D YN^DICN S:$D(DTOUT) %Y=U K DTOUT
 I %=0 W !!,"This group will be saved as a taxonomy for future use when entered as a value",!,"using the ""[Name of Group"" syntax." G NAME
 I $E(%Y)=U S AMQQQUIT="" G EXIT
 I "nN"[$E(%Y) G EXIT
 D RNAME
EXIT K X,AMQQTGNO,ATXFLG,%,%Y,A,B,I,N,T,Z
 Q
 ;
RNAME R !,"Group name: ",X:DTIME E  S X=U
 I X=U S AMQQQUIT="" Q
 I X="" Q
 I X["(ST)" W !!,"The (ST) is Q-Man's designation for a ""Standard Taxonomy"".",!,"You may not create a standard taxonomy.  Please select another name.",!,*7 G RNAME
 S ATXFLG="",DIC="^ATXAX(",DIC(0)="EQL",DLAYGO=9002226
 D ^DIC K DIC,DLAYGO ;IHS/OHPRD/JCM 8/19/94
 I Y=-1 G RNAME
 I '$P(Y,U,3),DUZ'=$P(^ATXAX(+Y,0),U,5) W !!,X," already exists and cannot be overwritten except by its creator",!!,*7 G RNAME
 I '$P(Y,U,3) D OWRITE Q:$D(AMQQQUIT)  I "Nn"[$E(%Y) G RNAME
 S (AMQQTDFN,AMQQTGNO)=+Y
 S DIE="^ATXAX(",DA=AMQQTGNO,DR=".05////"_DUZ_";.08////0;.09////"_DT_";.12////"_AMQQLINK_";.13////"_(AMQQTAXT=2)_";.15////"_+$P($G(@(AMQQTLOK_"0)")),U,2)_";1101" D ^DIE
 I AMQQTAXT=2 D RSTUFF G OEXIT
 D STUFF
 I $D(DTOUT) K DTOUT S AMQQQUIT="" Q
 Q
 ;
OWRITE S AMQQTGNA=$P(Y,U,2),AMQQTGNO=+Y
 W !!,X," already exists.  Want to overwrite" S %=2 D YN^DICN
 I $D(DTOUT) K DTOUT S %Y=U
 I %Y=U S AMQQQUIT="" G OEXIT
 I "Nn"[$E(%Y) G OEXIT
 S DA=+Y,DIK="^ATXAX(" D ^DIK K DIK,DA
 S ATXFLG="",DIC="^ATXAX(",DIC(0)="L",DINUM=AMQQTGNO,X=AMQQTGNA,DIADD=1,DIC("DR")=".01;.02"
 S DLAYGO=9002226 D ^DIC S %Y="Y" ;IHS/OHPRD/JCM 8/19/94
OEXIT K DIC,DIADD,AMQQTGNA,DLAYGO ;IHS/OHPRD/JCM 8/19/94
 Q
 ;
STUFF S X="" F I=1:1 S X=$O(^UTILITY("AMQQ TAX",$J,AMQQURGN,X)) Q:X=""  S ^ATXAX(AMQQTGNO,21,I,0)=X,^ATXAX(AMQQTGNO,21,"B",$E(X,1,30),I)="",^ATXAX(AMQQTGNO,21,"AA",X,X)=""
 G ST1
RSTUFF S X="" F I=1:1 S X=$O(@AMQQHILO@(X)) Q:X=""  S Y=@AMQQHILO@(X),^ATXAX(AMQQTGNO,21,I,0)=X_U_Y,^ATXAX(AMQQTGNO,21,"AA",X,Y)="",^ATXAX(AMQQTGNO,21,"B",$E(X,1,30),I)=""
ST1 S I=I-1,^ATXAX(AMQQTGNO,21,0)="^9002226.02101^"_I_U_I
 K X,Y,Z,I
 Q
 ;
RESTORE ; ENTRY POINT FROM AMQQTX SUBROUTINES
 N AMQQTGNO,AMQQTGIT
 S X=$E(X,2,99)
 S AMQQB=($E(X,$L(X))="]") I AMQQB S X=$E(X,1,$L(X)-1)
 S DIC("S")="I $P(^(0),U,12)=AMQQLINK",DIC="^ATXAX(",DIC(0)="EQ"
 I $D(AMQQNECO)!$D(AMQQDF) S DIC(0)=$S($D(AMQQECHO):"MQEZ",$D(AMQQDF):"MO",1:"")
 E  I $D(AMQQXX) S DIC(0)="EQS"
 D ^DIC K DIC
 I Y=-1 Q
 I Y'=-1,'AMQQB,'$D(AMQQDF) W "]"
 K AMQQSHNO,AMQQB S AMQQTGIT="" I AMQQTAXT'=2 D
 . I AMQQLINK=302 S AMQQTGIT="S X=$P(^AUTTHF(X,0),U)" ;IHS/OHPRD/JCM 11/15/93
 . E  I $D(^AMQQ(1,AMQQLINK,4,1,1)) S AMQQTGIT=^(1) ;IHS/OHPRD/JCM 11/15/93
 I AMQQTAXT=2 D RES1 I 1
 E  S AMQQTGNO="" F  S AMQQTGNO=$O(^ATXAX(+Y,21,"AA",AMQQTGNO)) Q:AMQQTGNO=""  S ^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQTGNO)="" I '$D(AMQQXX),'$D(AMQQDF) D SHOW
 K AMQQTJMP
 I '$D(AMQQDF) W !! K AMQQSHNO,Z,T
 S AMQQTGFG=""
 Q
 ;
SHOW I '$D(AMQQSHNO) S AMQQSHNO=0 W !!,"Members of ",X," Taxonomy =>",!
 N %,X,Z S Z=AMQQTGNO
 I $D(AMQQTJMP) W "." Q
 I AMQQTAXT'=2 S X=AMQQTGNO X AMQQTGIT S Z=X
 W ! S AMQQSHNO=AMQQSHNO+1 I AMQQSHNO>1,AMQQSHNO#(IOSL-4)=1 R "<>",%:DTIME W *13 I $E(%)=U W !,"OK" S AMQQTJMP="" Q
 W Z
 Q
 ;
RES1 S %="" F  S %=$O(^ATXAX(+Y,21,"AA",%)) Q:%=""  S A=$O(^(%,"")) D RES2
 K A,B,AMQQTGNO,N
 Q
 ;
RES2 S AMQQTGNO=%,@AMQQHILO@(%)=A I %'=A S AMQQTGNO=%_"- "_A
 S B=$O(@AMQQTGBL@("BA",%,"")),^UTILITY("AMQQ TAX",$J,AMQQURGN,B)="" I '$D(AMQQXX),'$D(AMQQDF) D SHOW
 K AMQQTJMP
 S N=% F  S N=$O(@AMQQTGBL@("BA",N)) Q:N=""  Q:N]A  S B=$O(^(N,"")),^UTILITY("AMQQ TAX",$J,AMQQURGN,B)=""
 Q
 ;

AMQQTXC
AMQQTXC ; OHPRD/DG - CODE RANGE TAXONOMY ; [ 06/10/97  9:28 AM ]
 ;;2;PCC QUERY UTILITY;**6,8,10**;SEP 9, 1993
 S DIC=$S($G(DUZ("AG"))="I":"@AMQQTGBL@(",1:AMQQTGBL_"(") ;IHS/OHPRD/JCM 10/18/94
 S DIC(0)="EMF"
 I $D(AMQQXX),$D(AMQQNECO) S DIC(0)="MF"
 I $G(AMQQSQNM)="CAUSE OF INJURY" S DIC("S")="I $E($P(^(0),U))=""E"""
 E  I AMQQTGBL="^ICD9" S DIC("S")="I $E($P(^(0),U))'=""E"""
 D ^DIC K DIC,DR
 I Y<0 S AMQQA=1 W:'$D(DUOUT) *7,"  ?? ",X," => Code does not exist!" S AMQQ("NO DISPLAY")=1 Q  ;IHS/OHPRD/TMJ 9/5/95
 S:AMQQTYP="LOW" AMQQ("LOW")=$P(@AMQQTGBL@(+Y,0),U)_" "
 I AMQQTYP="LOW",AMQQONE S AMQQ("HI")=AMQQ("LOW") D ^AMQQTXC1
 I AMQQTYP="HI" S AMQQ("HI")=$P(@AMQQTGBL@(+Y,0),U)_" " D L1 I 'AMQQ("NO DISPLAY") D DISPLAY Q:$D(AMQQQUIT)  D ^AMQQTXC1
EXIT K %
 Q
 ;
L1 I $E(AMQQ("HI"))?1N&($E(AMQQ("LOW"))?1N)!($E(AMQQ("LOW"))'?1N&($E(AMQQ("HI"))'?1N))
 E  W !,*7,"Low and high codes of range must both start either with a letter or a number.",! S AMQQ("NO DISPLAY")=1
 I 'AMQQ("NO DISPLAY") I AMQQ("LOW")]AMQQ("HI") W !,*7,"Low code is higher than high code.",! S AMQQ("NO DISPLAY")=1
 Q
 ;
DISPLAY ;SHOW CODES IN RANGE SELECTED
 W:$D(IOF) @IOF
 W !!,"Codes in this range =>",!! W $P(AMQQ("LOW")," ") S AMQQDFN=$O(@AMQQTGBL@("BA",AMQQ("LOW"),"")) W ?9,$S(AMQQTGBL="^ICPT":$P(@AMQQTGBL@(AMQQDFN,0),U,2),1:$P(@AMQQTGBL@(AMQQDFN,0),U,3)) ;IHS/OHPRD/TMJ 9/5/95
 S AMQQ=AMQQ("LOW"),AMQQCNT=IOSL-5,AMQQDFN=$O(@AMQQTGBL@("BA",AMQQ,"")) D A1
 F  S AMQQ=$O(@AMQQTGBL@("BA",AMQQ)) Q:AMQQ=""!(AMQQ]AMQQ("HI"))  S AMQQDFN=$O(^(AMQQ,"")) D  ;IHS/OHPRD/TMJ Patch #10 6/9/97
 . I $D(AMQQTJMP) W "." S ^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQDFN)="""" Q
 . W !,$P(AMQQ," "),?9,$S(AMQQTGBL="^ICPT":$P(@AMQQTGBL@(AMQQDFN,0),U,2),1:$P(@AMQQTGBL@(AMQQDFN,0),U,3)) D A1 I $D(AMQQQUIT) Q  ;IHS/OHPRD/TMJ 9/5/95
 K AMQQTJMP
 I $S('$D(AMQQR):1,AMQQR'=U:1,1:0) R !!,"Press return to continue",AMQQR:DTIME E  S AMQQR=U
 I AMQQR=U Q
 W !
 Q
 ;
A1 S AMQQCNT=AMQQCNT-1
 I '$D(AMQQTXEX) S ^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQDFN)=""
 E  K ^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQDFN)
 I AMQQCNT Q
A11 S AMQQCNT=IOSL-4
 R !,"<>",AMQQR:DTIME E  S AMQQR=U
 I AMQQR=U S AMQQTJMP="" W !,"OK" Q
 I AMQQR["?" W " Enter ""^"" to stop display, return to continue" G A11
 Q
 ;
RANGES ; ENTRY POINT FROM AMQQTXG1 ; DISPLAY TABLE OF ALL RANGES
 I $D(AMQQXX) Q
 W:$D(IOF) @IOF
 I '$D(AMQQNECO) W !!,"Code Range(s) Selected So Far =>",! ;IHS/OHPRD/TMJ 9/5/95
 S (AMQQ("NUM"),AMQQ)=0 F  S AMQQ=$O(@AMQQHILO@(AMQQ)) Q:AMQQ=""  S AMQQ("NUM")=AMQQ("NUM")+1 W !,AMQQ("NUM"),")  ",AMQQ,$S(AMQQ'=@AMQQHILO@(AMQQ):"- "_@AMQQHILO@(AMQQ),1:"")
 I '$D(AMQQ("BANG")) W !
 Q
 ;
SHOW ; ENTRY POINT FROM AMQQTXG1 ; ALLOW USER TO SELECT FROM RANGES TO DISPLAY CODES
 D RANGES
 I AMQQ("NUM")=1 S X=1 G AA
A W !,"Enter an Item Number from the table above to display code(s): " R X:DTIME E  S X=U
 I X?1."?" W !!,"Enter a number between 1 and ",AMQQ("NUM"),! G A
 I X=U Q
 I X,X'>AMQQ("NUM"),X?1N
 E  W "  ??",*7 G A
AA S AMQQ("N")=X F AMQQI=1:AMQQ("N") S AMQQ=$O(@AMQQHILO@(AMQQ)) I AMQQI=AMQQ("N") S AMQQ("LOW")=AMQQ,AMQQ("HI")=@AMQQHILO@(AMQQ) D DISPLAY Q
 S AMQQ("BANG")="" D RANGES K AMQQ("BANG")
 Q
 ;
ASK2 ;ASKS USER IF WANTS TO DISPLAY/PRINT RESULTS TO THIS POINT
 I '$D(@AMQQHILO) W !!,"A code range has yet to be selected.  A display cannot be generated.",! Q
 W !!,"Do you want to display the codes from a range you have already selected" S %=1 D YN^DICN I %=1 D SHOW
 I %=2!(%=-1) Q
 I %=0 W !!,"A table of ranges you have selected is displayed above.  You may ask for the",!,"codes in one of the ranges to be displayed.",! G ASK2
 Q
 ;

AMQQTXG
AMQQTXG ; OHPRD/DG - POINTER TAXONOMY ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
EN3 ; ENTRY POINT FOR POINTER TAXONOMY
 S AMQQHELP="PHELP",AMQQHEL1="PHELP1",AMQQLKUP="PLOOKUP"
VAR S AMQQTAXI=$P(^AMQQ(5,AMQQATN,0),U,17)
RUN D GET
 I '$D(AMQQQUIT),'$D(AMQQSCMP),AMQQTAXT'=2,'$D(AMQQXX) D LIST^AMQQTX
EXIT K X,AMQQTAXI,I,AMQQTGFG,AMQQTDIC,AMQQHELP,AMQQHEL1,AMQQLKUP,AMQQXXN,%,%Y,N,T,C
 Q
 ;
GET I '$D(AMQQXX) W !
GETR I $D(AMQQXXTT),$D(AMQQXXN) S AMQQXXN=$O(^UTILITY("AMQQ",$J,"XXTAX",AMQQXXTT,AMQQXXN)) Q:'AMQQXXN  S X=^(AMQQXXN) G GRR
 I $D(AMQQNTAX),AMQQNTAX="" Q
 I $D(AMQQNTAX) S X=AMQQNTAX,AMQQNTAX="" G GRR
 I $D(AMQQXX),$D(AMQQONE) S X="ALL" G GRR
 S %="Enter "_$S($D(^UTILITY("AMQQ TAX",$J,AMQQURGN)):"ANOTHER ",1:"")_AMQQTNAR
 K AMQQNDB
 W !,%,": " R X:DTIME E  S X=U
GRR I X="",'$D(^UTILITY("AMQQ TAX",$J,AMQQURGN)),'$D(AMQQSCMP) D ACA^AMQQAC Q:X=4  I X="" W ! G GETR
 I X="" Q
 I X=U S AMQQQUIT="" Q
 I X="]" S AMQQTTOT=9 K AMQQTGFG G GETR
 I X="@" S X="NULL" W " (NULL SET)"
 I X="EXIST" S X="EXISTS" W "S"
 I '$D(AMQQSCMP),$D(AMQQSQNM),$D(AMQQSQSJ),AMQQSQNM'=AMQQSQSJ,AMQQSQNM'="RESULT/DIAGNOSIS" F %="ALL","ANY","EXISTS" I X=% W " ??" G GET ; IHS/CMI/GIS 11/19/98
 I '$D(AMQQSCMP) F %="ALL","ANY","EXISTS","NULL" I X=% G GEXIT
 I X="*" D EDALL G GETR
 I X?1"?" D @(AMQQHELP_"^AMQQTXG1") G GETR
 I X?2"?" D LIST^AMQQTX G GETR
 I X?3."?" D @(AMQQHEL1_"^AMQQTXG1") G GETR
 I $E(X)="-",'$D(^UTILITY("AMQQ TAX",$J,AMQQURGN)) W "  ??",*7 G GETR
 I AMQQTAXT=2,$L(X,"-")>2 D DASH I Y W "  ??",*7 G GETR
 I $E(X)="-" S X=$E(X,2,99) S AMQQTXEX=""
 I X="[" W "  ??",*7 G GETR
 ;I X["[",X["-" W "  ??",*7 G GETR
 I $E(X,1,2)="[?" D WHATG^AMQQTX G GETR
 I $E(X)="[" D RESTORE^AMQQTX0 G GETR
 I $E(X)="""",$E(X,$L(X))="""" S X=$E(X,2,($L(X)-1)),AMQQNDB=""
 D @(AMQQLKUP_"^AMQQTXG1") I $D(AMQQQUIT) Q
 I Y'=-1,AMQQTAXT'=2 D SET^AMQQTX
 I Y=-1,$D(AMQQXX) K ^UTILITY("AMQQ TAX",$J,AMQQURGN),AMQQTAX Q
 G GETR
 ;
GEXIT I X'="NULL" K ^UTILITY("AMQQ TAX",$J,AMQQURGN) S AMQQSCMP=X Q
 D NULL^AMQQTX I $D(AMQQQUIT) Q
 I $D(AMQQSCMP),AMQQSCMP="NULL" Q
 I "Yy"'[$E(%Y) W " ??",*7
 G GETR
 ;
EDALL S %=$P(^AMQQ(1,AMQQLINK,0),U,5),%=$P(^AMQQ(4,%,0),U) I %="G" D EDA Q
 S X=AMQQTLOK_"""B"")"
 S %="" F  S %=$O(@X@(%)) Q:%=""  S Y=$O(^(%,"")) I Y'="" S ^UTILITY("AMQQ TAX",$J,AMQQURGN,Y)="" W "."
 Q
 ;
EDA N I,% F I=2:1 S %=$P(AMQQSSET,";",I),%=$P(%,":") Q:%=""  S ^UTILITY("AMQQ TAX",$J,AMQQURGN,%)="" W "."
 Q
 ;
DASH S Y=0
 I $L(X,"-")>3 S Y=1 Q
 I $P(X,"-")'="" S Y=1 Q
 F %=2,3 I $P(X,"-",%)="" S Y=1 Q
 Q
 ;
EN5 ; ENTRY POINT FOR HYBRID TAX
 D EN3
 Q
 ;
EN1 ; ENTRY POINT FOR FREE TEXT TAX
 S (AMQQHELP,AMQQHEL1)="FHELP",AMQQLKUP="FLOOKUP"
 D VAR
 Q
 ;
EN4 ; ENTRY POINT FOR GROUP OF CODES TAXONOMY
 S AMQQHEL1="GHELP1",AMQQHELP="PHELP",AMQQLKUP="GLOOKUP"
 D VAR
 Q
 ;
EN2 ; ENTY POINT FOR RANGE OF CODES
 S AMQQHELP="RHELP",AMQQLKUP="RLOOKUP",AMQQHEL1="RHELP1"
 D VAR
 Q
 ;

AMQQTXG1
AMQQTXG1 ; OHPRD/DG - LOOKUP FOR TAX ; [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**8,14**;JUN 10, 1993
 ;IHS/CMI/LAB - patch 14 WH
PLOOKUP ; ENTRY POINT FROM AMQQTXG
 S DIC=AMQQTLOK,DIC(0)="EQM"
 I $G(AMQQSQSN)=617,$G(AMQQSQN)=620 S %=$O(^UTILITY("AMQQ TAX",$J,+$G(AMQQTAX)-1,0)) I '$O(^(%)) S DIC("S")="I $D(^BWDIAG(""P"","_%_",Y))" ; IHS/CMI/GIS 11/24/98
 I $D(AMQQNECO) S DIC(0)="M"
 I DIC="^AUTTHF(" S DIC("S")="I $P(^(0),U,10)=""F"""
 D ^DIC K DIC,DUOUT,DTOUT
 I Y'=-1 S X=+Y I $D(AMQQTAXI),$D(AMQQTDIC),AMQQTAXI'="",AMQQTDIC'="" D PLK1
 Q
 ;
PLK1 I $D(AMQQTTX),AMQQTTX'="",$D(AMQQTAXT),AMQQTAXT=5 X AMQQTTX
 S %=AMQQTDIC_""""_AMQQTAXI_""",X)"
 I '$D(AMQQNDB),'$D(@%) W !,"  (none found in database so not selected... if you still want to select this",!,"   value enter it with quotes about it" S Y=-1
 K AMQQNDBC
 Q
 ;
PHELP ; ENTRY POINT FROM AMQQTXG
 W !!,"Enter the name of a ",AMQQATNM,".",!,"Enter ""??"" to see your selections or ""???"" to see choices.",!!
 Q
 ;
PHELP1 ; ENTRY POINT FROM AMQQTXG
 S DIC=AMQQTLOK,DIC(0)="E",D="B",DZ="??"
 I $G(AMQQSQSN)=617,$G(AMQQSQN)=620 S %=$O(^UTILITY("AMQQ TAX",$J,+$G(AMQQTAX)-1,0)) I '$O(^(%)) S DIC("S")="I $D(^BWDIAG(""P"","_%_",Y))" ; IHS/CMI/GIS 11/24/98
 I DIC="^AUTTHF(" S DIC("S")="I $P(^(0),U,10)=""F"""
 D DQ^DICQ K DIC,D,DZ
 Q
 ;
GLOOKUP ; ENTRY POINT FROM AMQQTXG
 S Y=$F(AMQQSSET,(";"_X_":"))
 I Y S Z=$E(AMQQSSET,Y,256),Z=$P(Z,";") W "  (",Z,")" S Y=X Q
 S Y=-1 F %=2:1 S Z=$P(AMQQSSET,";",%) Q:Z=""  I $E($P(Z,":",2),1,$L(X))=X W $E($P(Z,":",2),$L(X)+1,99) S Y=$P(Z,":") Q
 I Y=-1 W *7,"  ??" Q
 S X=Y
 Q
 ;
GHELP1 ; ENTRY POINT FROM AMQQTXG
 S %="You may select one or more of the following =>" W !!,%,!
 F %=1:1 S X=$P(AMQQSSET,":",%) W !?5,$P(X,";") I $P(X,";",2)="" Q
 Q
 ;
FHELP ; ENTRY POINT FROM AMQQTXG
 I AMQQTAXI="" W !!,"Enter the name of a ",AMQQATN Q
 S %="You may select one or more of the following =>" W !!,%,!
 S %="",X="",T=AMQQTDIC_""""_AMQQTAXI_""")" F I=1:1 S %=$O(@T@(%)) Q:%=""  W ! D:'(I#(IOSL-4)) FLIST1 W ?5,% I X=U Q
 Q
 ;
FLIST1 W "<>" R X:DTIME W *13,?5,*13
 Q
 ;
FLOOKUP ; ENTRY POINT FROM AMQQTXG
 I AMQQTAXI="" G FEXIT
 S T=AMQQTDIC_""""_AMQQTAXI_""")"
 I '$D(@T@(X)) S %=$O(@T@(X)) I $E(%,1,$L(X))'=X W "  <= Not found in data base",*7 G FEXIT
 I $D(@T@(X)) S %=$O(@T@(X)) I $E(%,1,$L(X))'=X G FEXIT
 I '$D(@T@(X)) S (%,Y)=$O(@T@(X)) I $E(%,1,$L(X))=X S %=$O(^(%)) I $E(%,1,$L(X))'=X W $E(Y,$L(X)+1,99) S X=Y G FEXIT
 S N=0,Z=X
 I $D(@T@(X)) S ^UTILITY("AMQQ LOOK",$J,1)=X,N=1
FINCN S Z=$O(@T@(Z)) I $E(Z,1,$L(X))'=X S N=N+1 D FC1 G:Y'=0 FEXIT G FMORE
 S N=N+1 I N>1,N#5=1 D FC Q:Y=1  G:Y=-1 FEXIT I Y=0 D FEXIT G FLOOKUP
 W !?5,N,"   ",Z S ^UTILITY("AMQQ LOOK",$J,N)=Z
 G FINCN
FMORE S AMQQLMOR=""
FEXIT K T,^UTILITY("AMQQ LOOK",$J),N
 Q
 ;
FC W !,"TYPE <CR> TO SEE MORE CHOICES, '^' TO STOP, OR"
FC1 W !,"CHOOSE 1-",N-1,": "
 R Y:DTIME E  S Y=U
 I Y="" Q
 I Y=U S Y=-1 Q
 I Y?1."?" W !,"Pick a number between 1 and ",N-1,".  You can also enter a new name.",! G FC
 I Y,$D(^UTILITY("AMQQ LOOK",$J,Y)) S X=^(Y) W "  (",X,")" Q
 I Y=+Y W "  ??",*7 G FC1
 S X=Y,Y=0 Q
 ;
RHELP ; ENTRY POINT FROM AMQQTXG
 S X="DIAG"
 I AMQQLINK=31 S Z="diagnosis^diagnoses^ICD9^250.00^250.51^CAUSE or LOCATION"
 I AMQQLINK=174 S Z="procedure^procedures^ADA^AAA^BBB^CCC"
 I AMQQLINK=455 S Z="CPT CODE^CPT CODES^CPT^11040^11044" ;IHS/OHPRD/TMJ 9/5/95
 D ^AMQQHEL1
 Q
 ;
RLOOKUP ; ENTRY POINT FROM AMQQTXG
 S AMQQSAVE("X")=X,(AMQQONE,AMQQSUB,AMQQA)=0,AMQQ("NO DISPLAY")=0,AMQQ("NOT TAX")="",AMQQTYP="LOW"
 I $D(AMQQTXEX) D RL1 G REXIT
 I X'["-" S AMQQONE=1 D ^AMQQTXC S:Y>0 ^UTILITY("AMQQ TAX",$J,AMQQURGN,+Y)="" G REXIT
 S X=$P(X,"-") W ! D ^AMQQTXC I 'AMQQA S AMQQTYP="HI",X=$P(AMQQSAVE("X"),"-",2) W ! D ^AMQQTXC
REXIT I 'AMQQA,'$D(AMQQQUIT),$D(@AMQQHILO) D RANGES^AMQQTXC
 K AMQQSUB,AMQQTYP,AMQQDFN,DIR,AMQQSAVE,AMQQA,AMQQCNT,AMQQ,AMQQR,AMQQI,AMQQSTP,AMQQX,AMQQTXEX
 Q
 ;
RL1 S AMQQSUB=1,AMQQA=0
 I X["-" S X=$P(X,"-") D ^AMQQTXC I 'AMQQA S X=$P(AMQQSAVE("X"),"-",2),AMQQTYP="HI" W ! D ^AMQQTXC Q
 I X'["-" S AMQQTYP="LOW",AMQQONE=1 D ^AMQQTXC I Y>0 K ^UTILITY("AMQQ TAX",$J,AMQQURGN,+Y)
 Q
 ;
RHELP1 ; ENTRY POINT ROM AMQQTXG
 I '$D(@AMQQHILO) W !!,"A code range has yet to be selected.  A display cannot be generated.",! Q
 D SHOW^AMQQTXC
 Q
 ;

AMQQUTIL
AMQQUTIL ; IHS/OHPRD/JCM - RETURNS IF USER HOLDER OF PARTICULAR SECURITY KEY ; [ 11/15/93 10:27 AM ] [ 10/17/95  07:47 AM ]
 ;;2;PCC QUERY UTILITY;**3**;JUN 10, 1993
 ;
KEYCHECK(AMQQKEY)  ; - EP - CHECK FOR KEY HOLDING
 Q $S(('$D(DUZ)#2):0,1:$D(^XUSEC(AMQQKEY,DUZ)))
 ;
DFNINC    ; - EP - Gets the next valid DFN when random sampling ;IHS/OHPRD/JCM 11/11/93
 Q:$D(^DPT(AMQP(0)))
 F  S AMQP(0)=AMQP(0)+$R(AMQP("$R")) Q:$D(^DPT(AMQP(0)))  S:'$O(^DPT(AMQP(0))) AMQP(0)=0 Q:'AMQP(0)
 Q

AMQQVIEW
AMQQVIEW ; IHS/OHPRD/JCM - VIEW TAXONOMIES AND SEARCH TEMPLATES ; [ 02/23/98  10:22 AM ]
 ;;2;PCC QUERY UTILITY;**4,10**;FEB 12, 1998
 ; CALLS TASKMAN
CHK I $D(DTOUT)+$D(DUOUT)+(Y=-1)+(Y="") K DIRUT,DUOUT,DTOUT S AMQQQUIT="" Q
 Q
 ;
TAX ; ENTRY POINT FROM AMQQOPT1
 S AMQQVG="^ATXAX",AMQQVTYP="TAX",AMQQVSS=11
 D OUT
 G EXIT
TMP ; ENTRY POINT FROM AMQQOPT1
 W !!!,"You can view templates which store either PATIENTS or VISITS =>"
 S DIR(0)="SO^1:PATIENTS;2:VISITS;3:BOTH patients and visits",DIR("A")=$C(10)_"     Your choice" D ^DIR K DIR
 D CHK I  Q
 S AMQQVCK=$S(Y=1:"I %=2!(%=9000001)",Y=2:"I %=9000010",1:"I %=2!(%=9000001)!(%=9000010)"),AMQQVG="^DIBT",AMQQVTYP="TMP",AMQQVSS="%D"
 D OUT
EXIT K AMQQQUIT,AMQQVENO,AMQQVNL,AMQQVWP,AMQQVENA,AMQQVG,AMQQVTYP,AMQQVSS,AMQQVIX,AMQQVCK,AMQQVOFF,%,I,Z
 W @IOF
 Q
 ;
OUT S AMQQVOFF=0
 W !! S %ZIS="Q" D ^%ZIS I POP Q
 I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G OUT
 I $E(IOST,1,2)="P-" N AMQQRV,AMQQNV,AMQQXV S (AMQQRV,AMQQNV)="AMQQXV",AMQQXV=""
 I $E(IOST,1,2)="C-" W !,@AMQQRV,@AMQQNV S AMQQVOFF=$X
 I '$D(IO("Q")) U IO D TASK D ^%ZISC Q
 S ZTRTN="TASK^AMQQVIEW",ZTIO=ION,ZTDTH="NOW"
 S ZTDESC="Q-MAN LIST OF TAXONOMIES AND TEMPLATES"
QUEUE F I=1:1 S %=$P("DT;DTIME;DUZ(;DUZ;U;AMQQV*;AMQQ200(;AMQQRV;AMQQNV;AMQQXV",";",I) Q:%=""  S ZTSAVE(%)="" ;IHS/OHPRD/JCM 3/17/94
 D ^%ZTLOAD,^%ZISC ; CALL TO TASKMAN
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3
 Q
 ;
TASK D HEADER
 S AMQQVNL=0
 I AMQQVTYP="TMP" F AMQQVIX="F9000001","F2","F9000010" I $D(@AMQQVG@(AMQQVIX)) S AMQQVENA="" F  S AMQQVENA=$O(@AMQQVG@(AMQQVIX,AMQQVENA)) Q:AMQQVENA=""  F AMQQVENO=0:0 S AMQQVENO=$O(@AMQQVG@(AMQQVIX,AMQQVENA,AMQQVENO)) Q:'AMQQVENO  D TLSET
 I AMQQVTYP="TAX" S AMQQVENA="" F  S AMQQVENA=$O(@AMQQVG@("B",AMQQVENA)) Q:AMQQVENA=""  F AMQQVENO=0:0 S AMQQVENO=$O(@AMQQVG@("B",AMQQVENA,AMQQVENO)) Q:'AMQQVENO  D TLSET,MEM
 I '$D(AMQQQUIT),$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR D CHK
 Q
 ;
TLSET I AMQQVTYP="TAX" G TLS1
 S %=$P(@AMQQVG@(AMQQVENO,0),U,4) X AMQQVCK E  Q
 I $D(@AMQQVG@(AMQQVENO,1))<10 Q
 D TLS1 Q
MEM ; List members of taxonomy
 NEW AMQQTX
 I $O(^ATXAX(AMQQVENO,21,0)) D PAUSE Q:$D(AMQQQUIT)  W !,$P(^ATXAX(AMQQVENO,0),U)_" Taxonomy Members:",! D PAUSE S AMQQTX=0 F  S AMQQTX=$O(^ATXAX(AMQQVENO,21,AMQQTX)) Q:'AMQQTX!($D(AMQQQUIT))!(AMQQVENO=99999999)  D
 . D PAUSE
 . I $D(AMQQQUIT) Q
 . N %,%A,%B
 . S %=$P(^ATXAX(AMQQVENO,21,AMQQTX,0),U,2),%A=$P(^(0),U)
 . I %]"",%?1N.N S %B=% D PTRVAL S %=%B
 . I %A?1N.N S %B=%A D PTRVAL S %A=%B
 . I %]"" W !,$S(%=%A:%,1:%A_"-"_%)
 . E  W !,%A
 . D PAUSE
 W !! D PAUSE,PAUSE
 Q
 ;
PTRVAL ; Change from ptr val to actual val
 NEW X,G
 I $P(^ATXAX(AMQQVENO,0),U,15) S G=^DIC($P(^(0),U,15),0,"GL")
AGIN I $P(@(G_"0)"),U,2)["P" S G=^DIC(+$P($P(^DD(+$P(@(G_"0)"),U,2),.01,0),U,2),"P",2),0,"GL") G AGIN
 Q:$P($G(@(G_%B_",0)")),U)=""  ;IHS/OHPRD/TMJ 2/12/98 fIX IF MISSING CPT CODE
 S %B=$P(@(G_%B_",0)"),U)
 Q
 ;
TLS1 S X=@AMQQVG@(AMQQVENO,0)
 D PAUSE I $D(AMQQQUIT) Q
 S %=$P(X,U),%=$E(%,1,31) W @AMQQRV,%,@AMQQNV
 D @(AMQQVTYP_"SET")
 W ! S Z=$S($G(@AMQQVG@(AMQQVENO,AMQQVSS,1,0))="":"   No description entered",1:("    "_$E(^(0),1,75)))
 I Z?1.P S Z=$S($G(@AMQQVG@(AMQQVENO,AMQQVSS,2,0))="":"  No description entered",1:("    "_$E(^(0),1,75)))
 W Z,! D PAUSE W ! D PAUSE
 Q
 ;
TAXSET S %=$P(X,U,9) S Y=% X ^DD("DD") I Y'=% W ?32+AMQQVOFF,$P(Y,"@")
 S %=$P(X,U,5) I %'="" S %=$P($G(@AMQQ200(3)@(%,0)),U),%=$P(%,","),%=$E(%,1,15) W ?46+AMQQVOFF,% ;VA/SLC ISC/GIS 11/24/93
 S %=$P(X,U,15) I %]"" S %=$P($G(^DIC(%,0)),U),%=$E(%,1,18-AMQQVOFF) W ?62+AMQQVOFF,%
 Q
 ;
TMPSET S %=$P(X,U,2) S Y=% X ^DD("DD") I Y'=% W ?32+AMQQVOFF,$P(Y,"@")
 S %=$P(X,U,5) I %'="" S %=$P($G(@AMQQ200(3)@(%,0)),U),%=$P(%,","),%=$E(%,1,15) W ?46+AMQQVOFF,% ;VA/SLC ISC/GIS 11/24/93
 S %=$P(X,U,$S(AMQQVTYP="TMP":4,1:15)),%=$P($G(^DIC(%,0)),U),%=$E(%,1,18-AMQQVOFF) W ?62+AMQQVOFF,%
 Q
 ;
WPAUSE W !
PAUSE S AMQQVNL=AMQQVNL+1 I AMQQVNL#(IOSL-4) Q
 I $E(IOST,1,2)="P-" W @IOF Q
 W !!,"<>" R %:DTIME E  S %=U
 I $E(%)=U S AMQQQUIT="",(AMQQVWP,AMQQVENO)=99999999,AMQQVENA="zzzzzzzz" Q
HEADER S %="",$P(%,"-",79)="" W @IOF,*13
 W $S(AMQQVTYP="TAX":"TAXONOMY",1:"TEMPLATE"),?32,"DATE",?46,"CREATOR",?62,"FILEMAN FILE",!,?4,"Narrative description of ",$S(AMQQVTYP="TAX":"taxonomy",1:"template"),!,%,!
 Q
 ;

AMQQWH
AMQQWH ; CMI/MIC/GIS - WOMEN'S HEALTH SETUP ROUTINE ;  [ 07/04/1999  10:35 AM ]
 ;;2;PCC QUERY UTILITY;**14**;MAR 31, 1998
 ;IHS/CMI/LAB patch 14 WH
SETUP ;
 N DA,DIC,DIK,X,Y,Z,%DEVOARG,%DEVTYPE
 W !!!,"SETUP ROUTINE FOR Q-MAN'S WOMEN'S HEALTH ATTRIBUTES",!!!
 I $D(^AMQQ(7,48,0)),^(0)'="WOMEN'S HEALTH" W "INVALID METADICTIONARY ENTRIES DETECTED.  SETUP CANCELLED...",*7 Q
 W "Cleaning out old metadictionary entries..."
 F Z=5,1 S DIK="^AMQQ("_Z_"," F DA=600:0 S DA=$O(^AMQQ(Z,DA)) Q:'DA  Q:DA>699  D ^DIK W "-"
 S DIK="^AMQQ(7," F DA=48:1:51 D ^DIK W "-"
 W !!,"Restoring globals...",!,"When prompted for the name of a file, enter 'AMQQWH.G'",!!
 D ^%GR
 I '$D(^AMQQ(1,675)) W "Globals not fully restored, install aborted!",!! Q
 W !!,"Restoring metadictionary indices..."
 S DIK="^AMQQ(7," F DA=48:1:51 D IX^DIK W "+"
 F Z=1,5 S DIK="^AMQQ("_Z_"," F DA=600:0 S DA=$O(^AMQQ(Z,DA)) Q:'DA  Q:DA>699  D IX^DIK W "+"
 W !!,"All metadictionary entries successfully updated!!!!",!
 W "Q-Man is now linked to the Women's Health Package."
 W !!,"Exiting setup...."
 Q
 ;