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