AMQQREG ; IHS/CMI/THL - QUERY CMS REGISTER INTERFACE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;;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 DX:AMQQCNAM["DIABET"
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))"
S DIC("A")="Which CMS REGISTER: "
W !
D DIC
Q:$D(AMQQQUIT)
S AMQQRDA=+Y
S AMQQCNAM=$P(Y,U,2)_" REGISTER"
D DECEASED^ACMGTP(AMQQRDA)
Q
ACTIVE ;EP;TO SELECT PATIENT STATUS
K DIR
W !!,"Select the Patient Status for this report"
W !!?10,"1 Active"
W !?10,"2 Inactive"
W !?10,"3 Transient"
W !?10,"4 Unreviewed"
W !?10,"5 Deceased"
W !?10,"6 Non-IHS"
W !?10,"7 Lost to Follow-up"
W !?10,"8 All Register Patients"
S DIR(0)="LO^1:8"
S DIR("A")="Which Status(es)"
S DIR("B")="1"
W !
D ^DIR
K DIR
I 'Y S AMQQQUIT="" Q
I Y[8 S AMQQ("CMS STATUS","Z")="" Q
I Y D
.N X,Z
.F J=1:1 S X=$P(Y,",",J) Q:X="" D
..S Z=$S(X=1:"A",X=2:"I",X=3:"T",X=4:"U",X=5:"D",X=6:"N",X=7:"L",X=8:"Z",1:"")
..Q:Z=""
..S AMQQ("CMS STATUS",Z)=""
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
S CTR=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 $G(AMQQ("DM DIAGNOSIS"))]"" D PATDX I $D(AMQQQUIT) K AMQQQUIT Q
.I $D(AMQQ("CMS STATUS","Z"))!$D(AMQQ("CMS STATUS",Z)) D
..S ^DIBT(AMQQDA,1,Y)=""
..W "."
..S CTR=CTR+1
W !!,"There are ",CTR," register patients for the combination selected.",!
Q
C1 ;CREATE SEARCH TEMPLATE
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
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 DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
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"""
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///^S X=""REGISTER"""
.D ^DIE
.S Y=DA
.K ^AMQQ(5,DA,1)
.K DA,DR,DIE
.D NR1
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
S X="REGISTER"
S DIC="^AMQQ(5,"
S DIC(0)="L"
S DIC("DR")="3////52;4////40;10////P"
D FILE^DICN
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,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
DX ;EP;TO SELECT DIABETES DIAGNOSIS
I $G(AMQQCNAM)["PRE-DIAB" G PREDX
W !!,"Select the Diabetes Register Diagnosis for this report"
S DIR(0)="SO^1:Type 1;2:Type 2;3:Type 1 & Type 2;4:Gestational DM;5:Impaired Glucose Tolerance;6:All Diagnoses"
S DIR("A")="Which Register Diagnosis"
S DIR("B")="All Diagnoses"
S DIR("?",1)="Enter the appropriate REGISTER DIAGNOSIS term. This is NOT a POV's ICD code."
S DIR("?",2)="Qman will not find patients in which the REGISTER DIAGNOSIS field is null"
S DIR("?",3)=""
S DIR("?",4)="If Register Diagnoses have not been assigned to all patients"
S DIR("?",5)="in the Register or to all patients with a specific categories,"
S DIR("?")="use '6 - All Diagnoses' to avoid misleading results."
D ^DIR
K DIR
I 'Y S AMQQQUIT="" Q
S AMQQ("DM DIAGNOSIS")=$S(Y=1:"TYPE 1",Y=2:"TYPE 2",Y=3:"TYPE 1 & TYPE 2",Y=4:"GESTATIONAL DM",Y=5:"IMPAIRED GLUCOSE TOLERANCE",1:"")
Q
PREDX ;EP TO SELECT PREDIABETES REGISTER DIAGNOSIS
W !!,"Select the Diabetes Register Diagnosis for this report"
S DIR(0)="SO^1:IMP Fasting Glucose (IFG);2:IMP Glucose Tolerance (IGT);3:Metabolic Syndrome;4:Other Abnormal Glucose;5:All Diagnoses"
S DIR("A")="Which Register Diagnosis"
S DIR("B")="All Diagnoses"
S DIR("?",1)="Enter the appropriate REGISTER DIAGNOSIS term. This is NOT a POV's ICD code."
S DIR("?",2)="Qman will not find patients in which the REGISTER DIAGNOSIS field is null"
S DIR("?",3)=""
S DIR("?",4)="If Register Diagnoses have not been assigned to all patients"
S DIR("?",5)="in the Register or to all patients with a specific categories,"
S DIR("?")="use '5 - All Diagnoses' to avoid misleading results."
D ^DIR
K DIR
I 'Y S AMQQQUIT="" Q
S AMQQ("DM DIAGNOSIS")=$S(Y=1:"IMP FASTING GLUCOSE (IFG)",Y=2:"IMP GLUCOSE TOLERANCE (IGT)",Y=3:"METABOLIC SYNDROME",Y=4:"OTHER ABNORMAL GLUCOSE",1:"")
Q
PATDX ;INCLUDE PATIENTS WITH SPECIFIC DIAGNOSIS
S AMQQQUIT=""
Q:'$D(^ACM(44,"D",X))
N Y,Z
S Y=0
F S Y=$O(^ACM(44,"D",X,Y)) Q:'Y D
.S Z=+$G(^ACM(44,Y,0))
.I $P($G(^ACM(44.1,+Z,0)),U)]"",AMQQ("DM DIAGNOSIS")[$P(^(0),U) K AMQQQUIT
Q
AMQQREG ; IHS/CMI/THL - QUERY CMS REGISTER INTERFACE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;;UTILITY TO SELECT AND UTILIZE CMS REGISTER AS SUBJECT OF A QMAN
+3 ;;SEARCH
+4 ;-----
EN NEW Y,AMQQ
+1 DO EN1
EXIT KILL AMQQQUIT
+1 QUIT
EN1 DO REG
+1 IF $DATA(AMQQQUIT)
QUIT
+2 DO ACTIVE
+3 IF $DATA(AMQQQUIT)
QUIT
+4 IF AMQQCNAM["DIABET"
DO DX
+5 IF $DATA(AMQQQUIT)
QUIT
+6 DO COHORT
+7 QUIT
REG ;EP;TO SELECT A REGISTER
+1 NEW Y
+2 KILL AMQQRDA
+3 SET DIC="^ACM(41.1,"
+4 SET DIC(0)="AEMQZ"
+5 SET DIC("S")="I $D(^ACM(41.1,+Y,""AU"",""B"",DUZ))"
+6 SET DIC("A")="Which CMS REGISTER: "
+7 WRITE !
+8 DO DIC
+9 IF $DATA(AMQQQUIT)
QUIT
+10 SET AMQQRDA=+Y
+11 SET AMQQCNAM=$PIECE(Y,U,2)_" REGISTER"
+12 DO DECEASED^ACMGTP(AMQQRDA)
+13 QUIT
ACTIVE ;EP;TO SELECT PATIENT STATUS
+1 KILL DIR
+2 WRITE !!,"Select the Patient Status for this report"
+3 WRITE !!?10,"1 Active"
+4 WRITE !?10,"2 Inactive"
+5 WRITE !?10,"3 Transient"
+6 WRITE !?10,"4 Unreviewed"
+7 WRITE !?10,"5 Deceased"
+8 WRITE !?10,"6 Non-IHS"
+9 WRITE !?10,"7 Lost to Follow-up"
+10 WRITE !?10,"8 All Register Patients"
+11 SET DIR(0)="LO^1:8"
+12 SET DIR("A")="Which Status(es)"
+13 SET DIR("B")="1"
+14 WRITE !
+15 DO ^DIR
+16 KILL DIR
+17 IF 'Y
SET AMQQQUIT=""
QUIT
+18 IF Y[8
SET AMQQ("CMS STATUS","Z")=""
QUIT
+19 IF Y
Begin DoDot:1
+20 NEW X,Z
+21 FOR J=1:1
SET X=$PIECE(Y,",",J)
IF X=""
QUIT
Begin DoDot:2
+22 SET Z=$SELECT(X=1:"A",X=2:"I",X=3:"T",X=4:"U",X=5:"D",X=6:"N",X=7:"L",X=8:"Z",1:"")
+23 IF Z=""
QUIT
+24 SET AMQQ("CMS STATUS",Z)=""
End DoDot:2
End DoDot:1
+25 QUIT
COHORT ;CREATE SEARCH TEMPLATE COHORT WITH REGISTER PATIENTS
+1 NEW X,Y,Z,AMQQDA
+2 DO C1
+3 IF $DATA(AMQQQUIT)
QUIT
+4 KILL ^DIBT(AMQQDA,1)
+5 SET X=0
+6 SET CTR=0
+7 FOR
SET X=$ORDER(^ACM(41,"B",AMQQRDA,X))
IF 'X
QUIT
Begin DoDot:1
+8 SET Z=$EXTRACT($GET(^ACM(41,X,"DT")))
+9 IF Z=""
QUIT
+10 SET Y=$PIECE($GET(^ACM(41,X,0)),U,2)
+11 IF 'Y
QUIT
+12 IF $GET(AMQQ("DM DIAGNOSIS"))]""
DO PATDX
IF $DATA(AMQQQUIT)
KILL AMQQQUIT
QUIT
+13 IF $DATA(AMQQ("CMS STATUS","Z"))!$DATA(AMQQ("CMS STATUS",Z))
Begin DoDot:2
+14 SET ^DIBT(AMQQDA,1,Y)=""
+15 WRITE "."
+16 SET CTR=CTR+1
End DoDot:2
End DoDot:1
+17 WRITE !!,"There are ",CTR," register patients for the combination selected.",!
+18 QUIT
C1 ;CREATE SEARCH TEMPLATE
+1 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+2 SET X=$EXTRACT(AMQQCNAM,1,25)_"-"_$JOB
+3 SET AMQQCHRT=X
+4 SET DIC="^DIBT("
+5 SET DIC(0)="L"
+6 IF $DATA(^DIBT("B",X))
SET Y=$ORDER(^DIBT("B",X,0))
IF Y
+7 IF '$TEST
DO FILE^DICN
+8 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+9 IF +Y<1
SET AMQQQUIT=""
QUIT
+10 SET AMQQDA=+Y
+11 SET $PIECE(^DIBT(+Y,0),U,2)=DT
+12 SET $PIECE(^DIBT(+Y,0),U,4)=2
+13 SET $PIECE(^DIBT(+Y,0),U,5)=DUZ
+14 SET ^UTILITY("AMQQ",$JOB,"Q",1)="40^COHORT^C^1^238^1^IS A MEMBER OF^'=^"_+Y_"^^0.00^^^0^"_+Y_";;^0"
+15 SET ^UTILITY("AMQQ",$JOB,"LIST",.1)="W ?3,@AMQQRV,""Subject of search: PATIENTS"",@AMQQNV"
+16 SET ^UTILITY("AMQQ",$JOB,"LIST",2)="W ?6,""MEMBER OF '"_AMQQCHRT_"' COHORT"""
+17 SET ^UTILITY("AMQQ",$JOB,"WEIGHT",-99,1)=""
+18 SET AMQQILIN=2
+19 SET AMQQNOET=""
+20 SET AMQQUATN=2
+21 SET AMQQUNB=1
+22 QUIT
NEWREG ;EP;TO CREATE REGISTER IN QMAN DICTIONARY OF TERMS
+1 IF $ORDER(^AMQQ(5,"B","REGISTER",0))
QUIT
+2 IF $DATA(^AMQQ(5,"B","CMS REGISTER"))
Begin DoDot:1
+3 SET DA=$ORDER(^AMQQ(5,"B","CMS REGISTER",0))
+4 IF 'DA
QUIT
+5 SET DIE="^AMQQ(5,"
+6 SET DR=".01///^S X=""REGISTER"""
+7 DO ^DIE
+8 SET Y=DA
+9 KILL ^AMQQ(5,DA,1)
+10 KILL DA,DR,DIE
+11 DO NR1
End DoDot:1
QUIT
+12 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+13 SET X="REGISTER"
+14 SET DIC="^AMQQ(5,"
+15 SET DIC(0)="L"
+16 SET DIC("DR")="3////52;4////40;10////P"
+17 DO FILE^DICN
+18 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
NR1 SET X="CMS REGISTER"
+1 SET DA(1)=+Y
+2 SET DIC="^AMQQ(5,"_+Y_",1,"
+3 SET DIC(0)="L"
+4 SET $PIECE(^AMQQ(5,+Y,1,0),U,2)="9009075.01"
+5 DO FILE^DICN
+6 KILL DIC,DA,DD,DR,DINUM,D,DLAYGO
+7 QUIT
DIC ;FM DIC INTERFACE
+1 IF $DATA(AMQQOUT)
QUIT
+2 KILL DTOUT,DUOUT,AMQQQUIT,AMQQOUT
+3 DO ^DIC
+4 IF +Y<1
SET AMQQQUIT=""
+5 IF $DATA(DUOUT)
SET AMQQQUIT=""
+6 IF $DATA(DTOUT)!(X="^^")
SET (AMQQQUIT,AMQQOUT)=""
+7 KILL DIC,DA,DD,DR,DINUM,D,DLAYGO
+8 QUIT
DX ;EP;TO SELECT DIABETES DIAGNOSIS
+1 IF $GET(AMQQCNAM)["PRE-DIAB"
GOTO PREDX
+2 WRITE !!,"Select the Diabetes Register Diagnosis for this report"
+3 SET DIR(0)="SO^1:Type 1;2:Type 2;3:Type 1 & Type 2;4:Gestational DM;5:Impaired Glucose Tolerance;6:All Diagnoses"
+4 SET DIR("A")="Which Register Diagnosis"
+5 SET DIR("B")="All Diagnoses"
+6 SET DIR("?",1)="Enter the appropriate REGISTER DIAGNOSIS term. This is NOT a POV's ICD code."
+7 SET DIR("?",2)="Qman will not find patients in which the REGISTER DIAGNOSIS field is null"
+8 SET DIR("?",3)=""
+9 SET DIR("?",4)="If Register Diagnoses have not been assigned to all patients"
+10 SET DIR("?",5)="in the Register or to all patients with a specific categories,"
+11 SET DIR("?")="use '6 - All Diagnoses' to avoid misleading results."
+12 DO ^DIR
+13 KILL DIR
+14 IF 'Y
SET AMQQQUIT=""
QUIT
+15 SET AMQQ("DM DIAGNOSIS")=$SELECT(Y=1:"TYPE 1",Y=2:"TYPE 2",Y=3:"TYPE 1 & TYPE 2",Y=4:"GESTATIONAL DM",Y=5:"IMPAIRED GLUCOSE TOLERANCE",1:"")
+16 QUIT
PREDX ;EP TO SELECT PREDIABETES REGISTER DIAGNOSIS
+1 WRITE !!,"Select the Diabetes Register Diagnosis for this report"
+2 SET DIR(0)="SO^1:IMP Fasting Glucose (IFG);2:IMP Glucose Tolerance (IGT);3:Metabolic Syndrome;4:Other Abnormal Glucose;5:All Diagnoses"
+3 SET DIR("A")="Which Register Diagnosis"
+4 SET DIR("B")="All Diagnoses"
+5 SET DIR("?",1)="Enter the appropriate REGISTER DIAGNOSIS term. This is NOT a POV's ICD code."
+6 SET DIR("?",2)="Qman will not find patients in which the REGISTER DIAGNOSIS field is null"
+7 SET DIR("?",3)=""
+8 SET DIR("?",4)="If Register Diagnoses have not been assigned to all patients"
+9 SET DIR("?",5)="in the Register or to all patients with a specific categories,"
+10 SET DIR("?")="use '5 - All Diagnoses' to avoid misleading results."
+11 DO ^DIR
+12 KILL DIR
+13 IF 'Y
SET AMQQQUIT=""
QUIT
+14 SET AMQQ("DM DIAGNOSIS")=$SELECT(Y=1:"IMP FASTING GLUCOSE (IFG)",Y=2:"IMP GLUCOSE TOLERANCE (IGT)",Y=3:"METABOLIC SYNDROME",Y=4:"OTHER ABNORMAL GLUCOSE",1:"")
+15 QUIT
PATDX ;INCLUDE PATIENTS WITH SPECIFIC DIAGNOSIS
+1 SET AMQQQUIT=""
+2 IF '$DATA(^ACM(44,"D",X))
QUIT
+3 NEW Y,Z
+4 SET Y=0
+5 FOR
SET Y=$ORDER(^ACM(44,"D",X,Y))
IF 'Y
QUIT
Begin DoDot:1
+6 SET Z=+$GET(^ACM(44,Y,0))
+7 IF $PIECE($GET(^ACM(44.1,+Z,0)),U)]""
IF AMQQ("DM DIAGNOSIS")[$PIECE(^(0),U)
KILL AMQQQUIT
End DoDot:1
+8 QUIT
