RTP40.m

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 ---RTP40   1231     printed  Feb 19, 2025@00:00:49                                                                                                                                                                                                       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