- 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 Feb 19, 2025@00:01:40 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
