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

ACMADDP.m

Go to the documentation of this file.
  1. ACMADDP ; IHS/TUCSON/TMJ - ADD PRE-DIABETES REGISTER ; [ 11/01/05 3:21 PM ]
  1. ;;2.0;ACM CASE MANAGEMENT SYSTEM;*6*;JAN 10, 1996
  1. ;EP CALLED FROM AN OPTION
  1. ;IHS/CMI/TMJ PATCH #6 - INSTALL NEW PRE-DIABETES REGISTER
  1. ;This Driver routine allows the user to convert an existing
  1. ;Pre-Diabetes Register, or add the IHS National Pre-Diabetes Register
  1. ;to the Case Management Package
  1. ;DRIVER ROUTINE: ACMADDP
  1. ;CALLED ROUTINES: ACMRGA02 - ACMADDM2
  1. ;
  1. ;
  1. W:$D(IOF) @IOF
  1. I $D(^ACM(41.1,"B","IHS PRE-DIABETES")) W !,"You already have a register called 'IHS PRE-DIABETES'",!,"This option cannot be run!" D INFORM Q
  1. S DIR("A",1)=" IHS National Pre-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 Pre-Diabetes Register"
  1. S DIR("A",5)=" if you curently are not using a Pre-Diabetes Register."
  1. S DIR("A",6)=" 2 = Converting an existing Case Management-based register to the"
  1. S DIR("A",7)=" IHS Pre-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 Pre-Diabetes Register."
  1. S DIR("A",11)="Answer YES if want the IHS National Pre-Diabetes Register installed."
  1. S DIR("A",12)=" "
  1. S DIR(0)="YO",DIR("A")="Shall I install the IHS National Pre-Diabetes 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 PRE-DIABETES REGISTER
  1. S DIR(0)="YO",DIR("A")="Are you sure you want me to install the IHS National Pre-Diabetes Register",DIR("B")="YES"
  1. W !
  1. D ^DIR K DIR
  1. Q:Y=""!(Y["^") I Y=1 D REG^ACMRGA02 S ACMQ=1
  1. Q
  1. ;
  1. CHGR ;CHANGES EXISTING REGISTER AND ADDS ELEMENTS,DIAG,COMP,RISK,DXCRIT
  1. W:$D(IOF) @IOF
  1. W !!!," Converting existing register to IHS National Pre-Diabetes Register",!
  1. W !,"This option will quide you through the following:"
  1. W !," 1 = Renaming your local register to the IHS National Pre-Diabetes Register"
  1. W !," 2 = Adding elements, diagnoses, complications, Diagnostic Criteria, and Risk Factors 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. S ACMRG=$G(DA)
  1. I ACMRG="" W !,"No Register Selected" Q
  1. ;
  1. ;Q:+Y<1 S ACMRG=+Y,ACMRGNA=$P(Y,U,2),ACMQ=0
  1. S ACMRGNA=$P(^ACM(41.1,ACMRG,0),U,1)
  1. W ACMRGNA
  1. S DIR(0)="YO",DIR("A")="Shall I rename "_ACMRGNA_" to IHS PRE-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 CHGRF
  1. Q:ACMQ D CHGDC
  1. Q:ACMQ D CDIAG^ACMADDM2
  1. Q:ACMQ D CCOMP^ACMADDM2
  1. Q:ACMQ D CRISK^ACMADDM2
  1. Q:ACMQ D CDXCR^ACMADDM2
  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 PRE-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 PRE-DIABETES""" D ^DIE
  1. K DIE,DIC,DA S ACMRGNA="IHS PRE-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 PRE-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^ACMRGA02
  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^ACMRGA02
  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^ACMRGA02
  1. Q
  1. CHGRF S DIR(0)="YO",DIR("A")="Shall I check/add the proper Risk Factors to the register",DIR("B")="YES"
  1. W ! D ^DIR K DIR S:Y["^" ACMQ=1 Q:Y=0!(Y["^") I Y=1 D SETR^ACMRGA02
  1. Q
  1. ;
  1. CHGDC S DIR(0)="YO",DIR("A")="Shall I check/add the proper Diagnostic Criteria to the register",DIR("B")="YES"
  1. W ! D ^DIR K DIR S:Y["^" ACMQ=1 Q:Y=0!(Y["^") I Y=1 D SETDC^ACMRGA02
  1. Q
  1. ;
  1. INFORM ;Install Information Text
  1. ;
  1. W !!,"You must first re-name your existing Register called IHS PRE-DIABETES to",!
  1. W "OLD IHS PRE-DIABETES and then run the Install and convert the OLD Register",!
  1. W "to the new Register. Be sure to add any new Users to the new Register.",!
  1. Q
  1. END ;CLEANUP
  1. K ACMRG,ACMRGNA,DA,DIC,DIE,DIR,DR
  1. Q
  1. ;