source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTSM81.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1RTSM81 ;PKE/ISC-ALBANY-Retirement Data Routine; ; 11/7/90 ;
2 ;;v 2.0;Record Tracking;;10/22/91
3ASK D DIP W !!,"Record Type Retirement Parameters:",!,"----------------------------------"
4DIE 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 ;
18Q K DIR,DIC,DE,DQ Q
19 ;
20START ;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
24DIP 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
26FLAG S RTAA=+RTAPL
27 S RTB=+RTFR
28 S RTA=+RTAPL
29 D DAT,TYP Q
30 ;
31DAT 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
35TYP 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
39SET ;
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
43BDAT S X2=-Y D DAT S X1=RTTM D C^%DTC S Y=X D D^DIQ W Y Q
44 ;
45HDR 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
49H1 W !!?5,"You may select a single terminal digit like `11'",!?8,"or a range of terminal digits like `5-30'"
50 Q
51H2 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
Note: See TracBrowser for help on using the repository browser.