- RTQ1 ;MJK/TROY ISC;Record Request Option; ; 1/30/87 10:11 AM ;
- ;;v 2.0;Record Tracking;;10/22/91
- MISS S RTASK=""
- MISS1 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)
- D DEMOS^RTUTL1,LINE^RTUTL3 W *7,!,RTD("N"),"'s ",RTD("T"),"is flagged as 'MISSING'" I '$D(RTASK) D NOASK G MISSQ
- 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
- MISSQ K RTASK Q
- ;
- NOASK ;
- W !?5,"* no processing allowed on the record until flag is removed"
- 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"
- D LINE^RTUTL3 K RTD,RT Q
- ;
- CANCEL Q:'$D(^RTV(190.1,RTQ,0))!($P(^(0),"^",6)'="x")
- 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)
- D DT^DIQ:Y W "." D LINE^RTUTL3 K X,Y,RTD,RTQ Q
- ;
- TEST ;This entry point is used by the input transform for the REQUESTOR and
- ;DATE/TIME RECORD NEEDED fields of the REQUESTED RECORDS(190.1) file.
- ;
- 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))
- K RTFL F RTCHK=1:1:2 S X=RTZ("X") D @("CHK"_RTCHK) Q:$D(RTFL)
- ;This next line is from the edit request templ. if users ^out of this check. RTFL1 only set by template.
- K RTCHK,RTQ,RTQDT,RT,RTB D RESTORE^RTUTL1
- I $D(RTFL),$D(RTFL1) S X=RTFL1
- Q
- ;
- CHK1 ;check for if the borrower already has a request pending for the
- ;record on the same day as the current request
- ;
- 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
- Q:$D(X) D LINE^RTUTL3
- 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
- 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
- ;
- CHK2 ;check to see if the REQUESTOR is the CURRENT BORROWER
- ;if so, then checks to see if the request is too soon. If too soon, then
- ;does not allow request. Otherwise, user is asked if they still want
- ;to make the request.
- ;
- Q:$S('$D(^RT(RT,"CL")):1,$P(^("CL"),"^",5)'=RTB:1,1:0) S X=RTQDT D H^RTUTL3 Q:X<0
- 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
- I Y<$S('$D(^RT(RT,0)):7200,'$D(^DIC(195.2,+$P(^(0),"^",3),0)):7200,1:$P(^(0),"^",13)*60) S RTFL=""
- D LINE^RTUTL3 W !,"REQUESTOR is the CURRENT BORROWER of the record."
- 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
- I $D(RTFL) W !!,"Request is not allowed for date/time specified. TOO SOON!"
- D LINE^RTUTL3,ASK:'$D(RTFL) Q
- ;
- ASK I RTX="RTB" S Y=RTB D BOR^RTB
- I RTX="RTQDT" S Y=RTZ("X") D D^DIQ
- 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"
- D SET^RTRD K RTRD,RTFL S:$E(X)'="Y" RTFL="" Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTQ1 3705 printed Feb 19, 2025@00:00:58 Page 2
- RTQ1 ;MJK/TROY ISC;Record Request Option; ; 1/30/87 10:11 AM ;
- +1 ;;v 2.0;Record Tracking;;10/22/91
- MISS SET RTASK=""
- MISS1 if '$DATA(^RT(RT,"CL"))
- GOTO MISSQ
- if $SELECT('$DATA(^RTV(195.9,+$PIECE(^("CL"),"^",5),0)):1,$PIECE(^(0),"^")'="2;DIC(195.4,":1,1:0)
- GOTO MISSQ
- +1 DO DEMOS^RTUTL1
- DO LINE^RTUTL3
- WRITE *7,!,RTD("N"),"'s ",RTD("T"),"is flagged as 'MISSING'"
- IF '$DATA(RTASK)
- DO NOASK
- GOTO MISSQ
- +2 KILL Y
- SET RTRD(1)="Yes^request record"
- SET RTRD(2)="No^do not request record"
- SET RTRD(0)="S"
- SET RTRD("B")=2
- SET RTRD("A")="Do you still want to request this record? "
- DO SET^RTRD
- KILL RTRD
- if $EXTRACT(X)'="Y"
- KILL RT
- DO LINE^RTUTL3
- MISSQ KILL RTASK
- QUIT
- +1 ;
- NOASK ;
- +1 WRITE !?5,"* no processing allowed on the record until flag is removed"
- +2 IF $DATA(^DIC(195.2,+$PIECE(^RT(RT,0),"^",3),0))
- IF $PIECE(^(0),"^",7)'="a"
- IF '$DATA(^XUSEC($SELECT($PIECE(RTAPL,"^",8)]"":$PIECE(RTAPL,"^",8),1:"RTZ XXX"),DUZ))
- WRITE !?5,"* please notify the file room if you have found this record"
- +3 DO LINE^RTUTL3
- KILL RTD,RT
- QUIT
- +4 ;
- CANCEL if '$DATA(^RTV(190.1,RTQ,0))!($PIECE(^(0),"^",6)'="x")
- QUIT
- +1 DO DEMOS^RTUTL1
- DO LINE^RTUTL3
- SET X=^RTV(190.1,RTQ,0)
- WRITE !,"The request (#",RTQ,") for ",RTD("N"),"'s ",RTD("T"),!?10,"was cancelled by ",$SELECT($DATA(^VA(200,+$PIECE(X,"^",8),0)):$PIECE(^(0),"^"),1:"UNKNOWN")," on "
- SET Y=$PIECE(X,"^",7)
- +2 if Y
- DO DT^DIQ
- WRITE "."
- DO LINE^RTUTL3
- KILL X,Y,RTD,RTQ
- QUIT
- +3 ;
- TEST ;This entry point is used by the input transform for the REQUESTOR and
- +1 ;DATE/TIME RECORD NEEDED fields of the REQUESTED RECORDS(190.1) file.
- +2 ;
- +3 SET RTZ1="X^RTQ^RTQDT^RT^RTB"
- DO SAVE^RTUTL1
- SET RT=+^RTV(190.1,DA,0)
- SET RTQDT=$SELECT(RTX="RTQDT":X,1:+$PIECE($PIECE(^(0),"^",4),"."))
- SET RTB=$SELECT(RTX="RTB":X,1:$PIECE(^(0),"^",5))
- +4 KILL RTFL
- FOR RTCHK=1:1:2
- SET X=RTZ("X")
- DO @("CHK"_RTCHK)
- if $DATA(RTFL)
- QUIT
- +5 ;This next line is from the edit request templ. if users ^out of this check. RTFL1 only set by template.
- +6 KILL RTCHK,RTQ,RTQDT,RT,RTB
- DO RESTORE^RTUTL1
- +7 IF $DATA(RTFL)
- IF $DATA(RTFL1)
- SET X=RTFL1
- +8 QUIT
- +9 ;
- CHK1 ;check for if the borrower already has a request pending for the
- +1 ;record on the same day as the current request
- +2 ;
- +3 FOR RTQ=0:0
- SET RTQ=$ORDER(^RTV(190.1,"AC",RT,+$PIECE(RTQDT,"."),RTQ))
- if 'RTQ
- QUIT
- IF RTQ'=DA
- IF $DATA(^RTV(190.1,RTQ,0))
- IF $PIECE(^(0),"^",6)="r"
- IF $PIECE(^(0),"^",5)=RTB
- IF $SELECT('$DATA(RTPULL):1,$PIECE(^(0),"^",10)=RTPULL:1,1:0)
- SET Y=^(0)
- KILL X
- QUIT
- +4 if $DATA(X)
- QUIT
- DO LINE^RTUTL3
- +5 WRITE !,*7,"Borrower already has a request pending for this record on this date:",!?5,"User Requesting Record : ",$SELECT($DATA(^VA(200,+$PIECE(Y,"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN"),!?5,"Date Request was Filed : "
- SET Y=$PIECE(Y,"^",2)
- DO D^DIQ
- WRITE Y
- +6 SET Y=$PIECE(^RTV(190.1,RTQ,0),"^",4)
- DO D^DIQ
- WRITE !?5,"Record Request Number : ",RTQ,!?5,"Date/Time Record Needed: ",Y
- DO LINE^RTUTL3
- DO ASK
- QUIT
- +7 ;
- CHK2 ;check to see if the REQUESTOR is the CURRENT BORROWER
- +1 ;if so, then checks to see if the request is too soon. If too soon, then
- +2 ;does not allow request. Otherwise, user is asked if they still want
- +3 ;to make the request.
- +4 ;
- +5 if $SELECT('$DATA(^RT(RT,"CL"))
- QUIT
- SET X=RTQDT
- DO H^RTUTL3
- if X<0
- QUIT
- +6 SET Y=$HOROLOG
- SET Y1=+$PIECE(Y,",")*24*3600
- SET Y1=Y1+$PIECE(Y,",",2)
- SET X1=+$PIECE(X,",")*24*3600
- SET X1=X1+$PIECE(X,",",2)
- SET Y=X1-Y1
- +7 IF Y<$SELECT('$DATA(^RT(RT,0)):7200,'$DATA(^DIC(195.2,+$PIECE(^(0),"^",3),0)):7200,1:$PIECE(^(0),"^",13)*60)
- SET RTFL=""
- +8 DO LINE^RTUTL3
- WRITE !,"REQUESTOR is the CURRENT BORROWER of the record."
- +9 SET Y=^RT(RT,"CL")
- SET U1=+$PIECE(Y,"^",7)
- SET Y=+$PIECE(Y,"^",6)
- DO D^DIQ
- WRITE !?5,"DATE/TIME Record was CHARGED to Requestor: ",Y,!?5,"USER RESPONSIBLE for the Charge : ",$SELECT($DATA(^VA(200,U1,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- KILL U1
- +10 IF $DATA(RTFL)
- WRITE !!,"Request is not allowed for date/time specified. TOO SOON!"
- +11 DO LINE^RTUTL3
- if '$DATA(RTFL)
- DO ASK
- QUIT
- +12 ;
- ASK IF RTX="RTB"
- SET Y=RTB
- DO BOR^RTB
- +1 IF RTX="RTQDT"
- SET Y=RTZ("X")
- DO D^DIQ
- +2 SET RTRD(1)="Yes^make the record request for "_Y
- SET RTRD(2)="No^select another time for the request "
- SET RTRD("B")=2
- SET RTRD("A")="Do you still wish to make the request for "_Y_"? "
- SET RTRD(0)="S"
- +3 DO SET^RTRD
- KILL RTRD,RTFL
- if $EXTRACT(X)'="Y"
- SET RTFL=""
- QUIT
