RTP40 ;MJK/TROY ISC;Charge Out Pull List to Holding Area; ; 5/19/87 11:25 AM ;
;;v 2.0;Record Tracking;**21**;10/22/91
K RTQ,RTPROV S X="CHARGE-OUT" D TYPE^RTT Q:'$D(RTMV) S Y=RTB D BOR^RTB S RTBNME=Y
W @IOF,"PULL LIST HOLDING AREA CHARGE-OUT LOG" D NOW^%DTC S Y=$E(%,1,12) D D^DIQ W ?51,"RUN DATE: ",Y D LINE^RTUTL3 S RTAG="HOLD^RTP40" D CHK^RTP4
K RTBNME,RTAG,RTMV,RTMV0 Q
;
HOLD S RTCOMR="Pull List: "_$P(RTP0,"^") F RTQX=0:0 S RTQX=$O(^RTV(190.1,"AP",RTPULL,RTQX)) Q:'RTQX I $D(^RTV(190.1,RTQX,0)),$P(^(0),"^",6)="r" S RT=+^(0) D CHG^RTT
S DA=RTPULL,DIE="^RTV(194.2,",DR="16////"_RTB D ^DIE I '$D(Y) W !!?3,"...'",$P(RTP0,"^"),"' pull list has been charged out to '",RTBNME,"'."
K RTCOMR,RTQX,RT Q
;
BOR K RTESC,RTB S RTRD(1)="Yes^charge out records to a holding area",RTRD(2)="No^charge out pull lists directly",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Do you want to charge out records to a holding area? " D SET^RTRD K RTRD
S:$E(X)="^" RTESC="" Q:$E(X)'="Y"
S DIC="^RTV(195.9,",DIC(0)="IDAEMLQ",DIC("DR")="3////"_+RTAPL,DIC("S")="I $P(^(0),U,3)="_+RTAPL_" D DICS^RTDPA31",DIC("V")="S RTA="_+RTAPL_" D DICV^RTDPA31 K RTA",DIC("A")="Select HOLDING AREA: " W ! D ^DIC K DIC
S:Y<0 RTESC="" S:Y>0 RTB=+Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTP40 1231 printed Dec 13, 2024@02:34:18 Page 2
RTP40 ;MJK/TROY ISC;Charge Out Pull List to Holding Area; ; 5/19/87 11:25 AM ;
+1 ;;v 2.0;Record Tracking;**21**;10/22/91
+2 KILL RTQ,RTPROV
SET X="CHARGE-OUT"
DO TYPE^RTT
if '$DATA(RTMV)
QUIT
SET Y=RTB
DO BOR^RTB
SET RTBNME=Y
+3 WRITE @IOF,"PULL LIST HOLDING AREA CHARGE-OUT LOG"
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO D^DIQ
WRITE ?51,"RUN DATE: ",Y
DO LINE^RTUTL3
SET RTAG="HOLD^RTP40"
DO CHK^RTP4
+4 KILL RTBNME,RTAG,RTMV,RTMV0
QUIT
+5 ;
HOLD SET RTCOMR="Pull List: "_$PIECE(RTP0,"^")
FOR RTQX=0:0
SET RTQX=$ORDER(^RTV(190.1,"AP",RTPULL,RTQX))
if 'RTQX
QUIT
IF $DATA(^RTV(190.1,RTQX,0))
IF $PIECE(^(0),"^",6)="r"
SET RT=+^(0)
DO CHG^RTT
+1 SET DA=RTPULL
SET DIE="^RTV(194.2,"
SET DR="16////"_RTB
DO ^DIE
IF '$DATA(Y)
WRITE !!?3,"...'",$PIECE(RTP0,"^"),"' pull list has been charged out to '",RTBNME,"'."
+2 KILL RTCOMR,RTQX,RT
QUIT
+3 ;
BOR KILL RTESC,RTB
SET RTRD(1)="Yes^charge out records to a holding area"
SET RTRD(2)="No^charge out pull lists directly"
SET RTRD("B")=2
SET RTRD(0)="S"
SET RTRD("A")="Do you want to charge out records to a holding area? "
DO SET^RTRD
KILL RTRD
+1 if $EXTRACT(X)="^"
SET RTESC=""
if $EXTRACT(X)'="Y"
QUIT
+2 SET DIC="^RTV(195.9,"
SET DIC(0)="IDAEMLQ"
SET DIC("DR")="3////"_+RTAPL
SET DIC("S")="I $P(^(0),U,3)="_+RTAPL_" D DICS^RTDPA31"
SET DIC("V")="S RTA="_+RTAPL_" D DICV^RTDPA31 K RTA"
SET DIC("A")="Select HOLDING AREA: "
WRITE !
DO ^DIC
KILL DIC
+3 if Y<0
SET RTESC=""
if Y>0
SET RTB=+Y
QUIT
