source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTQ1.m@ 1476

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1RTQ1 ;MJK/TROY ISC;Record Request Option; ; 1/30/87 10:11 AM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3MISS S RTASK=""
4MISS1 G MISSQ:'$D(^RT(RT,"CL")),MISSQ:$S('$D(^RTV(195.9,+$P(^("CL"),"^",5),0)):1,$P(^(0),"^")'="2;DIC(195.4,":1,1:0)
5 D DEMOS^RTUTL1,LINE^RTUTL3 W *7,!,RTD("N"),"'s ",RTD("T"),"is flagged as 'MISSING'" I '$D(RTASK) D NOASK G MISSQ
6 K Y S RTRD(1)="Yes^request record",RTRD(2)="No^do not request record",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Do you still want to request this record? " D SET^RTRD K RTRD K:$E(X)'="Y" RT D LINE^RTUTL3
7MISSQ K RTASK Q
8 ;
9NOASK ;
10 W !?5,"* no processing allowed on the record until flag is removed"
11 I $D(^DIC(195.2,+$P(^RT(RT,0),"^",3),0)),$P(^(0),"^",7)'="a",'$D(^XUSEC($S($P(RTAPL,"^",8)]"":$P(RTAPL,"^",8),1:"RTZ XXX"),DUZ)) W !?5,"* please notify the file room if you have found this record"
12 D LINE^RTUTL3 K RTD,RT Q
13 ;
14CANCEL Q:'$D(^RTV(190.1,RTQ,0))!($P(^(0),"^",6)'="x")
15 D DEMOS^RTUTL1,LINE^RTUTL3 S X=^RTV(190.1,RTQ,0) W !,"The request (#",RTQ,") for ",RTD("N"),"'s ",RTD("T"),!?10,"was cancelled by ",$S($D(^VA(200,+$P(X,"^",8),0)):$P(^(0),"^"),1:"UNKNOWN")," on " S Y=$P(X,"^",7)
16 D DT^DIQ:Y W "." D LINE^RTUTL3 K X,Y,RTD,RTQ Q
17 ;
18TEST ;This entry point is used by the input transform for the REQUESTOR and
19 ;DATE/TIME RECORD NEEDED fields of the REQUESTED RECORDS(190.1) file.
20 ;
21 S RTZ1="X^RTQ^RTQDT^RT^RTB" D SAVE^RTUTL1 S RT=+^RTV(190.1,DA,0),RTQDT=$S(RTX="RTQDT":X,1:+$P($P(^(0),"^",4),".")),RTB=$S(RTX="RTB":X,1:$P(^(0),"^",5))
22 K RTFL F RTCHK=1:1:2 S X=RTZ("X") D @("CHK"_RTCHK) Q:$D(RTFL)
23 ;This next line is from the edit request templ. if users ^out of this check. RTFL1 only set by template.
24 K RTCHK,RTQ,RTQDT,RT,RTB D RESTORE^RTUTL1
25 I $D(RTFL),$D(RTFL1) S X=RTFL1
26 Q
27 ;
28CHK1 ;check for if the borrower already has a request pending for the
29 ;record on the same day as the current request
30 ;
31 F RTQ=0:0 S RTQ=$O(^RTV(190.1,"AC",RT,+$P(RTQDT,"."),RTQ)) Q:'RTQ I RTQ'=DA,$D(^RTV(190.1,RTQ,0)),$P(^(0),"^",6)="r",$P(^(0),"^",5)=RTB,$S('$D(RTPULL):1,$P(^(0),"^",10)=RTPULL:1,1:0) S Y=^(0) K X Q
32 Q:$D(X) D LINE^RTUTL3
33 W !,*7,"Borrower already has a request pending for this record on this date:",!?5,"User Requesting Record : ",$S($D(^VA(200,+$P(Y,"^",3),0)):$P(^(0),"^"),1:"UNKNOWN"),!?5,"Date Request was Filed : " S Y=$P(Y,"^",2) D D^DIQ W Y
34 S Y=$P(^RTV(190.1,RTQ,0),"^",4) D D^DIQ W !?5,"Record Request Number : ",RTQ,!?5,"Date/Time Record Needed: ",Y D LINE^RTUTL3,ASK Q
35 ;
36CHK2 ;check to see if the REQUESTOR is the CURRENT BORROWER
37 ;if so, then checks to see if the request is too soon. If too soon, then
38 ;does not allow request. Otherwise, user is asked if they still want
39 ;to make the request.
40 ;
41 Q:$S('$D(^RT(RT,"CL")):1,$P(^("CL"),"^",5)'=RTB:1,1:0) S X=RTQDT D H^RTUTL3 Q:X<0
42 S Y=$H,Y1=+$P(Y,",")*24*3600,Y1=Y1+$P(Y,",",2),X1=+$P(X,",")*24*3600,X1=X1+$P(X,",",2),Y=X1-Y1
43 I Y<$S('$D(^RT(RT,0)):7200,'$D(^DIC(195.2,+$P(^(0),"^",3),0)):7200,1:$P(^(0),"^",13)*60) S RTFL=""
44 D LINE^RTUTL3 W !,"REQUESTOR is the CURRENT BORROWER of the record."
45 S Y=^RT(RT,"CL"),U1=+$P(Y,"^",7),Y=+$P(Y,"^",6) D D^DIQ W !?5,"DATE/TIME Record was CHARGED to Requestor: ",Y,!?5,"USER RESPONSIBLE for the Charge : ",$S($D(^VA(200,U1,0)):$P(^(0),"^"),1:"UNKNOWN") K U1
46 I $D(RTFL) W !!,"Request is not allowed for date/time specified. TOO SOON!"
47 D LINE^RTUTL3,ASK:'$D(RTFL) Q
48 ;
49ASK I RTX="RTB" S Y=RTB D BOR^RTB
50 I RTX="RTQDT" S Y=RTZ("X") D D^DIQ
51 S RTRD(1)="Yes^make the record request for "_Y,RTRD(2)="No^select another time for the request ",RTRD("B")=2,RTRD("A")="Do you still wish to make the request for "_Y_"? ",RTRD(0)="S"
52 D SET^RTRD K RTRD,RTFL S:$E(X)'="Y" RTFL="" Q
Note: See TracBrowser for help on using the repository browser.