source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUDCT1.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PRCUDCT1 ;WISC/LEM-Index FMS Document Transaction Rejects ;5/24/94 9:05 AM
2V ;;5.0;IFCAP;;4/21/95
3 ; This is a utility routine not accessible through IFCAP menus.
4 Q
5PERROR ; Process Errors
6 N XMDUN,XMSUB,XMTEXT,XMB,XMY,XMZ S PRCEND=""
7 ;I $D(PRCMG) S:PRCMG'["G." PRCMG="G."_PRCMG S X=PRCMG,XMDUZ="IFCAP FMS MESSAGE SERVER" D WHO^XMA21 D
8 ;.I Y=-1 S PRCXM(2)=$P($T(ERROR+1),";;",2)_" "_PRCMG,(PRETRY,XMY(.5))=""
9 ;I '$D(PRCMG) S PRCXM(2)=$P($T(ERROR+2),";;",2),XMY(.5)=""
10 D EMFORM ;S XMDUN="IFCAP SERVER ERROR"
11 ;S XMSUB="Document Confirmation Transaction"
12 ;S XMTEXT="PRCXM("
13 ;D ^XMD
14 K PRCXM Q
15ERROR ;
16 ;;Mailgroup members designated in file 423.5:
17 ;;Transaction control segment is messed up.
18EMFORM ;
19 I $D(PRCDA),$D(^PRCF(423.6,PRCDA,1,10000,0)) N I,J D
20 .N THDR,TDATE,Y S THDR=^PRCF(423.6,PRCDA,1,10000,0)
21 .S Y=$P(THDR,U,10),Y=($E(Y,1,4)-1700)_$E(Y,5,8) D DD^%DT S TDATE=Y
22 .F I=1:1 S J=$O(PRCXM(I)) Q:J=""
23 .S I=I+1,PRCXM(I)=" ",I=I+1,PRCXM(I)=" System ID: "_$P(THDR,U,2),I=I+1
24 .S PRCXM(I)=" ",I=I+1,PRCXM(I)=" Receiving Station #: "_$P(THDR,U,4)_" "_"Transaction Code : "_$P(THDR,U,5),I=I+1
25 .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
26 .I $L($P(THDR,U,9))>0 S PRCXM(I)=" ",I=I+1,PRCXM(I)=" Sales or Order #: "_$P(THDR,U,9),I=I+1
27 .S PRCXM(I)=" ",I=I+1,PRCXM(I)=" Interface Version #: "_$P(THDR,U,14)_" Message File #: "_PRCDA
28 .Q
29A N LN S DA=0 F S DA=$O(^PRCF(423.6,DA)) Q:+DA'=DA D ST
30 Q
31ST S LN=10001
32 S CTL=$G(^PRCF(423.6,DA,1,10000,0)) Q:CTL=""!($P(CTL,U,5)'="DCT")
33 S DOC=$P(CTL,U,6)
34DO F S LN=$O(^PRCF(423.6,DA,1,LN)) Q:LN="" S LIN=$G(^(LN,0)) D
35 . Q:"~"[$P(LIN,U,2) S SEG=$P(LIN,U,1)
36 . I SEG="ER1"!(SEG="ER2") D Q
37 . . N E,EC,EM F E=1:1:5 S EC=$P(LIN,U,E*2) Q:"~"[EC D
38 . . . S EM=$P(LIN,U,E*2+1) S SUB=DOC_" "_EC,^ZLX(SUB)=EM
39 . . . Q
40 . . Q
41 . I SEG="DCL" D Q
42 . . N S,STATUS S S=$P(LIN,U,3)
43 . . S STATUS=$S(S="A":"Accepted.",S="R":"Rejected:",1:"unknown.")
44 . . S PRCXM(I)=" ",PRCXM(I+1)=" Line "_$P(LIN,U,5)_" "_STATUS
45 . . S PRCXM(I+2)=" ",I=I+3
46 . . Q
47 . I SEG="DCD" D Q
48 . . N S,STATUS S S=$P(LIN,U,3)
49 . . S STATUS=$S(S="A":"Accepted.",S="R":"Rejected:",1:"unknown.")
50 . . S PRCXM(I+1)=" FMS Document "_$P(LIN,U,6)_"-"_$P(LIN,U,7)_" "_STATUS
51 . . S PRCXM(I)=" ",PRCXM(I+2)=" ",I=I+3
52 . . Q
53 . Q
54 Q
55TFILER ; Transaction Filer
56 N OK,REM,REM1
57 I PRCDA=0 D
58 .L +^PRCF(423.6,0):5 I '$T S X="FMS Transaction file unavailable - File Lock Timeout.*" D MSG^PRCFQ Q
59 .F CNT=1:1 Q:'$D(^PRCF(423.6,CNT,0))
60 .S $P(^PRCF(423.6,0),U,3)=CNT,PRCDA=CNT,$P(^(0),U,4)=$P(^(0),U,4)+1 L +^PRCF(423.6,PRCDA)
61 .S ^PRCF(423.6,PRCDA,0)=PRCKEY,^PRCF(423.6,"B",PRCKEY,PRCDA)="",$P(^PRCF(423.6,PRCDA,1,0),U,2)=$P(^DD(423.6,1,0),U,2) K CNT L -^PRCF(423.6,0) L -^PRCF(423.6,PRCDA)
62 L +^PRCF(423.6,PRCDA):5 I '$T S X="FMS Transaction record unavailable - File lock timeout.*" D MSG^PRCFQ Q
63 N II,LEN,OCNT,SCNT S (OCNT,SCNT)=10000*(+$P(XMRG,U,12)) I +$P(XMRG,U,12)=1 S ^PRCF(423.6,PRCDA,1,SCNT,0)=XMRG,SCNT=SCNT+1
64 S (OK,REM,REM1,S1)="" F D Q:XMER'=0 I S1>0 Q
65 .S:REM["}" S1=2 Q:REM["}" S:XMRG["{" S1=1,XMRG="" X:S1="" XMREC Q:XMER<0
66 .S:$L(REM)+$L(REM1)<241 REM=REM_REM1,REM1="" S:$L(REM)+$L(XMRG)<241 XMRG=REM_XMRG,REM="" I $L(REM)+$L(XMRG)>240 S REM1=$E(XMRG,241-$L(REM),$L(XMRG)),XMRG=REM_$E(XMRG,1,240-$L(REM))
67 .S LEN=$F(XMRG,"~")
68 .I LEN>1,LEN<241 S ^PRCF(423.6,PRCDA,1,SCNT,0)=$E(XMRG,1,LEN-1),SCNT=SCNT+1,REM=$E(XMRG,LEN,$L(XMRG)) Q
69 .I $L(XMRG)>0,$L(XMRG)<241 S ^PRCF(423.6,PRCDA,1,SCNT,0)=XMRG,SCNT=SCNT+1,REM="" Q
70 .I $E(XMRG,1,240)["^" F II=240:-1:1 I $E(XMRG,II)="^" S ^PRCF(423.6,PRCDA,1,SCNT,0)=$E(XMRG,1,II),SCNT=SCNT+1,REM=$E(XMRG,II+1,$L(XMRG)),OK=1 Q
71 .Q:OK=1 F II=240:-1:1 I $E(XMRG,II)=" " S ^PRCF(423.6,PRCDA,1,SCNT,0)=$E(XMRG,1,II),REM=$E(XMRG,II+1,$L(XMRG)) Q
72 .Q
73 S $P(^PRCF(423.6,PRCDA,1,0),U,3)=SCNT-1,$P(^(0),U,4)=(SCNT-OCNT)+$P(^(0),U,4) L -^PRCF(423.6,PRCDA) Q
Note: See TracBrowser for help on using the repository browser.