[613] | 1 | RTP6 ;ISC-ALBANY/PKE-kill logic, xref on file 44,.01 ; 9/17/87 20:21 ;
|
---|
| 2 | ;;v 2.0;Record Tracking;;**13**;10/22/91
|
---|
| 3 | ;
|
---|
| 4 | EN K ^TMP("RT F44",$J) S (RTPL,RTPLSAV)=X,RTPLNEW=$P(^SC(DA,0),U,1)
|
---|
| 5 | ;
|
---|
| 6 | D FIND,SET,EX Q
|
---|
| 7 | ;
|
---|
| 8 | EX K RTN,RTM,RTPL,RTPLSAV,RTPLNEW,RTPLDAT Q
|
---|
| 9 | ;
|
---|
| 10 | FIND F RTN=1:1 S RTPL=$O(^RTV(194.2,"B",RTPL)) Q:$P(RTPL," [",1)]RTPLSAV Q:RTPL="" I $P(RTPL," [",1)=RTPLSAV F RTM=0:0 S RTM=$O(^RTV(194.2,"B",RTPL,RTM)) Q:'RTM D W1 D UTL,KILL
|
---|
| 11 | Q
|
---|
| 12 | SET Q:'$D(^TMP("RT F44",$J))
|
---|
| 13 | F RTM=0:0 S RTM=$O(^TMP("RT F44",$J,RTM)) Q:'RTM S RTPLDAT=^(RTM),RTPLDAT=RTPLNEW_$P(RTPLDAT,RTPLSAV,2) D TST S $P(^RTV(194.2,RTM,0),U)=RTPLDAT,^RTV(194.2,"B",RTPLDAT,RTM)=""
|
---|
| 14 | ;
|
---|
| 15 | I RTN>1 W !!,"Number of Pull Lists renamed = ",RTN-1,!!
|
---|
| 16 | Q
|
---|
| 17 | UTL S ^TMP("RT F44",$J,RTM)=RTPL Q
|
---|
| 18 | ;
|
---|
| 19 | KILL K ^RTV(194.2,"B",RTPL) Q
|
---|
| 20 | ;
|
---|
| 21 | TST ;S ^TMP("RT F44",$J,"NEW",RTM)=RTPLDAT Q
|
---|
| 22 | ;
|
---|
| 23 | W1 I RTN=1 W !,"Renameing Pull Lists in file 194.2",!,"." Q
|
---|
| 24 | E W "." Q
|
---|
| 25 | Q
|
---|
| 26 | PULL K RTPULL,RTPULL0,RTDT
|
---|
| 27 | W !!,"Select"_$S('$D(RTIRE):" Pull List: ALL CLINIC LISTS //",1:" a 'RR' Record Retirement Pull List: ") R X:DTIME G PULLQ:'$T!(X["^") S:X=""&('$D(RTIRE)) X="ALL" D UALL I $T S RTPULL="ALL" G RTDT
|
---|
| 28 | G PULLQ:X=""
|
---|
| 29 | S DIC="^RTV(194.2,",DIC(0)="ZEMQI"
|
---|
| 30 | S DIC("S")="I $P(^(0),U,12)="_RTDV_",$P(^(0),U,15)="_+RTAPL_",$P(^(0),U,10)"_$S('$D(RTIRE):"'=3",1:"=3")
|
---|
| 31 | D ^DIC K DIC G PULL:Y<0 S RTPULL=+Y,RTPULL0=Y(0),RTDT=$P($P(Y(0),"^",2),".")
|
---|
| 32 | I $P(Y(0),"^",6)="x" W !!,*7,"This pull list was cancelled by ",$S($D(^VA(200,+$P(Y(0),"^",8),0)):$P(^(0),"^"),1:"UNKNOWN")," on " S Y=$P(Y(0),"^",7) D DT^DIQ W "." G PULL
|
---|
| 33 | RTDT W ! I '$D(RTDT) S %DT="EAFX",%DT("A")="Select Date: " D ^%DT K %DT I Y>0 S RTDT=Y D SHOW^RTP41 I 'RTC K RTDT G RTDT
|
---|
| 34 | PULLQ I '$D(RTPULL)!('$D(RTDT)) K RTPULL,RTDT,RTPULL0
|
---|
| 35 | K RTC Q
|
---|
| 36 | UALL X ^%ZOSF("UPPERCASE")
|
---|
| 37 | S X=Y I X="ALL"!($E(X,1,4)="ALL ")!(X="ALL CLINIC LISTS") Q
|
---|
| 38 | Q
|
---|