- 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 ;
