| 1 | PRCFAIS ;WISC/PEH-PACK ISM/EDI TRANSACTIONS INTO 32K SIZE MESSAGES ;5/18/93 09:05
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | N PRCFA0,PRCFAS,PRCFAD0,PRCFASEQ,PRCFASIZ,PRCFAS,VAR,LINE,PRCFAN,NAMES
|
|---|
| 5 | S PRCFAN=N,PTYP=$P(^PRCF(423,PRCFAN,"TRANS"),U,4) Q:'$D(^PRCF(423.9,PTYP,0)) I $P(^(0),"^",4)["Y" D
|
|---|
| 6 | .K ADD S ADD=$P($G(^PRCF(423.9,PTYP,0)),U,2) S:ADD]"" XMY(ADD)="" S:$G(PRCFA("EDI"))]"" XMY(PRCFA("EDI"))="" S:$G(PRCFA("ISM"))]"" XMY(PRCFA("ISM"))="" K PRCFA("EDI"),PRCFA("ISM")
|
|---|
| 7 | .K ADD I $D(^PRCF(423.9,PTYP,1,0)) S L=0 F 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),U,1) S XMY(ADD)=""
|
|---|
| 8 | .D USERS,GET
|
|---|
| 9 | .K NAMES S %X="XMY(",%Y="NAMES(" D %XY^%RCR
|
|---|
| 10 | .S (LINE,PRCFASIZ,PRCFAD0)=0,PRCFA0=$G(^PRCF(423,PRCFAN,"CODE",1,0))
|
|---|
| 11 | .F S PRCFAD0=$O(^PRCF(423,PRCFAN,"CODE",PRCFAD0)) Q:PRCFAD0="" S VAR=$G(^(PRCFAD0,0)) D:PRCFASIZ+$L(VAR)>30000 S LINE=LINE+1,^XMB(3.9,XMZ,2,LINE,0)=VAR,PRCFASIZ=PRCFASIZ+$L(VAR)
|
|---|
| 12 | ..S LINE=LINE+1,^XMB(3.9,XMZ,2,LINE,0)="~"
|
|---|
| 13 | ..S $P(PRCFASEQ,"^")=+$G(PRCFASEQ)+1,$P(PRCFASEQ,"^",PRCFASEQ+1)=LINE_";"_XMZ,PRCFASIZ=$L(PRCFA0),LINE=1 D GET Q
|
|---|
| 14 | .S $P(PRCFASEQ,"^")=+$G(PRCFASEQ)+1,$P(PRCFASEQ,"^",PRCFASEQ+1)=LINE_";"_XMZ
|
|---|
| 15 | .D MULTI
|
|---|
| 16 | .S:$D(PRCOPODA) $P(^PRC(442,PRCOPODA,12),"^",10)=XMZ
|
|---|
| 17 | .I $G(PBAT)["" S ZX=$O(^PRCF(421.2,"B",PBAT,0)) Q:ZX=""
|
|---|
| 18 | .S:$D(^PRCF(421.2,ZX,0)) $P(^(0),"^",12)=XMZ,$P(^(0),U,4)=DT,^PRCF(421.2,"D",XMZ,ZX)=""
|
|---|
| 19 | .S PRCOUT=1 K ZX
|
|---|
| 20 | .Q
|
|---|
| 21 | Q
|
|---|
| 22 | MULTI ;SET DOUCUMENT/SEQUENCE NUMBERS FOR MESSAGES
|
|---|
| 23 | N PRCFAR,PRCFANOD,PRCFAMSG,PRCFARS,PRCFASE1,PRCFASE2,VAR,I,J,K,L,M,N
|
|---|
| 24 | S PRCFASE2="000"_+$G(PRCFASEQ),PRCFASE2=$E(PRCFASE2,($L(PRCFASE2)-2),$L(PRCFASE2))
|
|---|
| 25 | F PRCFAR=1:1:+$G(PRCFASEQ) S PRCFASE1="000"_PRCFAR,PRCFASE1=$E(PRCFASE1,($L(PRCFASE1)-2),$L(PRCFASE1)),$P(PRCFA0,"^",8,9)=PRCFASE1_"^"_PRCFASE2,PRCFANOD=$P(PRCFASEQ,"^",(PRCFAR+1)) D
|
|---|
| 26 | .S LINE=$P(PRCFANOD,";",1),PRCFAMSG=$P(PRCFANOD,";",2) S ^XMB(3.9,PRCFAMSG,2,0)="^3.92A^"_LINE_"^"_LINE_"^"_DT,^XMB(3.9,PRCFAMSG,2,1,0)=PRCFA0
|
|---|
| 27 | F PRCFAR=1:1:+$G(PRCFASEQ) K XMY S XMZ=$P($P(PRCFASEQ,"^",(PRCFAR+1)),";",2),XMDUZ=DUZ,(XMDUN,XMSUB)="ISMS/EDI BATCH "_PBAT,%X="NAMES(",%Y="XMY(" D %XY^%RCR,ENT1^XMD
|
|---|
| 28 | Q
|
|---|
| 29 | USERS ;DEFINE MAILMAN VAR
|
|---|
| 30 | S XMDUZ=DUZ,(XMDUN,XMSUB)="ISMS/EDI BATCH "_PBAT
|
|---|
| 31 | Q
|
|---|
| 32 | GET ;GET XMZ VAR FROM MAILMAN
|
|---|
| 33 | F D XMZ^XMA2 Q:XMZ>0 H 5
|
|---|
| 34 | Q
|
|---|
| 35 | TX2 ;ENTER HERE TO SEND FEE, FEN, LOG, CAP OR IRS CODE SHEETS.
|
|---|
| 36 | N MM
|
|---|
| 37 | S ZZN=$P(^PRCF(423,N,"TRANS"),U,4),PTYP=$O(^PRCF(423.9,"AC",ZZN,0)) Q:PTYP="" Q:'$D(^PRCF(423.9,PTYP,0)) I $P(^(0),U,4)["Y" D Q
|
|---|
| 38 | .S M1=$P(PBAT,"-",4),M2=$E(M1,1,2)_$E(M1,$L(M1)-2,99),MM=$P(PBAT,"-",1,3)_"-"_M2 K M1,M2
|
|---|
| 39 | .K ZZN,ADD S ADD=$P($G(^PRCF(423.9,PTYP,0)),U,2) S:ADD]"" XMY(ADD)=""
|
|---|
| 40 | .K ADD I $D(^PRCF(423.9,PTYP,1,0)) S L=0 F 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),U),XMY(ADD)=""
|
|---|
| 41 | .S XMDUZ=DUZ,XMSUB="ISMS/EDI BATCH "_MM,XMTEXT="^PRCF(423,"_N_",""CODE""," D XMD
|
|---|
| 42 | .I $G(PBAT)["" S ZX=$O(^PRCF(421.2,"B",PBAT,0)) I ZX="" K ZX Q
|
|---|
| 43 | .S:$D(^PRCF(421.2,ZX,0)) $P(^(0),U,12)=XMZ,$P(^(0),U,4)=DT,^PRCF(421.2,"D",XMZ,ZX)=""
|
|---|
| 44 | .S PRCOUT=1 K ZX Q
|
|---|
| 45 | Q
|
|---|
| 46 | XMD N I,J,K,L,M,N
|
|---|
| 47 | D ^XMD
|
|---|
| 48 | S:$D(PRCOPODA) $P(^PRC(442,PRCOPODA,12),U,10)=XMZ
|
|---|
| 49 | Q
|
|---|
