source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOER3.m@ 893

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1PRCOER3 ;WIRMFO-EDI RECONCILLIATION REPORT ; [8/31/98 1:46pm]
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 I $S('$G(PRCOBEG):1,'$G(PRCOSTOP):1,'+$G(LIST):1,1:0) G STOP^PRCOER2
6 S ZTSAVE("PRCOBEG")=""
7 S ZTSAVE("PRCOSTOP")=""
8 S ZTSAVE("LIST")=""
9 S ZTSAVE("SENDER")=""
10 S ZTRTN="START^PRCOER3"
11 S ZTDESC="EC/EDI Reconciliation Report"
12 D ZIS^PRCOER2
13 I $G(POP) G STOP^PRCOER2
14 I $G(PRCOPOP) G STOP^PRCOER2
15 ;
16START ; enter from tasked job
17 ;
18 U IO
19 K ^TMP($J)
20 I $E(IOST,1,2)="C-" W @IOF
21 D UNLIST
22 ;
23 N A,HEADER
24 ;
25 ; Get all records between start and stop times for any sender.
26 ;
27 ; IN "AL" X-REF 2=PROGRESS LEVEL
28 ; A=INCOMMING TYPE OF TRANSACTION ('ACT' OR 'PRJ')
29 ; I=DATE/TIME PROCESSED
30 ; J=IEN OF FILE 443.75 RECORD
31 ;
32 I SENDER=0 F A="ACT","PRJ" D
33 . S I=PRCOBEG
34 . F S I=$O(^PRC(443.75,"AL",2,A,I)) Q:'I!(I>PRCOSTOP) D
35 . . S J=0
36 . . F S J=$O(^PRC(443.75,"AL",2,A,I,J)) Q:'J S PRCO(0)=$G(^PRC(443.75,J,0)),PRCO(1)=^(1) I PRCOA[$P(PRCO(0),U,4) D
37 . . . I $S($P(PRCO(0),U,4)']"":1,'$P(PRCO(0),U,7):1,'J:1,1:0) Q
38 . . . S ^TMP($J,$P(PRCO(0),U,4),$P(PRCO(0),U,7),J)=$P(PRCO(0),U,2)_U_$P(PRCO(1),U,2)_U_$P(PRCO(1),U)_U_$S($P(PRCO(1),U)="PRJ":$P(PRCO(1),U,7),1:"")
39 . . . Q
40 . . Q
41 . Q
42 ;
43SINGLE ; Come here from start to display a single SENDERs entries.
44 ;
45 ; IN "AL1" X-REF 2=PROGRESS LEVEL
46 ; S=SENDER
47 ; A=INCOMMING TYPE OF TRANSACTION ('ACT' OR 'PRJ')
48 ; I=DATE/TIME PROCESSED
49 ; J=IEN OF FILE 443.75 RECORD
50 ;
51 I SENDER>0 S S=SENDER F A="ACT","PRJ" D
52 . S I=PRCOBEG
53 . F S I=$O(^PRC(443.75,"AL1",2,S,A,I)) Q:'I!(I>PRCOSTOP) D
54 . . S J=0
55 . . F S J=$O(^PRC(443.75,"AL1",2,S,A,I,J)) Q:'J S PRCO(0)=$G(^PRC(443.75,J,0)),PRCO(1)=^(1) I PRCOA[$P(PRCO(0),U,4) D
56 . . . I $S($P(PRCO(0),U,4)']"":1,'$P(PRCO(0),U,7):1,'J:1,1:0) Q
57 . . . S ^TMP($J,$P(PRCO(0),U,4),$P(PRCO(0),U,7),J)=$P(PRCO(0),U,2)_U_$P(PRCO(1),U,2)_U_$P(PRCO(1),U)_U_$S($P(PRCO(1),U)="PRJ":$P(PRCO(1),U,7),1:"")
58 . . . Q
59 . . Q
60 . Q
61 ;
62 D WRITE
63 K ^TMP($J)
64 G STOP^PRCOER2
65 ;
66UNLIST ; take LIST variable from PRCOER1 and convert to user selection
67 ; returns PRCOA with transaction type delimited by '^'
68 ;
69 ; 1 = PHA
70 ; 2 = RFQ
71 ; 3 = TXT
72 ; 7 = ALL of the above (1,2,3,)
73 ;
74 K PRCOA
75 I '+$G(LIST) K LIST Q
76 I +LIST=7 S PRCOA="PHA^RFQ" Q
77 N I,J,K
78 S J=""
79 F I=1:1 S J=$P(LIST,",",I) Q:J']"" D
80 . S K=$S(J=1:"PHA",J=2:"RFQ",J=3:"TXT",1:"") D
81 .. S PRCOA=$S($G(PRCOA)]"":PRCOA_U_K,1:K)
82 Q
83 ;
84PHA ; call to retrieve PHA records to display
85 Q
86HED ; write header for report
87 W !!
88 S HEADER=$S(SENDER=0:"EC/EDI RECONCILIATION REPORT",1:"EC/EDI RECONCILIATION REPORT for "_$P($G(^VA(200,SENDER,0)),U))
89 W $$CJ^XLFSTR(HEADER,80),!
90 W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",$L(HEADER)),80),!
91 W !?2,"Date Range for Report: ",$$FMTE^XLFDT(PRCOBEG)_" to "_$$FMTE^XLFDT(PRCOSTOP),!
92 W !,"TRANS",?7,"DOCUMENT #",?32,"TRANSACTION",?55,"AUSTIN ACCEPTANCE",!,"TYPE",?35,"DATE",?62,"DATE",!,$$REPEAT^XLFSTR("-",$S($G(IOM):IOM,1:79)),!
93 Q
94WRITE ; write out record to report sorted by transaction type and date
95 ; stored in ^TMP($J,Transaction Type,Trans.date,ien)=PO/RFQ^austin date^incoming transaction^reject code
96 ;
97 D HED
98 I $O(^TMP($J,0))']"" W !,"No transactions for the date range selected.",! Q
99 N I,J,K
100 S I=""
101 S (J,K)=0
102 F S I=$O(^TMP($J,I)) Q:I=""!($G(PRCOUT)) D
103 . F S J=$O(^TMP($J,I,J)) Q:'J!($G(PRCOUT)) D
104 . . F S K=$O(^TMP($J,I,J,K)) Q:'K!($G(PRCOUT)) D
105 . . . I $G(^TMP($J,I,J,K))]"" S K(0)=^(K) D Q:$G(PRCOUT)
106 . . . . W !,I,?7,$P(K(0),U),?32,$$FMTE^XLFDT(J,"2P"),?55,$$FMTE^XLFDT($P(K(0),U,2),"2P")
107 . . . . I $P(K(0),U,3)="PRJ" D
108 . . . . . W !?2,"** REJECT CODE==> ",$P($G(^PRC(443.76,+$P(K(0),U,4),0)),U,2)
109 . . . . D HANG Q:$G(PRCOUT)
110 . . . Q
111 . . Q
112 . Q
113 Q
114 ;
115HANG ; call at end of screen if output sent to CRT
116 ; returns PRCOUT=1 if user exits(^,timeout)
117 N DIRUT,DUOUT,DTOUT
118 K PRCOUT
119 I ($Y+5)>IOSL,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:'Y PRCOUT=1 Q:$G(PRCOUT)
120 I $Y+5>IOSL W @IOF D HED
121 Q
Note: See TracBrowser for help on using the repository browser.