- 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
