| [613] | 1 | PRCFACR1 ;WISC/CTB/CLH/BGJ-PRINT TRANSMISSION AND SENT MESSAGES TO XM ;4/30/93 2:38 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | K ^TMP($J)
|
|---|
| 5 | I $D(ZTQUEUED) D DT^DICRW,KILL^%ZTLOAD
|
|---|
| 6 | F I=1:1 S PBATN=$O(^PRCF(421.2,"AD",PRCFKEY,0)) Q:+PBATN=0 S PBAT=$P(^PRCF(421.2,PBATN,0),"^") D BLIST K ^PRCF(421.2,"AD",PRCFKEY,PBATN) S $P(^PRCF(421.2,PBATN,0),"^",15)="",I=1
|
|---|
| 7 | SE K ^TMP("PRCFBTCH",$J) S IOP=$S($D(ION):ION,1:IO) D NOW^%DTC
|
|---|
| 8 | S DIC="^PRCF(423,",L=0,BY="[PRCFA BATCH TRANSMIT SORT]",FLDS="[PRCFA BTCH TRANSMIT]",(FR,TO)=PRCFKEY D EN1^DIP
|
|---|
| 9 | XM ;THIS SECTION WILL TAKE THE GLOBALS CREATED BY THE FILE MANAGER AND PASS THEM TO MAILMAN FOR DELIVERY TO AUSTIN.
|
|---|
| 10 | S N=0 F I=1:1 S N=$O(^TMP("PRCFBTCH",$J,N)) Q:N'=+N S PTYP=$O(^PRCF(423.9,"AC",N,0)) Q:PTYP="" I $P(^PRCF(423.9,PTYP,0),"^",4)["Y" D TYPE
|
|---|
| 11 | S N=0 F I=1:1 S N=$O(^PRCF(423,"AK",PRCFKEY,N)) Q:'N S $P(^PRCF(423,N,"TRANS"),"^",11)=""
|
|---|
| 12 | K ^PRCF(423,"AK",PRCFKEY),%,%DT,%I,BATCH,BATTYPE,DP,I,J,K,L,M,N,PRCFX,PTYP,X,Y,Z1,Z2
|
|---|
| 13 | OUT K %H,%Y,A,ADD,B,C,DIC,DIJ,DQTIME,ER,FAIL,POP,POK,PTR,PTRN,PBAT,PBATN,PRCFRT,X1,XMDUZ,XMDT,XMM,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,XMY,IOX,IOY,XMZ,^PRCF("LIST"),^TMP("PRCFBTCH",$J),PRCFKEY Q
|
|---|
| 14 | Q
|
|---|
| 15 | TYPE ;PROCESS ALL BATCH TYPE TO MAIL MAN
|
|---|
| 16 | S M=0 F J=1:1 S M=$O(^TMP("PRCFBTCH",$J,N,M)) Q:M="" D:"3,1,4,2,9,10,12"[N SHRINK D HEADER,CREATE
|
|---|
| 17 | Q
|
|---|
| 18 | CREATE ;CREATES MESSAGE FOR INDIVIDUAL BATCH
|
|---|
| 19 | ;ENTER THEM INTO MAIL MAN MESSAGES
|
|---|
| 20 | ;I '$D(DUZ) S DUZ=.5
|
|---|
| 21 | ;I DUZ="" S DUZ=.5
|
|---|
| 22 | Q:'$D(^PRCF(423.9,PTYP,0)) S:$P(^(0),"^",2)]"" @("XMY("_""""_$P(^(0),U,2)_""""_")=""""") S:$G(PRCFA("EDI"))]"" XMY(PRCFA("EDI"))="" K PRCFA("EDI") D
|
|---|
| 23 | .Q:'$D(^PRCF(423.9,PTYP,1,0)) D
|
|---|
| 24 | ..S L=0 F K=1:1 S L=$O(^PRCF(423.9,PTYP,1,L)) Q:L'=+L I $D(^PRCF(423.9,PTYP,1,L,0)) S ADD=$P(^(0),"^",1) S XMY(ADD)=""
|
|---|
| 25 | S XMDUZ=DUZ,XMSUB="FEE/FEN/LOG/ISM/EDI BATCH "_MM,XMTEXT="^TMP(""PRCFBTCH"","_$J_","_N_","""_M_""","
|
|---|
| 26 | D XMD
|
|---|
| 27 | I $D(M),M["" S X=$O(^PRCF(421.2,"B",M,0)) Q:X=""
|
|---|
| 28 | S:$D(^PRCF(421.2,X,0)) $P(^(0),"^",12)=XMZ,^PRCF(421.2,"D",XMZ,X)="" Q
|
|---|
| 29 | XMD N I,J,M,N D ^XMD Q
|
|---|
| 30 | BLIST ;PLACE ALL CODE SHEETS IN A BATCH ON TRANSMISSION LIST
|
|---|
| 31 | 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",PRCFKEY,N)="",$P(^PRCF(423,N,"TRANS"),"^",11)=PRCFKEY
|
|---|
| 32 | Q:+PBATN'>0
|
|---|
| 33 | S DA=PBATN
|
|---|
| 34 | I '$D(PRC("PER")) D DUZ^PRCFSITE Q:'%
|
|---|
| 35 | S:$D(P) PX=P
|
|---|
| 36 | D NOW^%DTC
|
|---|
| 37 | S XDT=%
|
|---|
| 38 | S X1=$P(PRC("PER"),"^",2)
|
|---|
| 39 | S $P(^PRCF(421.2,DA,0),"^",4)=XDT
|
|---|
| 40 | K XDT
|
|---|
| 41 | S MESSAGE=""
|
|---|
| 42 | I PRCFRT=0 D ENCODE^PRCFAES1(DA,DUZ,.MESSAGE)
|
|---|
| 43 | I PRCFRT=3 D ENCODE^PRCFAES2(DA,DUZ,.MESSAGE)
|
|---|
| 44 | K MESSAGE
|
|---|
| 45 | K P I $D(PX) S P=PX K PX Q
|
|---|
| 46 | Q
|
|---|
| 47 | SHRINK ;TAKE 4th '-' PIECE OF BATCH NUMBER AND MAKE IT INTO MMCCC
|
|---|
| 48 | ; WHERE MM = MONTH
|
|---|
| 49 | ; CCC = LAST 3 DIGITS OF COUNTER VALUE
|
|---|
| 50 | N SHRINK,SHRINK1,SHRINK2
|
|---|
| 51 | S SHRINK=$G(^TMP("PRCFBTCH",$J,N,M,1,0)) Q:SHRINK="" I $P(SHRINK,".",3)=999 S SHRINK1=$P(SHRINK,".",6),SHRINK2=$E(SHRINK1,1,2)_$E(SHRINK1,$L(SHRINK1)-2,99),$P(SHRINK,".",6)=SHRINK2,^TMP("PRCFBTCH",$J,N,M,1,0)=SHRINK
|
|---|
| 52 | Q
|
|---|
| 53 | HEADER ;DO THE SAME THING TO THE MESSAGE HEADER AS 'SHRINK' DOES TO THE BATCH NUMBER.
|
|---|
| 54 | N M1,M2
|
|---|
| 55 | S M1=$P(M,"-",4),M2=$E(M1,1,2)_$E(M1,$L(M1)-2,99),MM=$P(M,"-",1,3)_"-"_M2 Q
|
|---|
