| 1 | PRCODCT1 ;WISC/DJM-Server interface to IFCAP from FMS ;5/30/95 1:22 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | PERROR ; Process Errors
|
|---|
| 6 | N XMDUN,XMSUB,XMTEXT,XMB,XMY,XMZ,PRCEND,E,EC,LIN,S,SEG,STOP,XMCHAN,XMDUZ
|
|---|
| 7 | S PRCEND=""
|
|---|
| 8 | I $D(PRCMG) S:PRCMG'["G." PRCMG="G."_PRCMG ; S X=PRCMG
|
|---|
| 9 | S XMDUZ="IFCAP FMS MESSAGE SERVER",XMCHAN=1
|
|---|
| 10 | ;D WHO^XMA21 D
|
|---|
| 11 | ;.I Y=-1 S PRCXM(2)=$P($T(ERROR+1),";;",2)_" "_PRCMG,(PRETRY,XMY(.5))=""
|
|---|
| 12 | I '$D(PRCMG) S PRCXM(2)=$P($T(ERROR+2),";;",2),XMY(.5)=""
|
|---|
| 13 | D EMFORM S XMDUN="IFCAP SERVER ERROR"
|
|---|
| 14 | S XMSUB="Document Confirmation Transaction (DCT)"
|
|---|
| 15 | S XMTEXT="PRCXM(",XMY(PRCMG)=""
|
|---|
| 16 | D ^XMD
|
|---|
| 17 | K PRCXM
|
|---|
| 18 | Q
|
|---|
| 19 | ERROR ;
|
|---|
| 20 | ;;No mailgroup members designated in
|
|---|
| 21 | ;;There is no mailgroup listed for CTL-DCT in file 423.5.
|
|---|
| 22 | EMFORM ;
|
|---|
| 23 | I $D(PRCDA),$D(^PRCF(423.6,PRCDA,1,10000,0)) N I,J D
|
|---|
| 24 | .N THDR,TDATE,Y S THDR=^PRCF(423.6,PRCDA,1,10000,0)
|
|---|
| 25 | .S Y=$P(THDR,U,10),Y=($E(Y,1,4)-1700)_$E(Y,5,8) D DD^%DT S TDATE=Y
|
|---|
| 26 | .F I=1:1 S J=$O(PRCXM(I)) Q:J=""
|
|---|
| 27 | .S I=I+1,PRCXM(I)=" ",I=I+1,PRCXM(I)=" System ID: "_$P(THDR,U,2),I=I+1
|
|---|
| 28 | .S PRCXM(I)=" ",I=I+1,PRCXM(I)=" Receiving Station #: "_$P(THDR,U,4)_" "_"Transaction Code : "_$P(THDR,U,5),I=I+1
|
|---|
| 29 | .S PRCXM(I)=" ",I=I+1,PRCXM(I)=" Transaction Date : "_TDATE_" "_"Transaction Time : "_$E($P(THDR,U,11),1,2)_":"_$E($P(THDR,U,11),3,4)_":"_$E($P(THDR,U,11),5,6),I=I+1
|
|---|
| 30 | .S PRCXM(I)=" ",I=I+1,PRCXM(I)=" Interface Version #: "_$P(THDR,U,14),I=I+1
|
|---|
| 31 | .Q
|
|---|
| 32 | S LN=DOCLN,STOP=0
|
|---|
| 33 | DO F S LN=$O(^PRCF(423.6,PRCDA,1,LN)) Q:LN="" Q:LN=LINE S LIN=$G(^(LN,0)) D Q:STOP=1
|
|---|
| 34 | . S SEG=$P(LIN,U,1)
|
|---|
| 35 | . I LN>DOCLN,(SEG="DOC") S STOP=1 Q
|
|---|
| 36 | . Q:"~"[$P(LIN,U,2)
|
|---|
| 37 | . I SEG="ER1"!(SEG="ER2") D Q
|
|---|
| 38 | . . N E,EC,EM F E=1:1:5 S EC=$P(LIN,U,E*2) Q:"~"[EC D
|
|---|
| 39 | . . . S EM=$P(LIN,U,E*2+1),PRCXM(I)=" "_EC_" "_EM,I=I+1
|
|---|
| 40 | . . . Q
|
|---|
| 41 | . . Q
|
|---|
| 42 | . I SEG="DCL" D Q
|
|---|
| 43 | . . N S,STATUS S S=$P(LIN,U,3)
|
|---|
| 44 | . . S STATUS=$S(S="A":"Accepted.",S="R":"Rejected:",1:"unknown.")
|
|---|
| 45 | . . S PRCXM(I)=" ",PRCXM(I+1)=" Line "_$P(LIN,U,5)_" "_STATUS
|
|---|
| 46 | . . S I=I+2
|
|---|
| 47 | . . Q
|
|---|
| 48 | . I SEG="DCD" D Q
|
|---|
| 49 | . . N S,STATUS S S=$P(LIN,U,3)
|
|---|
| 50 | . . S STATUS=$S(S="A":"Accepted.",S="R":"Rejected:",1:"unknown.")
|
|---|
| 51 | . . S PRCXM(I)=" ",PRCXM(I+1)=" FMS Document "_DOCID_" "_STATUS
|
|---|
| 52 | . . S I=I+2
|
|---|
| 53 | . Q
|
|---|
| 54 | Q
|
|---|
