Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACMADDM

ACMADDM.m

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