ACMADDM ; IHS/TUCSON/TMJ - ADD DIABETES REGISTER ; 05 Feb 2006 11:39 AM
;;2.0;ACM CASE MANAGEMENT SYSTEM;**6**;JAN 10, 1996
;EP CALLED FROM AN OPTION
;This routine allows the user to convert an existing
;Diabetes Register, or add the IHS National Diabetes Register
;to the Case Management Package
;
W:$D(IOF) @IOF
I $D(^ACM(41.1,"B","IHS DIABETES")) W !,"You already have a register called 'IHS DIABETES'",!,"This option cannot be run!" Q
S DIR("A",1)=" IHS National Diabetes Register Installation"
S DIR("A",2)=" "
S DIR("A",3)="This option will quide you through the following:"
S DIR("A",4)=" 1 = Installing the IHS National Diabetes Register"
S DIR("A",5)=" if you curently are not using a Diabetes Register."
S DIR("A",6)=" 2 = Converting an existing Case Management-based register to the"
S DIR("A",7)=" IHS Diabetes Register, renaming your register and adding "
S DIR("A",8)=" diagnoses and complications included in the IHS standard."
S DIR("A",9)=" "
S DIR("A",10)="Answer NO if you have an existing Diabetes Register."
S DIR("A",11)="Answer YES if want the IHS National Diabetes Register installed."
S DIR("A",12)=" "
S DIR(0)="YO",DIR("A")="Shall I install the IHS National Register",DIR("B")="NO"
W !
S ACMQ=0 D ^DIR K DIR
S:Y["^" ACMQ=1 Q:ACMQ I Y=1 D ADDR
D:ACMQ END Q:ACMQ D CHGR
Q
ADDR ;ADDS IHS DIABETES REGISTER
S DIR(0)="YO",DIR("A")="Are you sure you want me to install the IHS National Register",DIR("B")="YES"
W !
D ^DIR K DIR
Q:Y=""!(Y["^") I Y=1 D REG^ACMRGA01 S ACMQ=1
Q
;
CHGR ;CHANGES EXISTING REGISTER AND ADDS ELEMENTS,DIAG,COMP
W:$D(IOF) @IOF
W !!!," Converting existing register to IHS National Diabetes Register",!
W !,"This option will quide you through the following:"
W !," 1 = Renaming your local register to the IHS National Diabetes Register"
W !," 2 = Adding elements, diagnoses, and complications included",!," in the IHS standard to your converted register."
W !!,"Enter the name of your existing local register you want converted: ",! S DIC(0)="AQEM" D RGTPX^ACMGTP
Q:+Y<1 S ACMRG=+Y,ACMRGNA=$P(Y,U,2),ACMQ=0
S DIR(0)="YO",DIR("A")="Shall I rename "_ACMRGNA_" to IHS DIABETES Register",DIR("B")="NO"
W !
D ^DIR K DIR
S:Y["^" ACMQ=1 Q:ACMQ I Y=1 D CHGN
D CHGE
Q:ACMQ D CHGD
Q:ACMQ D CHGC
Q:ACMQ D CDIAG^ACMADDM1
Q:ACMQ D CCOMP^ACMADDM1
W !,"Finished.." D END Q
;
CHGN ;RENAME REGISTER
S DIE="^ACM(41.1,",DA=ACMRG,ACMRGNA=$P(^ACM(41.1,DA,0),U,1),DR=".01///IHS DIABETES" D ^DIE K DA,DR
F ACMI=42,43,44,45,46,47,48,51,53,54 S ACMGREF="^ACM("_ACMI_")" S DA=0 F S DA=$O(@ACMGREF@("F",ACMRGNA,DA)) Q:'DA W "." S DIE="^ACM("_ACMI_",",DR=".05///^S X=""IHS DIABETES""" D ^DIE
K DIE,DIC,DA S ACMRGNA="IHS DIABETES"
S DIE="^ACM(41,",DR=".05///^S X=ACMRGNA",ACMX=0 F S ACMX=$O(^ACM(41,"B",ACMRG,ACMX)) Q:+ACMX=0 S DA=ACMX D ^DIE W "."
W !,"The register has been renamed to IHS DIABETES.." Q
;
CHGE S DIR(0)="YO",DIR("A")="Shall I check/add the proper elements to the register",DIR("B")="YES"
W ! D ^DIR K DIR S:Y["^" ACMQ=1 Q:Y=0!(Y["^") I Y=1 D SETE^ACMRGA01
Q
;
CHGD S DIR(0)="YO",DIR("A")="Shall I check/add the proper diagnoses to the register",DIR("B")="YES"
W ! D ^DIR K DIR S:Y["^" ACMQ=1 Q:Y=0!(Y["^") I Y=1 D SETD^ACMRGA01
Q
;
CHGC S DIR(0)="YO",DIR("A")="Shall I check/add the proper complications to the register",DIR("B")="YES"
W ! D ^DIR K DIR S:Y["^" ACMQ=1 Q:Y=0!(Y["^") I Y=1 D SETC^ACMRGA01
Q
;
END ;CLEANUP
K ACMRG,ACMRGNA,DA,DIC,DIE,DIR,DR
Q
;
XDX ;EP;TO ELIMINATE DUPLICATE DM DIAGNOSES.
N X,Y,DA,DIE,DR,DIK,ACMXX,ACMPDA,ACMPRIM
F ACMXX="TYPE 1","TYPE 2","GESTATIONAL DM","IMPAIRED GLUCOSE TOLERANCE" D XDX1
Q
XDX1 S ACMPRIM=0
S ACMPDA=0
F S ACMPDA=$O(^ACM(44.1,"B",ACMXX,ACMPDA)) Q:'ACMPDA D
.I $D(^ACM(44,"B",ACMPDA)),'$G(ACMPRIM) S ACMPRIM=ACMPDA Q
Q:'ACMPRIM
S ACMPDA=0
F S ACMPDA=$O(^ACM(44.1,"B",ACMXX,ACMPDA)) Q:'ACMPDA D
.W !!,"ACMXX: ",ACMXX," IEN: ",ACMPDA
.Q:ACMPDA=ACMPRIM
.S DA=0
.F S DA=$O(^ACM(44.3,"B",ACMPDA,DA)) Q:'DA D
..S DR=".01////"_ACMPRIM
..S DIE="^ACM(44.3,"
..D ^DIE
..W !,"Patient DX Intervention entry ",DA," Changed from ",ACMXX," IEN: ",ACMPDA," to ",ACMXX," IEN: ",ACMPRIM
.S DA=0
.F S DA=$O(^ACM(44,"B",ACMPDA,DA)) Q:'DA D
..S DR=".01////"_ACMPRIM
..S DIE="^ACM(44,"
..D ^DIE
..W !,"Patient DX entry ",DA," Changed from ",ACMXX," IEN: ",ACMPDA," to ",ACMXX," IEN: ",ACMPRIM
.S DA=ACMPDA
.S DIK="^ACM(44.1,"
.D ^DIK
.W !,"Diagnosis list entry for ",ACMXX,", IEN: ",DA," deleted."
Q
ACMADDM ; IHS/TUCSON/TMJ - ADD DIABETES REGISTER ; 05 Feb 2006 11:39 AM
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**6**;JAN 10, 1996
+2 ;EP CALLED FROM AN OPTION
+3 ;This routine allows the user to convert an existing
+4 ;Diabetes Register, or add the IHS National Diabetes Register
+5 ;to the Case Management Package
+6 ;
+7 IF $DATA(IOF)
WRITE @IOF
+8 IF $DATA(^ACM(41.1,"B","IHS DIABETES"))
WRITE !,"You already have a register called 'IHS DIABETES'",!,"This option cannot be run!"
QUIT
+9 SET DIR("A",1)=" IHS National Diabetes Register Installation"
+10 SET DIR("A",2)=" "
+11 SET DIR("A",3)="This option will quide you through the following:"
+12 SET DIR("A",4)=" 1 = Installing the IHS National Diabetes Register"
+13 SET DIR("A",5)=" if you curently are not using a Diabetes Register."
+14 SET DIR("A",6)=" 2 = Converting an existing Case Management-based register to the"
+15 SET DIR("A",7)=" IHS Diabetes Register, renaming your register and adding "
+16 SET DIR("A",8)=" diagnoses and complications included in the IHS standard."
+17 SET DIR("A",9)=" "
+18 SET DIR("A",10)="Answer NO if you have an existing Diabetes Register."
+19 SET DIR("A",11)="Answer YES if want the IHS National Diabetes Register installed."
+20 SET DIR("A",12)=" "
+21 SET DIR(0)="YO"
SET DIR("A")="Shall I install the IHS National Register"
SET DIR("B")="NO"
+22 WRITE !
+23 SET ACMQ=0
DO ^DIR
KILL DIR
+24 IF Y["^"
SET ACMQ=1
IF ACMQ
QUIT
IF Y=1
DO ADDR
+25 IF ACMQ
DO END
IF ACMQ
QUIT
DO CHGR
+26 QUIT
ADDR ;ADDS IHS DIABETES REGISTER
+1 SET DIR(0)="YO"
SET DIR("A")="Are you sure you want me to install the IHS National Register"
SET DIR("B")="YES"
+2 WRITE !
+3 DO ^DIR
KILL DIR
+4 IF Y=""!(Y["^")
QUIT
IF Y=1
DO REG^ACMRGA01
SET ACMQ=1
+5 QUIT
+6 ;
CHGR ;CHANGES EXISTING REGISTER AND ADDS ELEMENTS,DIAG,COMP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!!," Converting existing register to IHS National Diabetes Register",!
+3 WRITE !,"This option will quide you through the following:"
+4 WRITE !," 1 = Renaming your local register to the IHS National Diabetes Register"
+5 WRITE !," 2 = Adding elements, diagnoses, and complications included",!," in the IHS standard to your converted register."
+6 WRITE !!,"Enter the name of your existing local register you want converted: ",!
SET DIC(0)="AQEM"
DO RGTPX^ACMGTP
+7 IF +Y<1
QUIT
SET ACMRG=+Y
SET ACMRGNA=$PIECE(Y,U,2)
SET ACMQ=0
+8 SET DIR(0)="YO"
SET DIR("A")="Shall I rename "_ACMRGNA_" to IHS DIABETES Register"
SET DIR("B")="NO"
+9 WRITE !
+10 DO ^DIR
KILL DIR
+11 IF Y["^"
SET ACMQ=1
IF ACMQ
QUIT
IF Y=1
DO CHGN
+12 DO CHGE
+13 IF ACMQ
QUIT
DO CHGD
+14 IF ACMQ
QUIT
DO CHGC
+15 IF ACMQ
QUIT
DO CDIAG^ACMADDM1
+16 IF ACMQ
QUIT
DO CCOMP^ACMADDM1
+17 WRITE !,"Finished.."
DO END
QUIT
+18 ;
CHGN ;RENAME REGISTER
+1 SET DIE="^ACM(41.1,"
SET DA=ACMRG
SET ACMRGNA=$PIECE(^ACM(41.1,DA,0),U,1)
SET DR=".01///IHS DIABETES"
DO ^DIE
KILL DA,DR
+2 FOR ACMI=42,43,44,45,46,47,48,51,53,54
SET ACMGREF="^ACM("_ACMI_")"
SET DA=0
FOR
SET DA=$ORDER(@ACMGREF@("F",ACMRGNA,DA))
IF 'DA
QUIT
WRITE "."
SET DIE="^ACM("_ACMI_","
SET DR=".05///^S X=""IHS DIABETES"""
DO ^DIE
+3 KILL DIE,DIC,DA
SET ACMRGNA="IHS DIABETES"
+4 SET DIE="^ACM(41,"
SET DR=".05///^S X=ACMRGNA"
SET ACMX=0
FOR
SET ACMX=$ORDER(^ACM(41,"B",ACMRG,ACMX))
IF +ACMX=0
QUIT
SET DA=ACMX
DO ^DIE
WRITE "."
+5 WRITE !,"The register has been renamed to IHS DIABETES.."
QUIT
+6 ;
CHGE SET DIR(0)="YO"
SET DIR("A")="Shall I check/add the proper elements to the register"
SET DIR("B")="YES"
+1 WRITE !
DO ^DIR
KILL DIR
IF Y["^"
SET ACMQ=1
IF Y=0!(Y["^")
QUIT
IF Y=1
DO SETE^ACMRGA01
+2 QUIT
+3 ;
CHGD SET DIR(0)="YO"
SET DIR("A")="Shall I check/add the proper diagnoses to the register"
SET DIR("B")="YES"
+1 WRITE !
DO ^DIR
KILL DIR
IF Y["^"
SET ACMQ=1
IF Y=0!(Y["^")
QUIT
IF Y=1
DO SETD^ACMRGA01
+2 QUIT
+3 ;
CHGC SET DIR(0)="YO"
SET DIR("A")="Shall I check/add the proper complications to the register"
SET DIR("B")="YES"
+1 WRITE !
DO ^DIR
KILL DIR
IF Y["^"
SET ACMQ=1
IF Y=0!(Y["^")
QUIT
IF Y=1
DO SETC^ACMRGA01
+2 QUIT
+3 ;
END ;CLEANUP
+1 KILL ACMRG,ACMRGNA,DA,DIC,DIE,DIR,DR
+2 QUIT
+3 ;
XDX ;EP;TO ELIMINATE DUPLICATE DM DIAGNOSES.
+1 NEW X,Y,DA,DIE,DR,DIK,ACMXX,ACMPDA,ACMPRIM
+2 FOR ACMXX="TYPE 1","TYPE 2","GESTATIONAL DM","IMPAIRED GLUCOSE TOLERANCE"
DO XDX1
+3 QUIT
XDX1 SET ACMPRIM=0
+1 SET ACMPDA=0
+2 FOR
SET ACMPDA=$ORDER(^ACM(44.1,"B",ACMXX,ACMPDA))
IF 'ACMPDA
QUIT
Begin DoDot:1
+3 IF $DATA(^ACM(44,"B",ACMPDA))
IF '$GET(ACMPRIM)
SET ACMPRIM=ACMPDA
QUIT
End DoDot:1
+4 IF 'ACMPRIM
QUIT
+5 SET ACMPDA=0
+6 FOR
SET ACMPDA=$ORDER(^ACM(44.1,"B",ACMXX,ACMPDA))
IF 'ACMPDA
QUIT
Begin DoDot:1
+7 WRITE !!,"ACMXX: ",ACMXX," IEN: ",ACMPDA
+8 IF ACMPDA=ACMPRIM
QUIT
+9 SET DA=0
+10 FOR
SET DA=$ORDER(^ACM(44.3,"B",ACMPDA,DA))
IF 'DA
QUIT
Begin DoDot:2
+11 SET DR=".01////"_ACMPRIM
+12 SET DIE="^ACM(44.3,"
+13 DO ^DIE
+14 WRITE !,"Patient DX Intervention entry ",DA," Changed from ",ACMXX," IEN: ",ACMPDA," to ",ACMXX," IEN: ",ACMPRIM
End DoDot:2
+15 SET DA=0
+16 FOR
SET DA=$ORDER(^ACM(44,"B",ACMPDA,DA))
IF 'DA
QUIT
Begin DoDot:2
+17 SET DR=".01////"_ACMPRIM
+18 SET DIE="^ACM(44,"
+19 DO ^DIE
+20 WRITE !,"Patient DX entry ",DA," Changed from ",ACMXX," IEN: ",ACMPDA," to ",ACMXX," IEN: ",ACMPRIM
End DoDot:2
+21 SET DA=ACMPDA
+22 SET DIK="^ACM(44.1,"
+23 DO ^DIK
+24 WRITE !,"Diagnosis list entry for ",ACMXX,", IEN: ",DA," deleted."
End DoDot:1
+25 QUIT
