RTP ;MJK/TROY ISC;Pull List Option; ; 5/7/87 12:37 PM ;
;;v 2.0;Record Tracking;;10/22/91
D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
G:$D(^DOPT($P(X," ;"),11)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
D IXALL^DIK
A D OVERALL^RTPSET Q:$D(XQUIT)
W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
;
1 ;;Create Pull List
CREATE I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
W ! S DIC("A")="Enter NEW PULL LIST NAME: ",DIC(0)="IAELQ",DIC("S")="I 0",DIC("DR")="15////"_+RTAPL,DIC="^RTV(194.2,",DLAYGO=194.2 D ^DIC K DIC G Q:Y<0
K RTQDT,RTB,RTINST,RTSEL S RTPLTY=2,RTSHOW="",DIE("NO^")="OUTOK",(DA,RTPULL)=+Y,DR="[RT PULL LIST]",DIE="^RTV(194.2," D ^DIE K RTSHOW,RTINST,RTPLTY,DIE,DE,DQ
I $D(Y) W !?3,*7,"...entry is incomplete" S DIK="^RTV(194.2," D ^DIK K DIK W "...pull list has been deleted." S Y=""
D ADD^RTP2:'$D(Y) K DLAYGO,DIC,RTESC,RTPULL
Q K X1,A,DA,D0,DR,DIE,P,POP,RTC,RTY,%,%I,%H
K DIC,X,Y,J,I Q
;
2 ;;Change Pull List Date
W ! S DIC("S")="I $P(^(0),U,6)=""r"",'$P(^(0),U,13),$P(^(0),U,15)=+RTAPL",DIC(0)="IAEMQ",DIC="^RTV(194.2," D ^DIC K DIC Q:Y<0 S RTPULL=+Y
S %DT="ATEFX",%DT("A")="Enter NEW Date: ",%DT(0)="NOW" D ^%DT K %DT G Q2:Y<0 S RTQDT=Y
S RTRD(1)="Yes^change the date",RTRD(2)="No^do not change the date",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Are you sure you want to change the date the records are needed? " D SET^RTRD K RTRD G Q2:$E(X)'="Y"
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" W "." S DA=RTQ,DR="4////"_RTQDT S DIE="^RTV(190.1," D ^DIE K DE,DQ
S DA=RTPULL,DR="2////"_RTQDT,DIE="^RTV(194.2," D ^DIE
Q2 K DE,DQ,RTPULL,RTQDT,RTQ G Q
;
3 ;;Add Records Request to List
I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
D LIST G Q:Y<0 D ADD^RTP2 K DIC,RTESC,RTPULL G Q
;
4 ;;Cancel an Entire Pull List
D LIST G Q4:Y<0 S Y="cancel" D ASK G Q4:$E(X)'="Y" 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,"...pull list has been cancelled"
Q4 K RTPULL,RTSTAT
K DUOUT,X,Y,DIC,J G Q
;
5 ;;Designate Requests as Not Fillable
G 5^RTP1
;
6 ;;Charge Out Pull List
G ^RTP4
;
7 ;;Flag Pull List as PULLED/NOT CHARGED
;D LIST Q:Y<0 S RTSTAT="p" G CAN
Q
;
8 ;;Cancel Individual Requests from Pull List
G 8^RTP1
;
9 ;;Modify Pull List Comments
G 9^RTP1
;
10 ;;Pull List Print
G ^RTP3
;
11 ;;Special Multi-Institution Prints
G ^RTP5
;
12 ;;Cancel an Entire Pull list for all future dates
G ALL^RTPCAN
;
LIST 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 Q:Y<0 S RTPULL=+Y Q
;
STAT S DA=RTPULL,DR="[RT CHANGE PULL LIST STATUS]",DIE="^RTV(194.2," D ^DIE K DE,DQ Q
;
ASK ;
S RTRD(1)="Yes^"_Y_" entire pull list",RTRD(2)="No^not "_Y_" pull list",RTRD("B")=2,RTRD("A")="Are you sure you want to "_Y_" this pull list? ",RTRD(0)="S" D SET^RTRD K RTRD Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTP 3207 printed Dec 13, 2024@02:34:10 Page 2
RTP ;MJK/TROY ISC;Pull List Option; ; 5/7/87 12:37 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 DO DT^DICRW
SET X=$TEXT(+1)
SET DIK="^DOPT("""_$PIECE(X," ;",1)_""","
+3 if $DATA(^DOPT($PIECE(X," ;"),11))
GOTO A
SET ^DOPT($PIECE(X," ;"),0)=$PIECE(X,";",3)_"^1N^"
FOR I=1:1
SET Y=$TEXT(@I)
if Y=""
QUIT
SET ^DOPT($PIECE(X," ;"),I,0)=$PIECE(Y,";",3,99)
+4 DO IXALL^DIK
A DO OVERALL^RTPSET
if $DATA(XQUIT)
QUIT
+1 WRITE !!
SET DIC="^DOPT("""_$PIECE($TEXT(+1)," ;")_""","
SET DIC(0)="IQEAM"
DO ^DIC
if Y<0
QUIT
DO @+Y
GOTO A
+2 ;
1 ;;Create Pull List
CREATE IF '$DATA(RTDIV)
DO DIV1^RTPSET
IF '$DATA(RTDIV)
DO MES^RTP4
QUIT
+1 WRITE !
SET DIC("A")="Enter NEW PULL LIST NAME: "
SET DIC(0)="IAELQ"
SET DIC("S")="I 0"
SET DIC("DR")="15////"_+RTAPL
SET DIC="^RTV(194.2,"
SET DLAYGO=194.2
DO ^DIC
KILL DIC
if Y<0
GOTO Q
+2 KILL RTQDT,RTB,RTINST,RTSEL
SET RTPLTY=2
SET RTSHOW=""
SET DIE("NO^")="OUTOK"
SET (DA,RTPULL)=+Y
SET DR="[RT PULL LIST]"
SET DIE="^RTV(194.2,"
DO ^DIE
KILL RTSHOW,RTINST,RTPLTY,DIE,DE,DQ
+3 IF $DATA(Y)
WRITE !?3,*7,"...entry is incomplete"
SET DIK="^RTV(194.2,"
DO ^DIK
KILL DIK
WRITE "...pull list has been deleted."
SET Y=""
+4 if '$DATA(Y)
DO ADD^RTP2
KILL DLAYGO,DIC,RTESC,RTPULL
Q KILL X1,A,DA,D0,DR,DIE,P,POP,RTC,RTY,%,%I,%H
+1 KILL DIC,X,Y,J,I
QUIT
+2 ;
2 ;;Change Pull List Date
+1 WRITE !
SET DIC("S")="I $P(^(0),U,6)=""r"",'$P(^(0),U,13),$P(^(0),U,15)=+RTAPL"
SET DIC(0)="IAEMQ"
SET DIC="^RTV(194.2,"
DO ^DIC
KILL DIC
if Y<0
QUIT
SET RTPULL=+Y
+2 SET %DT="ATEFX"
SET %DT("A")="Enter NEW Date: "
SET %DT(0)="NOW"
DO ^%DT
KILL %DT
if Y<0
GOTO Q2
SET RTQDT=Y
+3 SET RTRD(1)="Yes^change the date"
SET RTRD(2)="No^do not change the date"
SET RTRD(0)="S"
SET RTRD("B")=2
SET RTRD("A")="Are you sure you want to change the date the records are needed? "
DO SET^RTRD
KILL RTRD
if $EXTRACT(X)'="Y"
GOTO Q2
+4 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"
WRITE "."
SET DA=RTQ
SET DR="4////"_RTQDT
SET DIE="^RTV(190.1,"
DO ^DIE
KILL DE,DQ
+5 SET DA=RTPULL
SET DR="2////"_RTQDT
SET DIE="^RTV(194.2,"
DO ^DIE
Q2 KILL DE,DQ,RTPULL,RTQDT,RTQ
GOTO Q
+1 ;
3 ;;Add Records Request to List
+1 IF '$DATA(RTDIV)
DO DIV1^RTPSET
IF '$DATA(RTDIV)
DO MES^RTP4
QUIT
+2 DO LIST
if Y<0
GOTO Q
DO ADD^RTP2
KILL DIC,RTESC,RTPULL
GOTO Q
+3 ;
4 ;;Cancel an Entire Pull List
+1 DO LIST
if Y<0
GOTO Q4
SET Y="cancel"
DO ASK
if $EXTRACT(X)'="Y"
GOTO Q4
SET RTSTAT="x"
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,"...pull list has been cancelled"
Q4 KILL RTPULL,RTSTAT
+1 KILL DUOUT,X,Y,DIC,J
GOTO Q
+2 ;
5 ;;Designate Requests as Not Fillable
+1 GOTO 5^RTP1
+2 ;
6 ;;Charge Out Pull List
+1 GOTO ^RTP4
+2 ;
7 ;;Flag Pull List as PULLED/NOT CHARGED
+1 ;D LIST Q:Y<0 S RTSTAT="p" G CAN
+2 QUIT
+3 ;
8 ;;Cancel Individual Requests from Pull List
+1 GOTO 8^RTP1
+2 ;
9 ;;Modify Pull List Comments
+1 GOTO 9^RTP1
+2 ;
10 ;;Pull List Print
+1 GOTO ^RTP3
+2 ;
11 ;;Special Multi-Institution Prints
+1 GOTO ^RTP5
+2 ;
12 ;;Cancel an Entire Pull list for all future dates
+1 GOTO ALL^RTPCAN
+2 ;
LIST 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
QUIT
SET RTPULL=+Y
QUIT
+1 ;
STAT SET DA=RTPULL
SET DR="[RT CHANGE PULL LIST STATUS]"
SET DIE="^RTV(194.2,"
DO ^DIE
KILL DE,DQ
QUIT
+1 ;
ASK ;
+1 SET RTRD(1)="Yes^"_Y_" entire pull list"
SET RTRD(2)="No^not "_Y_" pull list"
SET RTRD("B")=2
SET RTRD("A")="Are you sure you want to "_Y_" this pull list? "
SET RTRD(0)="S"
DO SET^RTRD
KILL RTRD
QUIT
+2 ;
