source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTP6.m@ 1608

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1RTP6 ;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 ;
4EN K ^TMP("RT F44",$J) S (RTPL,RTPLSAV)=X,RTPLNEW=$P(^SC(DA,0),U,1)
5 ;
6 D FIND,SET,EX Q
7 ;
8EX K RTN,RTM,RTPL,RTPLSAV,RTPLNEW,RTPLDAT Q
9 ;
10FIND 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
12SET 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
17UTL S ^TMP("RT F44",$J,RTM)=RTPL Q
18 ;
19KILL K ^RTV(194.2,"B",RTPL) Q
20 ;
21TST ;S ^TMP("RT F44",$J,"NEW",RTM)=RTPLDAT Q
22 ;
23W1 I RTN=1 W !,"Renameing Pull Lists in file 194.2",!,"." Q
24 E W "." Q
25 Q
26PULL 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
33RTDT 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
34PULLQ I '$D(RTPULL)!('$D(RTDT)) K RTPULL,RTDT,RTPULL0
35 K RTC Q
36UALL X ^%ZOSF("UPPERCASE")
37 S X=Y I X="ALL"!($E(X,1,4)="ALL ")!(X="ALL CLINIC LISTS") Q
38 Q
Note: See TracBrowser for help on using the repository browser.