source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTP40.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1RTP40 ;MJK/TROY ISC;Charge Out Pull List to Holding Area; ; 5/19/87 11:25 AM ;
2 ;;v 2.0;Record Tracking;**21**;10/22/91
3 K RTQ,RTPROV S X="CHARGE-OUT" D TYPE^RTT Q:'$D(RTMV) S Y=RTB D BOR^RTB S RTBNME=Y
4 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
5 K RTBNME,RTAG,RTMV,RTMV0 Q
6 ;
7HOLD 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
8 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,"'."
9 K RTCOMR,RTQX,RT Q
10 ;
11BOR 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
12 S:$E(X)="^" RTESC="" Q:$E(X)'="Y"
13 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
14 S:Y<0 RTESC="" S:Y>0 RTB=+Y Q
Note: See TracBrowser for help on using the repository browser.