| [613] | 1 | PRCFACR0 ;WISC@ALTOONA/CTB-CONTINUATION OF PRCFACR ;4/30/93 3:05 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | I '$D(^PRCF(421.2,"AD",PRCFKEY)) W !!,"NO BATCHES SELECTED OPTION ABORTED",$C(7) G OUT
|
|---|
| 5 | F I=1:1 S PBATN=$O(^PRCF(421.2,"AD","Y",0)) Q:+PBATN=0 S PBAT=$P(^PRCF(421.2,PBATN,0),"^") D BLIST K ^PRCF(421.2,"AD","Y",PBATN) S I=1
|
|---|
| 6 | S ZTSAVE("PRCFRT")="",ZTSAVE("PRCFASYS")="",ZTSAVE("PRCFKEY")="",ZTRTN="^PRCFACR1",ZTDESC="TRANSMIT "_$S(PRCFASYS["LOG":"LOG ",PRCFASYS["ISM":"ISM ",PRCFASYS["EDI":"EDI ",1:"")_"CODE SHEETS" D ^PRCFQ
|
|---|
| 7 | OUT K %,%DT,%H,%Y,A,B,C,DIC,DIJ,DQTIME,ER,FAIL,I,N,POP,POK,PTR,PTRN,PBAT,PBATN,PFLAG,RT,X,X1,XMDUZ,XMDT,XMM,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,IOX,IOY,XMZ,Y,^PRCF("LIST") Q
|
|---|
| 8 | F I=1:1 S PBATN=$O(^PRCF(421.2,"AD","Y",0)) Q:+PBATN=0 S PBAT=$P(^PRCF(421.2,PBATN,0),"^") D BLIST K ^PRCF(421.2,"AD","Y",PBATN) S I=1
|
|---|
| 9 | BLIST I $D(^PRCF(423,"AD",PBAT)) S N=0 F I=1:1 S N=$O(^PRCF(423,"AD",PBAT,N)) Q:N'=+N S ^PRCF(423,"AK","Y",N)="",$P(^PRCF(423,N,"TRANS"),"^",11)="Y" W "."
|
|---|
| 10 | I +PBATN>0 S DA=PBATN D Q15
|
|---|
| 11 | Q
|
|---|
| 12 | Q15 I '$D(PRC("PER")) D DUZ^PRCFSITE Q:'%
|
|---|
| 13 | S:$D(P) PX=P
|
|---|
| 14 | D NOW^%DTC
|
|---|
| 15 | S XDT=%
|
|---|
| 16 | S X1=$P(PRC("PER"),"^",2)
|
|---|
| 17 | S $P(^PRCF(421.2,DA,0),"^",4+PRCFRT)=XDT
|
|---|
| 18 | K XDT
|
|---|
| 19 | S MESSAGE=""
|
|---|
| 20 | I PRCFRT=0 D ENCODE^PRCFAES1(DA,DUZ,.MESSAGE)
|
|---|
| 21 | I PRCFRT=3 D ENCODE^PRCFAES2(DA,DUZ,.MESSAGE)
|
|---|
| 22 | K MESSAGE
|
|---|
| 23 | K P S:$D(PX) P=PX Q
|
|---|
| 24 | Q
|
|---|
