source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTT12.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1RTT12 ;ISC-ALBANY/PKE-repoint request to new record ; 12/30/02 12:28pm
2 ;;2.0;Record Tracking;**31**;10/22/91
3 D EN K X,P,Z,RDT,RTV0,RTWND Q
4 ;
5EN I '$D(RT)!('$D(RTPAR))!('RT)!('RTPAR) Q
6 S RTRD(1)="Yes^transfer Requests to Record/Volume "_RTVOL
7 S RTRD(2)="No^not change the Record/Volume(s) Requested."
8 S:'$D(RTRD("A")) RTRD("A")="Pending Requests can be transferred to last Record/Volume just created. "_$C(13,10)_" Transfer Requests to volume '"_RTVOL_"' ? "
9 S RTRD(0)="S",RTRD("B")=2 D SET^RTRD K RTRD S X=$E(X) S:X["^" RTESC="" I X'="Y" Q
10 ;get pend cut
11 Q:'$D(RTTY) D PND^RTRPT Q:'$D(RTWND(+RTTY))
12 ;get requests
13GET ;
14 N RTCNT
15 F RTV0=0:0 S RTV0=$O(^RT("P",RTPAR,RTV0)) Q:'RTV0 I RTV0'=RT D FIND
16 S RTV0=RTPAR Q:RTV0=RT
17 ;z=da
18FIND F Z=0:0 S Z=$O(^RTV(190.1,"B",RTV0,Z)) Q:'Z D REC L -^RTV(190.1,Z)
19 QUIT
20 ;
21REC I $D(^RTV(190.1,Z,0)),$D(^RT(+^RTV(190.1,Z,0))) L +^RTV(190.1,Z):1 I '$T G REC
22 N RTMVMNT0
23 I '$D(^RTV(190.1,Z,0))!('$D(^RT(+^RTV(190.1,Z,0)))) L -^RTV(190.1,Z) Q
24 ;only requests,pending
25 S RTMVMNT0=^RTV(190.1,Z,0) ;zero node of the entry in 190.1
26 S RDT=+$P(RTMVMNT0,U,4) Q:'RDT I $P(RDT,".")<RTWND(+RTTY) Q
27 I $P(RTMVMNT0,U,6)'="r" D Q
28 . S RTCNT=$G(RTCNT)+1
29 . I $G(RTCNT)=1 W !!,"The following request(s) cannot be transferred due to Request Status:"
30 . W !?2,"Request for "_$E($$EXTRNL(4,4),1,12)_" for "_$E($$EXTRNL(5,5),1,25)_" - Status is "_$$EXTRNL(6,6)
31 S $P(^RTV(190.1,Z,0),"^",1)=RT,^RTV(190.1,"B",RT,Z)="" K ^RTV(190.1,"B",RTV0,Z) ;W " ." R X:0
32 ;date/time needed
33DAT I RDT,$D(^RTV(190.1,"AC",RTV0,$P(RDT,"."),Z)) S ^RTV(190.1,"AC",RT,$P(RDT,"."),Z)="" K ^RTV(190.1,"AC",RTV0,$P(RDT,"."),Z)
34 ;
35 ;pull list
36PUL S P=+$P(^RTV(190.1,Z,0),"^",10)
37 I P,$D(^RTV(190.1,"AP1",P,RTV0,Z)) S ^RTV(190.1,"AP1",P,RT,Z)="" K ^RTV(190.1,"AP1",P,RTV0,Z)
38 L -^RTV(190.1,Z) Q
39EXTRNL(RTPIECE,RTFIELD) ;get external values for fields to be displayed
40 ; RTPIECE is piece of zero node, 190.1
41 ; RTFIELD is FM field number
42 S Y=$P(RTMVMNT0,U,RTPIECE)
43 S C=$P(^DD(190.1,RTFIELD,0),U,2)
44 D Y^DIQ
45 Q Y
Note: See TracBrowser for help on using the repository browser.