- ACMOPTDM ; IHS/TUCSON/TMJ - CREATES OPTION FOR DIABETES REG INSTALL ;
- ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
- ;;CREATES THE NATIONAL IHS DIABETES INSTALL OPTION
- ;;ADDS THE OPTION TO THE ACMMENU OPTION
- ;
- W:$D(IOF) @IOF
- I '$D(DUZ) W !,"You MUST log in as an user before running this routine..." Q
- I '$D(^DIC(19,"B","ACMMENU")) W !,"You do not have an option called 'ACM MANAGER UTILITIES'",!,"This option cannot be installed!" Q
- I $D(^DIC(19,"B","ACM INSTALL IHS DIABETES REGIS")) W !,"You already have an option called 'ACM INSTALL IHS DIABETES REGISTER'",!,"This option cannot be installed!" Q
- S DIR("A",1)=" IHS National Diabetes Register Menu Installation"
- S DIR("A",2)=" "
- S DIR("A",3)="This option will install the following:"
- S DIR("A",4)=" 1 = Install the Menu Option 'ACM INSTALL IHS DIABETES REGISTER'"
- S DIR("A",5)=" 2 = Assign the 'ACMZ MANAGER' security key to the option."
- S DIR("A",6)=" 3 = Add the option to the 'ACMMENU' option."
- S DIR("A",7)=" "
- S DIR("A",9)="Answer YES if want the ACM Menu Options installed."
- S DIR("A",10)=" "
- S DIR(0)="YO",DIR("A")="Shall I install the option",DIR("B")="NO"
- W ! D ^DIR K DIR I Y=1 D ADDOPT
- K ACMM,ACMRG,ACMY,ACMF,ACMX
- Q
- ADDOPT ;ADDS IHS DIABETES REGISTER OPTION
- S ACMRG=$T(ACMOPT+1),ACMRG=$P(ACMRG,";;",3)
- W !!,"Option: ",ACMRG," is being added...",!!
- S X=ACMRG,DIC="^DIC(19,",DIC(0)="LX" K DD,DA D FILE^DICN Q:+Y<1 S ACMRG=+Y K DIC,DA,DD
- F I=2:1 S ACMF=$T(ACMOPT+I) Q:ACMF["*" S ACMF($P(ACMF,";;",2))=$P(ACMF,";;",3)
- S ACMX=0 F S ACMX=$O(ACMF(ACMX)) Q:ACMX="" S ACMY=0,ACMY=$O(^DD(19,"B",ACMX,ACMY)) I +ACMY S $P(ACMF(ACMX),U,2)=+ACMY
- S (DR,ACMX)="" F S ACMX=$O(ACMF(ACMX)) Q:ACMX="" S ACMY=ACMF(ACMX) I $L($P(ACMY,U,1))&(+$P(ACMY,U,2)) S DR=DR_$P(ACMY,U,2)_"///"_$P(ACMY,U,1)_";"
- I $L(DR) S DR=$E(DR,1,$L(DR)-1)
- S DA=ACMRG,DIE="^DIC(19," D ^DIE S $P(^ACM(41.1,ACMRG,0),U,12)=1 K DIC,DIE,DA,DR
- ;
- S ACMM=ACMRG,ACMRG=$T(ACMMENU+1),ACMRG=$P(ACMRG,";;",3)
- W !!,"Option is being added to ",ACMRG,"...",!!
- S X=ACMRG,DIC="^DIC(19,",DIC(0)="L" D ^DIC Q:+Y<1 S ACMRG=+Y K DIC,DA,DD
- K DD,DO S X=ACMM,DIC="^DIC(19,"_ACMRG_",10,",DIC(0)="LX",DA(1)=ACMRG D FILE^DICN K DIC,DA,DD
- W !!,"Finished...",!!
- END K ACMM,ACMRG,ACMY,ACMF,ACMX,ACMQ
- Q
- ACMOPT ;;
- ;;NAME;;ACM INSTALL IHS DIABETES REGIS
- ;;MENU TEXT;;Install IHS Diabetes Register
- ;;LOCK;;ACMZ MANAGER
- ;;CREATOR;;POSTMASTER
- ;;TYPE;;R
- ;;PACKAGE;;ACM CASE MANAGEMENT SYSTEM
- ;;ROUTINE;;ACMADDM
- ;;*
- ;;NAME;;ACMMENU
- ;;*
- ACMOPTDM ; IHS/TUCSON/TMJ - CREATES OPTION FOR DIABETES REG INSTALL ;
- +1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
- +2 ;;CREATES THE NATIONAL IHS DIABETES INSTALL OPTION
- +3 ;;ADDS THE OPTION TO THE ACMMENU OPTION
- +4 ;
- +5 IF $DATA(IOF)
- WRITE @IOF
- +6 IF '$DATA(DUZ)
- WRITE !,"You MUST log in as an user before running this routine..."
- QUIT
- +7 IF '$DATA(^DIC(19,"B","ACMMENU"))
- WRITE !,"You do not have an option called 'ACM MANAGER UTILITIES'",!,"This option cannot be installed!"
- QUIT
- +8 IF $DATA(^DIC(19,"B","ACM INSTALL IHS DIABETES REGIS"))
- WRITE !,"You already have an option called 'ACM INSTALL IHS DIABETES REGISTER'",!,"This option cannot be installed!"
- QUIT
- +9 SET DIR("A",1)=" IHS National Diabetes Register Menu Installation"
- +10 SET DIR("A",2)=" "
- +11 SET DIR("A",3)="This option will install the following:"
- +12 SET DIR("A",4)=" 1 = Install the Menu Option 'ACM INSTALL IHS DIABETES REGISTER'"
- +13 SET DIR("A",5)=" 2 = Assign the 'ACMZ MANAGER' security key to the option."
- +14 SET DIR("A",6)=" 3 = Add the option to the 'ACMMENU' option."
- +15 SET DIR("A",7)=" "
- +16 SET DIR("A",9)="Answer YES if want the ACM Menu Options installed."
- +17 SET DIR("A",10)=" "
- +18 SET DIR(0)="YO"
- SET DIR("A")="Shall I install the option"
- SET DIR("B")="NO"
- +19 WRITE !
- DO ^DIR
- KILL DIR
- IF Y=1
- DO ADDOPT
- +20 KILL ACMM,ACMRG,ACMY,ACMF,ACMX
- +21 QUIT
- ADDOPT ;ADDS IHS DIABETES REGISTER OPTION
- +1 SET ACMRG=$TEXT(ACMOPT+1)
- SET ACMRG=$PIECE(ACMRG,";;",3)
- +2 WRITE !!,"Option: ",ACMRG," is being added...",!!
- +3 SET X=ACMRG
- SET DIC="^DIC(19,"
- SET DIC(0)="LX"
- KILL DD,DA
- DO FILE^DICN
- IF +Y<1
- QUIT
- SET ACMRG=+Y
- KILL DIC,DA,DD
- +4 FOR I=2:1
- SET ACMF=$TEXT(ACMOPT+I)
- IF ACMF["*"
- QUIT
- SET ACMF($PIECE(ACMF,";;",2))=$PIECE(ACMF,";;",3)
- +5 SET ACMX=0
- FOR
- SET ACMX=$ORDER(ACMF(ACMX))
- IF ACMX=""
- QUIT
- SET ACMY=0
- SET ACMY=$ORDER(^DD(19,"B",ACMX,ACMY))
- IF +ACMY
- SET $PIECE(ACMF(ACMX),U,2)=+ACMY
- +6 SET (DR,ACMX)=""
- FOR
- SET ACMX=$ORDER(ACMF(ACMX))
- IF ACMX=""
- QUIT
- SET ACMY=ACMF(ACMX)
- IF $LENGTH($PIECE(ACMY,U,1))&(+$PIECE(ACMY,U,2))
- SET DR=DR_$PIECE(ACMY,U,2)_"///"_$PIECE(ACMY,U,1)_";"
- +7 IF $LENGTH(DR)
- SET DR=$EXTRACT(DR,1,$LENGTH(DR)-1)
- +8 SET DA=ACMRG
- SET DIE="^DIC(19,"
- DO ^DIE
- SET $PIECE(^ACM(41.1,ACMRG,0),U,12)=1
- KILL DIC,DIE,DA,DR
- +9 ;
- +1 SET ACMM=ACMRG
- SET ACMRG=$TEXT(ACMMENU+1)
- SET ACMRG=$PIECE(ACMRG,";;",3)
- +2 WRITE !!,"Option is being added to ",ACMRG,"...",!!
- +3 SET X=ACMRG
- SET DIC="^DIC(19,"
- SET DIC(0)="L"
- DO ^DIC
- IF +Y<1
- QUIT
- SET ACMRG=+Y
- KILL DIC,DA,DD
- +4 KILL DD,DO
- SET X=ACMM
- SET DIC="^DIC(19,"_ACMRG_",10,"
- SET DIC(0)="LX"
- SET DA(1)=ACMRG
- DO FILE^DICN
- KILL DIC,DA,DD
- +5 WRITE !!,"Finished...",!!
- END KILL ACMM,ACMRG,ACMY,ACMF,ACMX,ACMQ
- +1 QUIT
- ACMOPT ;;
- +1 ;;NAME;;ACM INSTALL IHS DIABETES REGIS
- +2 ;;MENU TEXT;;Install IHS Diabetes Register
- +3 ;;LOCK;;ACMZ MANAGER
- +4 ;;CREATOR;;POSTMASTER
- +5 ;;TYPE;;R
- +6 ;;PACKAGE;;ACM CASE MANAGEMENT SYSTEM
- +7 ;;ROUTINE;;ACMADDM
- +8 ;;*
- +1 ;;NAME;;ACMMENU
- +2 ;;*