- 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
