| [613] | 1 | RTSM81 ;PKE/ISC-ALBANY-Retirement Data Routine; ; 11/7/90 ;
|
|---|
| 2 | ;;v 2.0;Record Tracking;;10/22/91
|
|---|
| 3 | ASK D DIP W !!,"Record Type Retirement Parameters:",!,"----------------------------------"
|
|---|
| 4 | DIE S DIC("A")="Select RECORD TYPE: ",DIC="^DIC(195.2,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,3)=+RTAPL" D ^DIC K DIC G Q:X="^" I Y>0 S DA=+Y,DR="[RT RETIREMENT PROFILE]",DIE="^DIC(195.2," D ^DIE K DE,DQ W ! G DIE
|
|---|
| 5 | W !!,"Overall Retirement Parameters:",!,"------------------------------" S DA=+RTAPL,DR="25",DIE="^DIC(195.1," D ^DIE K DE,DQ G Q:$D(Y)
|
|---|
| 6 | S X=^DIC(195.1,+RTAPL,2) I $P(X,"^",5)'="y" W !!?5,*7,"No records will be retired!" K RTERM Q
|
|---|
| 7 | ;
|
|---|
| 8 | W ! S DIR(0)="YO",DIR("B")="NO",DIR("A")=" Is it ok to continue"
|
|---|
| 9 | S DIR("?")=" Enter 'Y' to continue"
|
|---|
| 10 | D ^DIR I $D(DUOUT)!($D(DTOUT))!('Y) K DIR Q
|
|---|
| 11 | W ! S DIR(0)="YO",DIR("B")="YES",DIR("A")="Use terminal digit scan"
|
|---|
| 12 | S DIR("?")="^D H2^RTSM81"
|
|---|
| 13 | D ^DIR I $D(DUOUT)!($D(DTOUT)) K DIR Q
|
|---|
| 14 | S RTERM="" I 'Y S RTERM="NO" W !!," 'Record Retirement Pull lists' will be generated by",!," searching all Records for ",$P($P(RTAPL,"^"),";",2) Q
|
|---|
| 15 | ;
|
|---|
| 16 | W !!," 'Record Retirement Pull lists' will be generated using",!," terminal digits to select a range of Records " Q
|
|---|
| 17 | ;
|
|---|
| 18 | Q K DIR,DIC,DE,DQ Q
|
|---|
| 19 | ;
|
|---|
| 20 | START ;K RTFLAGS,RTT S (RTLSTQ,RTLSTP)=0 F I=10,8,12 S $P(RTFLAGS,"^",I)=$P(^DIC(195.4,1,0),"^",I)="y"
|
|---|
| 21 | ;
|
|---|
| 22 | ;F RTYPE=0:0 S RTYPE=$O(^DIC(195.2,RTYPE)) Q:'RTYPE I $D(^(RTYPE,0)) S RTYPE0=^(0) D SET:$P(RTYPE0,"^",18)="y"
|
|---|
| 23 | ;Q
|
|---|
| 24 | DIP W !!?5,"...compiling retirement profile" S IOP="HOME",DIC="^DIC(195.2,",(BY,FLDS)="[RT RETIREMENT PROFILE]",L=0,DIS(0)="I $P(^DIC(195.2,D0,0),U,3)=+RTAPL" K DTOUT D EN1^DIP K DIC,FLDS,BY,L,TO,FR,IOP Q
|
|---|
| 25 | Q
|
|---|
| 26 | FLAG S RTAA=+RTAPL
|
|---|
| 27 | S RTB=+RTFR
|
|---|
| 28 | S RTA=+RTAPL
|
|---|
| 29 | D DAT,TYP Q
|
|---|
| 30 | ;
|
|---|
| 31 | DAT D NOW^%DTC S %I(1)=%I(1)+1 I %I(1)>12 S %I(1)=1,%I(3)=%I(3)+1
|
|---|
| 32 | S X=$S(%I(1)?1N:"0"_%I(1),1:%I(1))_"01"_$E(%I(3),2,3),%DT="F" D ^%DT
|
|---|
| 33 | K %DT,%I S RTTM=$E(Y,1,5)_"01",RTTMM="["_$E(Y,4,5)_"/01/"_$E(Y,2,3)_"]"
|
|---|
| 34 | Q
|
|---|
| 35 | TYP S RTLSTM=0 F RTYPE=0:0 S RTYPE=$O(^DIC(195.2,RTYPE)) Q:'RTYPE I $D(^(RTYPE,0)) S RTYPE0=^(0) I $P(RTYPE0,"^",3)=+RTAPL S RTFLAG(RTYPE)=0 I $D(^(1)) D SET:$P(^(1),"^",2)="y"
|
|---|
| 36 | K RTYPE,RTYPE0
|
|---|
| 37 | Q
|
|---|
| 38 | ;determine from the 1st of next month, rttm
|
|---|
| 39 | SET ;
|
|---|
| 40 | S X1=RTTM,X2=-$S($P(RTYPE0,"^",19):$P(RTYPE0,"^",19),1:"") D C^%DTC S RTFLAG(RTYPE)=X S:RTLSTM'>X RTLSTM=X Q
|
|---|
| 41 | ;S Y=X D D^DIQ S RTFLAGS(RTYPE)=$J($P(RTYPE0,"^",2)_" Cutoff = "_Y,26)
|
|---|
| 42 | Q
|
|---|
| 43 | BDAT S X2=-Y D DAT S X1=RTTM D C^%DTC S Y=X D D^DIQ W Y Q
|
|---|
| 44 | ;
|
|---|
| 45 | HDR W:$E(IOST,1,2)'="C-" @IOF W !?5,"Generating ",RTDESC,!!
|
|---|
| 46 | ;W !?5 F N=0:0 S N=$O(RTFLAGS(N)) Q:'N W:$X>55 !?5 W RTFLAGS(N)," "
|
|---|
| 47 | ;W !! K RTFLAGS Q
|
|---|
| 48 | Q
|
|---|
| 49 | H1 W !!?5,"You may select a single terminal digit like `11'",!?8,"or a range of terminal digits like `5-30'"
|
|---|
| 50 | Q
|
|---|
| 51 | H2 W !!?5,"Enter 'Y' to look for inactive records by terminal digit"
|
|---|
| 52 | W !?5,"Enter 'N' to look for inactive records by record number" Q
|
|---|
