source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCODCT1.m@ 1005

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PRCODCT1 ;WISC/DJM-Server interface to IFCAP from FMS ;5/30/95 1:22 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5PERROR ; 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
19ERROR ;
20 ;;No mailgroup members designated in
21 ;;There is no mailgroup listed for CTL-DCT in file 423.5.
22EMFORM ;
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
33DO 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
Note: See TracBrowser for help on using the repository browser.