RTP1 ;MJK/TROY ISC;Pull List Option; ; 5/5/87 8:40 AM ;
;;v 2.0;Record Tracking;;10/22/91
5 ;Designate Requests as 'Not Fillable'
D PND^RTRPT S RTINACFL=""
51 S DIC(0)="IEQ",DIC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"") D SCRN^RTQ",RTSEL="DSO" R !!,"Select Request: ",X:DTIME G Q5:"^"[X S RTN=0 D ^RTDPA2 G 51:'$D(RTY)
F RTY=0:0 S RTY=+$O(RTY(RTY)) Q:'RTY S RTQ=+RTY(RTY) I $D(^RTV(190.1,RTQ,0)) S S=$P(^(0),"^",6) D NOT I $D(RTQ) S DIE="^RTV(190.1,",DR="[RT CHANGE REQUEST STATUS]",DA=RTQ D ^DIE K DE,DQ
K RTY,RTQ G 51
Q5 K DIC,RTSEL,RTWND,RTN,RTSTAT,RTPULL,RTESC,RTINACFL
K DA,D0,POP,DIE,POP,RTC,N,DR,J Q
NOT D EQUALS^RTUTL3 W !,"Current status of request is '",$S(S="r":"REQUESTED",1:"NOT FILLABLE"),"'." S RTSTAT=S
S RTRD(1)="Yes^change request status",RTRD(2)="No^do not change status",RTRD(0)="S",RTRD("B")=1,RTRD("A")="Do you want to change status to '"_$S(S="r":"NOT FILLABLE",1:"REQUESTED")_"' ? " D SET^RTRD K RTRD D EQUALS^RTUTL3
I $E(X)="N"!($E(X)="^") K RTQ,RTSTAT Q
S RTSTAT=$S(RTSTAT="r":"n",1:"r") Q
;
8 ;Cancel Individual Requests from a Pull List
D LIST^RTP Q:Y<0 S RTSTAT="x"
81 K RTY S DIC(0)="IEQ",DIC("S")="I $P(^(0),U,10)=RTPULL,$P(^(0),U,6)=""r""!($P(^(0),U,6)=""n"")",RTSEL="DSO" R !!,"Select Request: ",X:DTIME S RTN=0 D HELP^RTP2:X["?" G 81:'$D(X),Q8:"^"[X D ^RTDPA2 K RTSEL G 81:'$D(RTY)
D CAN G 81:$E(X)'="Y" S RTSTAT="x"
F RTY=0:0 S RTY=+$O(RTY(RTY)) Q:'RTY S RTQ=+RTY(RTY) I $D(^RTV(190.1,RTQ,0)) S DIE="^RTV(190.1,",DR="[RT CHANGE REQUEST STATUS]",DA=RTQ D ^DIE K DE,DQ W !?3,"...request has been cancelled"
K RTSTAT,RTY,RTQ G 81
Q8 K DIC,RTSEL,RTN,RTSTAT,RTPULL,RTESC,NEW,A,DA,D0,DIE,N,POP,RT,RTC,RTE
K X,Y,C,I,X1,RTQ,T,DR Q
CAN S RTRD(1)="Yes^cancel request(s)",RTRD(2)="No^do cancel request(s)",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Are you sure you want to cancel "_$S(RTC=1:"this",1:"these")_" request"_$S(RTC=1:"",1:"s")_"? " D SET^RTRD K RTRD Q
;
9 ;Modify Pull List Comments
W ! S DIC("S")="I $P(^(0),U,2)'<DT,$P(^(0),U,6)=""r"",$P(^(0),U,15)=+RTAPL",DIC(0)="IAEMQ",DIC="^RTV(194.2," D ^DIC K DIC G Q9:Y<0
S DA=+Y,DR="100",DIE="^RTV(194.2," D ^DIE K DE,DQ
Q9 K DA,D0,DIE,DR,POP,DIC,J Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTP1 2182 printed Apr 09, 2024@21:36:32 Page 2
RTP1 ;MJK/TROY ISC;Pull List Option; ; 5/5/87 8:40 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
5 ;Designate Requests as 'Not Fillable'
+1 DO PND^RTRPT
SET RTINACFL=""
51 SET DIC(0)="IEQ"
SET DIC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"") D SCRN^RTQ"
SET RTSEL="DSO"
READ !!,"Select Request: ",X:DTIME
if "^"[X
GOTO Q5
SET RTN=0
DO ^RTDPA2
if '$DATA(RTY)
GOTO 51
+1 FOR RTY=0:0
SET RTY=+$ORDER(RTY(RTY))
if 'RTY
QUIT
SET RTQ=+RTY(RTY)
IF $DATA(^RTV(190.1,RTQ,0))
SET S=$PIECE(^(0),"^",6)
DO NOT
IF $DATA(RTQ)
SET DIE="^RTV(190.1,"
SET DR="[RT CHANGE REQUEST STATUS]"
SET DA=RTQ
DO ^DIE
KILL DE,DQ
+2 KILL RTY,RTQ
GOTO 51
Q5 KILL DIC,RTSEL,RTWND,RTN,RTSTAT,RTPULL,RTESC,RTINACFL
+1 KILL DA,D0,POP,DIE,POP,RTC,N,DR,J
QUIT
NOT DO EQUALS^RTUTL3
WRITE !,"Current status of request is '",$SELECT(S="r":"REQUESTED",1:"NOT FILLABLE"),"'."
SET RTSTAT=S
+1 SET RTRD(1)="Yes^change request status"
SET RTRD(2)="No^do not change status"
SET RTRD(0)="S"
SET RTRD("B")=1
SET RTRD("A")="Do you want to change status to '"_$SELECT(S="r":"NOT FILLABLE",1:"REQUESTED")_"' ? "
DO SET^RTRD
KILL RTRD
DO EQUALS^RTUTL3
+2 IF $EXTRACT(X)="N"!($EXTRACT(X)="^")
KILL RTQ,RTSTAT
QUIT
+3 SET RTSTAT=$SELECT(RTSTAT="r":"n",1:"r")
QUIT
+4 ;
8 ;Cancel Individual Requests from a Pull List
+1 DO LIST^RTP
if Y<0
QUIT
SET RTSTAT="x"
81 KILL RTY
SET DIC(0)="IEQ"
SET DIC("S")="I $P(^(0),U,10)=RTPULL,$P(^(0),U,6)=""r""!($P(^(0),U,6)=""n"")"
SET RTSEL="DSO"
READ !!,"Select Request: ",X:DTIME
SET RTN=0
if X["?"
DO HELP^RTP2
if '$DATA(X)
GOTO 81
if "^"[X
GOTO Q8
DO ^RTDPA2
KILL RTSEL
if '$DATA(RTY)
GOTO 81
+1 DO CAN
if $EXTRACT(X)'="Y"
GOTO 81
SET RTSTAT="x"
+2 FOR RTY=0:0
SET RTY=+$ORDER(RTY(RTY))
if 'RTY
QUIT
SET RTQ=+RTY(RTY)
IF $DATA(^RTV(190.1,RTQ,0))
SET DIE="^RTV(190.1,"
SET DR="[RT CHANGE REQUEST STATUS]"
SET DA=RTQ
DO ^DIE
KILL DE,DQ
WRITE !?3,"...request has been cancelled"
+3 KILL RTSTAT,RTY,RTQ
GOTO 81
Q8 KILL DIC,RTSEL,RTN,RTSTAT,RTPULL,RTESC,NEW,A,DA,D0,DIE,N,POP,RT,RTC,RTE
+1 KILL X,Y,C,I,X1,RTQ,T,DR
QUIT
CAN SET RTRD(1)="Yes^cancel request(s)"
SET RTRD(2)="No^do cancel request(s)"
SET RTRD(0)="S"
SET RTRD("B")=2
SET RTRD("A")="Are you sure you want to cancel "_$SELECT(RTC=1:"this",1:"these")_" request"_$SELECT(RTC=1:"",1:"s")_"? "
DO SET^RTRD
KILL RTRD
QUIT
+1 ;
9 ;Modify Pull List Comments
+1 WRITE !
SET DIC("S")="I $P(^(0),U,2)'<DT,$P(^(0),U,6)=""r"",$P(^(0),U,15)=+RTAPL"
SET DIC(0)="IAEMQ"
SET DIC="^RTV(194.2,"
DO ^DIC
KILL DIC
if Y<0
GOTO Q9
+2 SET DA=+Y
SET DR="100"
SET DIE="^RTV(194.2,"
DO ^DIE
KILL DE,DQ
Q9 KILL DA,D0,DIE,DR,POP,DIC,J
QUIT
