RTUTL4 ;MJK/TROY ISC;Select a Request Utility Routine; ; 5/8/87 10:35 AM ;
;;v 2.0;Record Tracking;;10/22/91
K R S X="AA",A=+RTAPL,E=RTE S:$D(RTTY) X="AT",V=+RTTY
F R=0:0 S R=$O(^RT(X,A,E,R)) Q:'R S R(R)=""
REC ;entry point to display requests for a record; R(R) and RTE defined
S IOP="" D ^%ZIS K RTESC,IOP,RTL,Q D HD,TYPE^RTNQ2
F R=0:0 S R=$O(R(R)) Q:'R F Q=0:0 S Q=$O(^RTV(190.1,"B",R,Q)) Q:'Q S Q(Q)=""
I $D(Q)<11 W !?5,"No requests" G Q
F Q=0:0 S Q=$O(Q(Q)) Q:'Q I $D(^RTV(190.1,Q,0)) S Q0=^(0),Y=Q X:$D(RTQDC("S")) RTQDC("S") I $T!('$D(RTQDC("S"))),$D(^RT(+Q0,0)) S Y=^(0),V=+$P(Y,"^",7),O=+RTO(+$P(Y,"^",3)),RTL(O,999-V,Q)=$P(RTO(+$P(Y,"^",3)),"^",3)_V_"^"_Q0
I $D(RTL)<10 W !?5,"No requests meet current criteria" G Q
S (RTC,RTC0)=0 K RTFL,RTS F O=0:0 S O=$O(RTL(O)) Q:'O F V=0:0 S V=$O(RTL(O,V)) Q:'V F Q=0:0 S Q=$O(RTL(O,V,Q)) Q:'Q S Q0=RTL(O,V,Q),RTC=RTC+1,RTS(RTC)=Q D PRT G Q:$D(RTESC)
I $D(RTSEL),RTC>RTC0 D SEL1
Q K RTS,RTESC,RTLC,RTC0,RTFL,RTL,O,V,Q,Q0,O,E,T,RTO,R Q
;
PRT S S="",R1=$P(Q0,"^"),Q0=$P(Q0,"^",2,99) S:$P(Q0,"^",10) RTFL="",S="*" S Y=+$P(Q0,"^",4) D D^DIQ S D=Y S Y=Q0 D DEMOS3^RTUTL1
W !,RTC,?4,R1,?12,$E(RTD("B"),1,17),?30,D,?50,RTD("P1"),?72,$J(Q,7),S S RTLC=RTLC+1
I $D(RTD("PROV")) W !?12,"(",RTD("PROV"),")",?50,$E("("_RTD("PROVP")_"/"_RTD("PROVL"),1,19),")" S RTLC=RTLC+1
I $D(^RTV(190.1,Q,"COMMENT")) S RTLC=RTLC+1 W !?3,"(Comment: ",^("COMMENT"),")" S RTLC=RTLC+1
K S,R1,RTD,D D SEL Q
;
HD I $O(R(0)),'$O(R($O(R(0)))) S RT=$O(R(0)) I $D(^RT(RT,0)) S X1="**** Request Profile for "_$S($D(^DIC(195.2,+$P(^(0),"^",3),0)):$P(^(0),"^"),1:"")_" Vol: "_+$P(^RT(RT,0),"^",7)_" ****" D RECHD^RTUTL2 S RTLC=5 G HD1
S X1="Request Profile for "_$P($P(RTAPL,"^",1),";",2)_" Records" D PTHD^RTUTL2,EQUALS^RTUTL3 S RTLC=5
HD1 W !?59,"[* pull list request]",!?4,"Record",?12,"Requestor",?30,"Date Needed",?50,"Phone/Room#",?72,"Request#" D LINE^RTUTL3 S RTLC=RTLC+2
Q
;
SEL I $D(RTSEL),(RTLC+4)>20 S RTLC=0,RTZ("RTC")=RTC D SEL1 W ! S:$D(RTESC) RTC=RTZ("RTC"),RTC0=RTC K RTZ Q
I (RTLC+4)>20,IOST["C-" S RTLC=0 K RTESC D ESC^RTRD
Q
;
SEL1 S RTRD("A")=$S($D(RTSEL("A")):RTSEL("A"),1:"Choose Request")_$S(RTSEL["S"&(RTC>1):"s",1:"")_" from List: " D SEL^RTRD K RTRD,RTESC
S:$D(RTY)!(X="^") RTESC="" S:RTC ^DISV($S($D(DUZ)'[0:DUZ,1:0),"^RTV(190.1,")=+RTY(RTC) Q
;
RT Q:'$D(RT) S R(RT)="" G REC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTUTL4 2379 printed Apr 09, 2024@21:36:11 Page 2
RTUTL4 ;MJK/TROY ISC;Select a Request Utility Routine; ; 5/8/87 10:35 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 KILL R
SET X="AA"
SET A=+RTAPL
SET E=RTE
if $DATA(RTTY)
SET X="AT"
SET V=+RTTY
+3 FOR R=0:0
SET R=$ORDER(^RT(X,A,E,R))
if 'R
QUIT
SET R(R)=""
REC ;entry point to display requests for a record; R(R) and RTE defined
+1 SET IOP=""
DO ^%ZIS
KILL RTESC,IOP,RTL,Q
DO HD
DO TYPE^RTNQ2
+2 FOR R=0:0
SET R=$ORDER(R(R))
if 'R
QUIT
FOR Q=0:0
SET Q=$ORDER(^RTV(190.1,"B",R,Q))
if 'Q
QUIT
SET Q(Q)=""
+3 IF $DATA(Q)<11
WRITE !?5,"No requests"
GOTO Q
+4 FOR Q=0:0
SET Q=$ORDER(Q(Q))
if 'Q
QUIT
IF $DATA(^RTV(190.1,Q,0))
SET Q0=^(0)
SET Y=Q
if $DATA(RTQDC("S"))
XECUTE RTQDC("S")
IF $TEST!('$DATA(RTQDC("S")))
IF $DATA(^RT(+Q0,0))
SET Y=^(0)
SET V=+$PIECE(Y,"^",7)
SET O=+RTO(+$PIECE(Y,"^",3))
SET RTL(O,999-V,Q)=$PIECE(RTO(+$PIECE(Y,"^",3)),"^",3)_V_"^"_Q0
+5 IF $DATA(RTL)<10
WRITE !?5,"No requests meet current criteria"
GOTO Q
+6 SET (RTC,RTC0)=0
KILL RTFL,RTS
FOR O=0:0
SET O=$ORDER(RTL(O))
if 'O
QUIT
FOR V=0:0
SET V=$ORDER(RTL(O,V))
if 'V
QUIT
FOR Q=0:0
SET Q=$ORDER(RTL(O,V,Q))
if 'Q
QUIT
SET Q0=RTL(O,V,Q)
SET RTC=RTC+1
SET RTS(RTC)=Q
DO PRT
if $DATA(RTESC)
GOTO Q
+7 IF $DATA(RTSEL)
IF RTC>RTC0
DO SEL1
Q KILL RTS,RTESC,RTLC,RTC0,RTFL,RTL,O,V,Q,Q0,O,E,T,RTO,R
QUIT
+1 ;
PRT SET S=""
SET R1=$PIECE(Q0,"^")
SET Q0=$PIECE(Q0,"^",2,99)
if $PIECE(Q0,"^",10)
SET RTFL=""
SET S="*"
SET Y=+$PIECE(Q0,"^",4)
DO D^DIQ
SET D=Y
SET Y=Q0
DO DEMOS3^RTUTL1
+1 WRITE !,RTC,?4,R1,?12,$EXTRACT(RTD("B"),1,17),?30,D,?50,RTD("P1"),?72,$JUSTIFY(Q,7),S
SET RTLC=RTLC+1
+2 IF $DATA(RTD("PROV"))
WRITE !?12,"(",RTD("PROV"),")",?50,$EXTRACT("("_RTD("PROVP")_"/"_RTD("PROVL"),1,19),")"
SET RTLC=RTLC+1
+3 IF $DATA(^RTV(190.1,Q,"COMMENT"))
SET RTLC=RTLC+1
WRITE !?3,"(Comment: ",^("COMMENT"),")"
SET RTLC=RTLC+1
+4 KILL S,R1,RTD,D
DO SEL
QUIT
+5 ;
HD IF $ORDER(R(0))
IF '$ORDER(R($ORDER(R(0))))
SET RT=$ORDER(R(0))
IF $DATA(^RT(RT,0))
SET X1="**** Request Profile for "_$SELECT($DATA(^DIC(195.2,+$PIECE(^(0),"^",3),0)):$PIECE(^(0),"^"),1:"")_" Vol: "_+$PIECE(^RT(RT,0),"^",7)_" ****"
DO RECHD^RTUTL2
SET RTLC=5
GOTO HD1
+1 SET X1="Request Profile for "_$PIECE($PIECE(RTAPL,"^",1),";",2)_" Records"
DO PTHD^RTUTL2
DO EQUALS^RTUTL3
SET RTLC=5
HD1 WRITE !?59,"[* pull list request]",!?4,"Record",?12,"Requestor",?30,"Date Needed",?50,"Phone/Room#",?72,"Request#"
DO LINE^RTUTL3
SET RTLC=RTLC+2
+1 QUIT
+2 ;
SEL IF $DATA(RTSEL)
IF (RTLC+4)>20
SET RTLC=0
SET RTZ("RTC")=RTC
DO SEL1
WRITE !
if $DATA(RTESC)
SET RTC=RTZ("RTC")
SET RTC0=RTC
KILL RTZ
QUIT
+1 IF (RTLC+4)>20
IF IOST["C-"
SET RTLC=0
KILL RTESC
DO ESC^RTRD
+2 QUIT
+3 ;
SEL1 SET RTRD("A")=$SELECT($DATA(RTSEL("A")):RTSEL("A"),1:"Choose Request")_$SELECT(RTSEL["S"&(RTC>1):"s",1:"")_" from List: "
DO SEL^RTRD
KILL RTRD,RTESC
+1 if $DATA(RTY)!(X="^")
SET RTESC=""
if RTC
SET ^DISV($SELECT($DATA(DUZ)'[0:DUZ,1:0),"^RTV(190.1,")=+RTY(RTC)
QUIT
+2 ;
RT if '$DATA(RT)
QUIT
SET R(RT)=""
GOTO REC
