AMERBSET.m

AMERBSET ; IHS/ANMC/GIS - MAKES AGE BIN STRING ; 

 ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009

 ;

SETBIN S ^TMP("AMERAGE",$J)="0:1;2:4;5:12;13:19;20:39;40:59;60:79;80:199"

 I $D(^AMER("AGE")) S ^TMP("AMERAGE",$J)=^AMER("AGE")

 D LIST

 S DIR(0)="YO",DIR("A")="Is this OK",DIR("B")="YES",DIR("?")="" D ^DIR K DIR

 D OUT^AMEROUT I $D(AMERQUIT) Q

 I "yY"[$E(X) Q

RUN S %="",A=-1 W !!! F L=0:0 D AGE Q:X=""  I $D(AMERQUIT) G EXIT

 D CLOSE I $D(AMERQUIT) G EXIT

 D LIST

EXIT K X,Y,Z,%,I,L,A

 Q

 ;

AGE ;

 S DIR(0)="N",DIR("A")="Enter the starting age of the "_$S(%="":"first",1:"next")_" age group: "

 D ^DIR S X=Y I '$T S X=U K DIR

 I X=U S AMERQUIT="" Q

 I X="" Q

 I X?1."?" D HELP G AGE

 I X?1.3N,X>A D SET Q

 W "  ??",*7 G AGE

 ;

SET S A=X

 I %="" S %=X Q

 S %=%_":"_(X-1)_";"_X

 Q

 ;

CLOSE I %="" Q

GC ;

 S DIR(0)="N",DIR("A")="Enter the highest age for the last group: "

 D ^DIR S X=Y I '$T S X=U K DIR

 I X=U S AMERQUIT="" Q

 I X?1."?" D HELP G GC

 I X="" S X=199

 I X?1.3N,X'<A S %=%_":"_X,^TMP("AMERAGE",$J)=% Q

 W "  ??",*7 G GC

 ;

HELP Q

 ;

LIST W !!,"CURRENT AGE GROUPS =>",!

 S %=^TMP("AMERAGE",$J)

 F I=1:1 S X=$P(%,";",I) Q:X=""  W !,$P(X,":")," - ",$P(X,":",2)

 W !!

 Q

AMERBSET  ; IHS/ANMC/GIS - MAKES AGE BIN STRING ; 

 +1       ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009

 +2       ;

SETBIN     SET ^TMP("AMERAGE",$JOB)="0:1;2:4;5:12;13:19;20:39;40:59;60:79;80:199"

 +1        IF $DATA(^AMER("AGE"))

               SET ^TMP("AMERAGE",$JOB)=^AMER("AGE")

 +2        DO LIST

 +3        SET DIR(0)="YO"

           SET DIR("A")="Is this OK"

           SET DIR("B")="YES"

           SET DIR("?")=""

           DO ^DIR

           KILL DIR

 +4        DO OUT^AMEROUT

           IF $DATA(AMERQUIT)

               QUIT 

 +5        IF "yY"[$EXTRACT(X)

               QUIT 

RUN        SET %=""

           SET A=-1

           WRITE !!!

           FOR L=0:0

               DO AGE

               IF X=""

                   QUIT 

               IF $DATA(AMERQUIT)

                   GOTO EXIT

 +1        DO CLOSE

           IF $DATA(AMERQUIT)

               GOTO EXIT

 +2        DO LIST

EXIT       KILL X,Y,Z,%,I,L,A

 +1        QUIT 

 +2       ;

AGE       ;

 +1        SET DIR(0)="N"

           SET DIR("A")="Enter the starting age of the "_$SELECT(%="":"first",1:"next")_" age group: "

 +2        DO ^DIR

           SET X=Y

           IF '$TEST

               SET X=U

               KILL DIR

 +3        IF X=U

               SET AMERQUIT=""

               QUIT 

 +4        IF X=""

               QUIT 

 +5        IF X?1."?"

               DO HELP

               GOTO AGE

 +6        IF X?1.3N

               IF X>A

                   DO SET

                   QUIT 

 +7        WRITE "  ??",*7

           GOTO AGE

 +8       ;

SET        SET A=X

 +1        IF %=""

               SET %=X

               QUIT 

 +2        SET %=%_":"_(X-1)_";"_X

 +3        QUIT 

 +4       ;

CLOSE      IF %=""

               QUIT 

GC        ;

 +1        SET DIR(0)="N"

           SET DIR("A")="Enter the highest age for the last group: "

 +2        DO ^DIR

           SET X=Y

           IF '$TEST

               SET X=U

               KILL DIR

 +3        IF X=U

               SET AMERQUIT=""

               QUIT 

 +4        IF X?1."?"

               DO HELP

               GOTO GC

 +5        IF X=""

               SET X=199

 +6        IF X?1.3N

               IF X'<A

                   SET %=%_":"_X

                   SET ^TMP("AMERAGE",$JOB)=%

                   QUIT 

 +7        WRITE "  ??",*7

           GOTO GC

 +8       ;

HELP       QUIT 

 +1       ;

LIST       WRITE !!,"CURRENT AGE GROUPS =>",!

 +1        SET %=^TMP("AMERAGE",$JOB)

 +2        FOR I=1:1

               SET X=$PIECE(%,";",I)

               IF X=""

                   QUIT 

               WRITE !,$PIECE(X,":")," - ",$PIECE(X,":",2)

 +3        WRITE !!

 +4        QUIT