source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOER2.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1PRCOER2 ;WISC-EDI REPORTS USING LIST MANAGER CONT ; [8/31/98 1:42pm]
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 D FULL^VALM1
6 W @IOF
7 N PRCOBEG,PRCOSTOP
8 D RT^PRCOER1 ; ask user date range
9 I $S('$G(PRCOBEG):1,'$G(PRCOSTOP):1,1:0) G STOP
10 ;
11 N A,HEADER
12 S A(1)="Your selection will generate the Transaction Summary Statistical Report"
13 S A(2)="for the following date range: "_$$FMTE^XLFDT(PRCOBEG,"2D")_" - "_$$FMTE^XLFDT(PRCOSTOP,"2D")
14 D EN^DDIOL(.A)
15 W !!
16 S DIR(0)="Y",DIR("A")="Want to continue",DIR("B")="Yes"
17 D ^DIR K DIR G STOP:$D(DIRUT)!'Y
18 ;
19 ; ask user for output device - home or printer
20 ;
21 S ZTSAVE("PRCOBEG")=""
22 S ZTSAVE("PRCOSTOP")=""
23 S ZTSAVE("SENDER")=""
24 S ZTRTN="EN^PRCOER2"
25 S ZTDESC="Transaction Summary Statistics Report"
26 D ZIS
27 I $G(POP) G STOP
28 G STOP:$G(PRCOPOP)
29 ;
30EN ; enter from tasked job
31 U IO
32 I $E(IOST,1,2)="C-" W @IOF
33 S (ACNT,PCNT,TCNT)=0
34 I SENDER=0 F A="ACT","PRJ" S I=PRCOBEG F S I=$O(^PRC(443.75,"AL",2,A,I)) Q:'I!(I>PRCOSTOP) D
35 . S J=0 F S J=$O(^PRC(443.75,"AL",2,A,I,J)) Q:'J D
36 . . I A="ACT" S ACNT=ACNT+1
37 . . I A="PRJ" S PCNT=PCNT+1
38 . . S TCNT=TCNT+1
39 ;
40 I SENDER>0 F A="ACT","PRJ" S I=PRCOBEG F S I=$O(^PRC(443.75,"AL1",2,SENDER,A,I)) Q:'I!(I>PRCOSTOP) D
41 . S J=0 F S J=$O(^PRC(443.75,"AL1",2,SENDER,A,I,J)) Q:'J D
42 . . I A="ACT" S ACNT=ACNT+1
43 . . I A="PRJ" S PCNT=PCNT+1
44 . . S TCNT=TCNT+1
45 ;
46EN1 ; those transactions still waiting Austin feedback
47 ;
48 S (PHA,RFQ,TXT,NOTCNT)=0
49 I SENDER=0 F A="PHA","RFQ","TXT" S I=PRCOBEG F S I=$O(^PRC(443.75,"AJ",1,A,I)) Q:'I!(I>PRCOSTOP) D
50 . S J=0 F S J=$O(^PRC(443.75,"AJ",1,A,I,J)) Q:'J D
51 . . I A="PHA" S PHA=PHA+1
52 . . I A="RFQ" S RFQ=RFQ+1
53 . . I A="TXT" S TXT=TXT+1
54 . . S NOTCNT=NOTCNT+1
55 ;
56 I SENDER>0 F A="PHA","RFQ","TXT" S I=PRCOBEG F S I=$O(^PRC(443.75,"AJ1",1,SENDER,A,I)) Q:'I!(I>PRCOSTOP) D
57 . S J=0 F S J=$O(^PRC(443.75,"AJ1",1,SENDER,A,I,J)) Q:'J D
58 . . I A="PHA" S PHA=PHA+1
59 . . I A="RFQ" S RFQ=RFQ+1
60 . . I A="TXT" S TXT=TXT+1
61 . . S NOTCNT=NOTCNT+1
62 ;
63 ; write out summary results and quit
64 ;
65 D HED
66 W !,"Summary of Processed Records: ",!
67 W !?5,"# of accepted (ACT) records - ",$J(ACNT,8)
68 W !?5,"# of rejected (RJT) records - ",$J(PCNT,8)
69 W !?35,"---------"
70 W !?35,$J(TCNT,8),!
71 ;
72 W !,"Summary of Transactions Waiting Austin Processing",!
73 W !?5,"# of PHA records - ",$J(PHA,8)
74 W !?5,"# of RFQ records - ",$J(RFQ,8)
75 W !?5,"# of TXT records - ",$J(TXT,8)
76 W !?23,"---------"
77 W !?24,$J(NOTCNT,8)
78 ;
79STOP ; quit and return to listman
80 S:$D(ZTQUEUED) ZTREQ="@"
81 I '$D(ZTQUEUED) D CLOSE
82 K I,ACNT,PCNT,TCNT,PHA,RFQ,TXT,NOTCNT,PRCOPOP,PRCOBEG,PRCOSTOP,PRCOUT,PRCOA
83 S VALMBCK="R",VALMBG=1
84 W !
85 I $E(IOST,1,2)="C-" D PAUSE^PRCOER
86 Q
87 ;
88HED ; header for report
89 W !!
90 S HEADER=$S(SENDER=0:"TRANSACTION SUMMARY STATISTICS REPORT",1:"TRANSACTION SUMMARY STATISTICS REPORT for "_$P($G(^VA(200,SENDER,0)),U))
91 W $$CJ^XLFSTR(HEADER,80),!
92 W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",$L(HEADER)),80),!
93 W !?2,"Date Range for Report: ",$$FMTE^XLFDT(PRCOBEG)_" to "_$$FMTE^XLFDT(PRCOSTOP),!!
94 Q
95 ;
96ZIS ; ASK DEVICE will return PRCOPOP if QUEUED
97 ;
98 K IOP,IO("Q"),PRCOPOP
99 W ! S %ZIS="QMP" D ^%ZIS Q:POP
1001 I $D(IO("Q")) S PRCOPOP=1 K IO("Q"),ZTIO D ^%ZTLOAD W:$D(ZTSK) !,"Request Queued",!,"Task #: ",$G(ZTSK) K ZTSK,ZTSAVE,ZTRTN,ZTIO D HOME^%ZIS
101 Q
102 ;
103CLOSE I '$D(ZTQUEUED) D ^%ZISC
104 K IOP,ZTDESC,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTDTH,PRCOPOP,POP
105 Q
106 ; THIS IS NOT USED CURRENTLY. MAY HAVE TO DELETE
107 ; this is called from the EDI protocols to display
108 ; variable PRCO = line tag in routine to execute
109 ;
110 D FULL^VALM1
111 ;
112EN2 N PRI,PRX
113 S VALMBCK="R"
114 D SEL^VALM2 G END:'$O(VALMY(0))
115 S PRI=0 F S PRI=$O(VALMY(0)) Q:'PRI I $D(^TMP("PRCOER",$J,PRI)) S PRX=^(PRI) D @PRCO D Q:'Y
116 . S DIR(0)="E"
117 . S DIR("A")="Press <ENTER> to "_$S($O(VALMY(PRI)):"view next selection",1:"return to list")
118 . D ^DIR K DIR
119 ;
120 Q
121END S VALMBCK="R"
122 Q
Note: See TracBrowser for help on using the repository browser.