RTPCAN ;RPW/BUF,PKE/TROY-Cancel All pull lists for a clinic ; 9-17-87
;;v 2.0;Record Tracking;**25**;10/22/91
ALL D:'$D(DT) DT^DICRW
S DIC=44,DIC(0)="AEQMZ",DIC("A")="Select Clinic: ",DIC("S")="I $P(^(0),U,3)=""C""" D ^DIC K DIC("A"),DIC("S") G Q4:Y<0 S RTCLNAM=$P(Y,U,2)
W !!,*7,"Are you sure you want to DELETE ALL Pull lists for the " S DIR("A")=" "_RTCLNAM_" clinic: ",DIR(0)="YA",DIR("B")="NO" D ^DIR G:Y'=1 Q4
;
S RTPNAM=RTCLNAM_" [",N=0
F RTN=0:0 S RTPNAM=$O(^RTV(194.2,"B",RTPNAM)) Q:(RTPNAM="")!($P(RTPNAM," [")]RTCLNAM)!($P(RTPNAM," [")'=RTCLNAM) S RTPULL=$O(^(RTPNAM,0)) D CHK G Q4:$E(X)="^"
W !,?3,N," Pull lists were cancelled"
Q4 K N,RTPULL,RTSTAT,RTPNAM,RTCLNAM,%
K DIC,DIR,Y,X Q
;
CHK Q:'$D(^RTV(194.2,RTPULL,0)) Q:$P(^(0),U,2)'>DT Q:$P(^(0),U,6)'="r"
S RTSTAT="x"
;
CAN F RTQ=0:0 S RTQ=$O(^RTV(190.1,"AP",RTPULL,RTQ)) Q:'RTQ I $D(^RTV(190.1,RTQ,0)),$P(^(0),"^",6)="r"!($P(^(0),"^",6)="n") S DA=RTQ,DIE="^RTV(190.1,",DR="[RT CHANGE REQUEST STATUS]" D ^DIE K DE,DQ
K RTQ D STAT W !!?3,RTPNAM,"...pull list has been cancelled" S N=N+1 Q
Q
STAT S DA=RTPULL,DR="[RT CHANGE PULL LIST STATUS]",DIE="^RTV(194.2," D ^DIE K DE,DQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTPCAN 1185 printed Nov 22, 2024@17:44:22 Page 2
RTPCAN ;RPW/BUF,PKE/TROY-Cancel All pull lists for a clinic ; 9-17-87
+1 ;;v 2.0;Record Tracking;**25**;10/22/91
ALL if '$DATA(DT)
DO DT^DICRW
+1 SET DIC=44
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Clinic: "
SET DIC("S")="I $P(^(0),U,3)=""C"""
DO ^DIC
KILL DIC("A"),DIC("S")
if Y<0
GOTO Q4
SET RTCLNAM=$PIECE(Y,U,2)
+2 WRITE !!,*7,"Are you sure you want to DELETE ALL Pull lists for the "
SET DIR("A")=" "_RTCLNAM_" clinic: "
SET DIR(0)="YA"
SET DIR("B")="NO"
DO ^DIR
if Y'=1
GOTO Q4
+3 ;
+4 SET RTPNAM=RTCLNAM_" ["
SET N=0
+5 FOR RTN=0:0
SET RTPNAM=$ORDER(^RTV(194.2,"B",RTPNAM))
if (RTPNAM="")!($PIECE(RTPNAM," [")]RTCLNAM)!($PIECE(RTPNAM," [")'=RTCLNAM)
QUIT
SET RTPULL=$ORDER(^(RTPNAM,0))
DO CHK
if $EXTRACT(X)="^"
GOTO Q4
+6 WRITE !,?3,N," Pull lists were cancelled"
Q4 KILL N,RTPULL,RTSTAT,RTPNAM,RTCLNAM,%
+1 KILL DIC,DIR,Y,X
QUIT
+2 ;
CHK if '$DATA(^RTV(194.2,RTPULL,0))
QUIT
if $PIECE(^(0),U,2)'>DT
QUIT
if $PIECE(^(0),U,6)'="r"
QUIT
+1 SET RTSTAT="x"
+2 ;
CAN FOR RTQ=0:0
SET RTQ=$ORDER(^RTV(190.1,"AP",RTPULL,RTQ))
if 'RTQ
QUIT
IF $DATA(^RTV(190.1,RTQ,0))
IF $PIECE(^(0),"^",6)="r"!($PIECE(^(0),"^",6)="n")
SET DA=RTQ
SET DIE="^RTV(190.1,"
SET DR="[RT CHANGE REQUEST STATUS]"
DO ^DIE
KILL DE,DQ
+1 KILL RTQ
DO STAT
WRITE !!?3,RTPNAM,"...pull list has been cancelled"
SET N=N+1
QUIT
+2 QUIT
STAT SET DA=RTPULL
SET DR="[RT CHANGE PULL LIST STATUS]"
SET DIE="^RTV(194.2,"
DO ^DIE
KILL DE,DQ
QUIT
