source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFACR0.m@ 1710

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1PRCFACR0 ;WISC@ALTOONA/CTB-CONTINUATION OF PRCFACR ;4/30/93 3:05 PM
2V ;;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
7OUT 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
9BLIST 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
12Q15 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
Note: See TracBrowser for help on using the repository browser.