RTPCAN.m

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 ---RTPCAN   1185     printed  Apr 09, 2024@21:38:04                                                                                                                                                                                                      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