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