PRCOER2 ;WISC-EDI REPORTS USING LIST MANAGER CONT ; [8/31/98 1:42pm]
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
D FULL^VALM1
W @IOF
N PRCOBEG,PRCOSTOP
D RT^PRCOER1 ; ask user date range
I $S('$G(PRCOBEG):1,'$G(PRCOSTOP):1,1:0) G STOP
;
N A,HEADER
S A(1)="Your selection will generate the Transaction Summary Statistical Report"
S A(2)="for the following date range: "_$$FMTE^XLFDT(PRCOBEG,"2D")_" - "_$$FMTE^XLFDT(PRCOSTOP,"2D")
D EN^DDIOL(.A)
W !!
S DIR(0)="Y",DIR("A")="Want to continue",DIR("B")="Yes"
D ^DIR K DIR G STOP:$D(DIRUT)!'Y
;
; ask user for output device - home or printer
;
S ZTSAVE("PRCOBEG")=""
S ZTSAVE("PRCOSTOP")=""
S ZTSAVE("SENDER")=""
S ZTRTN="EN^PRCOER2"
S ZTDESC="Transaction Summary Statistics Report"
D ZIS
I $G(POP) G STOP
G STOP:$G(PRCOPOP)
;
EN ; enter from tasked job
U IO
I $E(IOST,1,2)="C-" W @IOF
S (ACNT,PCNT,TCNT)=0
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
. S J=0 F S J=$O(^PRC(443.75,"AL",2,A,I,J)) Q:'J D
. . I A="ACT" S ACNT=ACNT+1
. . I A="PRJ" S PCNT=PCNT+1
. . S TCNT=TCNT+1
;
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
. S J=0 F S J=$O(^PRC(443.75,"AL1",2,SENDER,A,I,J)) Q:'J D
. . I A="ACT" S ACNT=ACNT+1
. . I A="PRJ" S PCNT=PCNT+1
. . S TCNT=TCNT+1
;
EN1 ; those transactions still waiting Austin feedback
;
S (PHA,RFQ,TXT,NOTCNT)=0
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
. S J=0 F S J=$O(^PRC(443.75,"AJ",1,A,I,J)) Q:'J D
. . I A="PHA" S PHA=PHA+1
. . I A="RFQ" S RFQ=RFQ+1
. . I A="TXT" S TXT=TXT+1
. . S NOTCNT=NOTCNT+1
;
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
. S J=0 F S J=$O(^PRC(443.75,"AJ1",1,SENDER,A,I,J)) Q:'J D
. . I A="PHA" S PHA=PHA+1
. . I A="RFQ" S RFQ=RFQ+1
. . I A="TXT" S TXT=TXT+1
. . S NOTCNT=NOTCNT+1
;
; write out summary results and quit
;
D HED
W !,"Summary of Processed Records: ",!
W !?5,"# of accepted (ACT) records - ",$J(ACNT,8)
W !?5,"# of rejected (RJT) records - ",$J(PCNT,8)
W !?35,"---------"
W !?35,$J(TCNT,8),!
;
W !,"Summary of Transactions Waiting Austin Processing",!
W !?5,"# of PHA records - ",$J(PHA,8)
W !?5,"# of RFQ records - ",$J(RFQ,8)
W !?5,"# of TXT records - ",$J(TXT,8)
W !?23,"---------"
W !?24,$J(NOTCNT,8)
;
STOP ; quit and return to listman
S:$D(ZTQUEUED) ZTREQ="@"
I '$D(ZTQUEUED) D CLOSE
K I,ACNT,PCNT,TCNT,PHA,RFQ,TXT,NOTCNT,PRCOPOP,PRCOBEG,PRCOSTOP,PRCOUT,PRCOA
S VALMBCK="R",VALMBG=1
W !
I $E(IOST,1,2)="C-" D PAUSE^PRCOER
Q
;
HED ; header for report
W !!
S HEADER=$S(SENDER=0:"TRANSACTION SUMMARY STATISTICS REPORT",1:"TRANSACTION SUMMARY STATISTICS REPORT for "_$P($G(^VA(200,SENDER,0)),U))
W $$CJ^XLFSTR(HEADER,80),!
W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",$L(HEADER)),80),!
W !?2,"Date Range for Report: ",$$FMTE^XLFDT(PRCOBEG)_" to "_$$FMTE^XLFDT(PRCOSTOP),!!
Q
;
ZIS ; ASK DEVICE will return PRCOPOP if QUEUED
;
K IOP,IO("Q"),PRCOPOP
W ! S %ZIS="QMP" D ^%ZIS Q:POP
1 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
Q
;
CLOSE I '$D(ZTQUEUED) D ^%ZISC
K IOP,ZTDESC,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTDTH,PRCOPOP,POP
Q
; THIS IS NOT USED CURRENTLY. MAY HAVE TO DELETE
; this is called from the EDI protocols to display
; variable PRCO = line tag in routine to execute
;
D FULL^VALM1
;
EN2 N PRI,PRX
S VALMBCK="R"
D SEL^VALM2 G END:'$O(VALMY(0))
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
. S DIR(0)="E"
. S DIR("A")="Press <ENTER> to "_$S($O(VALMY(PRI)):"view next selection",1:"return to list")
. D ^DIR K DIR
;
Q
END S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOER2 4020 printed Jan 18, 2025@03:13:07 Page 2
PRCOER2 ;WISC-EDI REPORTS USING LIST MANAGER CONT ; [8/31/98 1:42pm]
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 DO FULL^VALM1
+4 WRITE @IOF
+5 NEW PRCOBEG,PRCOSTOP
+6 ; ask user date range
DO RT^PRCOER1
+7 IF $SELECT('$GET(PRCOBEG):1,'$GET(PRCOSTOP):1,1:0)
GOTO STOP
+8 ;
+9 NEW A,HEADER
+10 SET A(1)="Your selection will generate the Transaction Summary Statistical Report"
+11 SET A(2)="for the following date range: "_$$FMTE^XLFDT(PRCOBEG,"2D")_" - "_$$FMTE^XLFDT(PRCOSTOP,"2D")
+12 DO EN^DDIOL(.A)
+13 WRITE !!
+14 SET DIR(0)="Y"
SET DIR("A")="Want to continue"
SET DIR("B")="Yes"
+15 DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
GOTO STOP
+16 ;
+17 ; ask user for output device - home or printer
+18 ;
+19 SET ZTSAVE("PRCOBEG")=""
+20 SET ZTSAVE("PRCOSTOP")=""
+21 SET ZTSAVE("SENDER")=""
+22 SET ZTRTN="EN^PRCOER2"
+23 SET ZTDESC="Transaction Summary Statistics Report"
+24 DO ZIS
+25 IF $GET(POP)
GOTO STOP
+26 if $GET(PRCOPOP)
GOTO STOP
+27 ;
EN ; enter from tasked job
+1 USE IO
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+3 SET (ACNT,PCNT,TCNT)=0
+4 IF SENDER=0
FOR A="ACT","PRJ"
SET I=PRCOBEG
FOR
SET I=$ORDER(^PRC(443.75,"AL",2,A,I))
if 'I!(I>PRCOSTOP)
QUIT
Begin DoDot:1
+5 SET J=0
FOR
SET J=$ORDER(^PRC(443.75,"AL",2,A,I,J))
if 'J
QUIT
Begin DoDot:2
+6 IF A="ACT"
SET ACNT=ACNT+1
+7 IF A="PRJ"
SET PCNT=PCNT+1
+8 SET TCNT=TCNT+1
End DoDot:2
End DoDot:1
+9 ;
+10 IF SENDER>0
FOR A="ACT","PRJ"
SET I=PRCOBEG
FOR
SET I=$ORDER(^PRC(443.75,"AL1",2,SENDER,A,I))
if 'I!(I>PRCOSTOP)
QUIT
Begin DoDot:1
+11 SET J=0
FOR
SET J=$ORDER(^PRC(443.75,"AL1",2,SENDER,A,I,J))
if 'J
QUIT
Begin DoDot:2
+12 IF A="ACT"
SET ACNT=ACNT+1
+13 IF A="PRJ"
SET PCNT=PCNT+1
+14 SET TCNT=TCNT+1
End DoDot:2
End DoDot:1
+15 ;
EN1 ; those transactions still waiting Austin feedback
+1 ;
+2 SET (PHA,RFQ,TXT,NOTCNT)=0
+3 IF SENDER=0
FOR A="PHA","RFQ","TXT"
SET I=PRCOBEG
FOR
SET I=$ORDER(^PRC(443.75,"AJ",1,A,I))
if 'I!(I>PRCOSTOP)
QUIT
Begin DoDot:1
+4 SET J=0
FOR
SET J=$ORDER(^PRC(443.75,"AJ",1,A,I,J))
if 'J
QUIT
Begin DoDot:2
+5 IF A="PHA"
SET PHA=PHA+1
+6 IF A="RFQ"
SET RFQ=RFQ+1
+7 IF A="TXT"
SET TXT=TXT+1
+8 SET NOTCNT=NOTCNT+1
End DoDot:2
End DoDot:1
+9 ;
+10 IF SENDER>0
FOR A="PHA","RFQ","TXT"
SET I=PRCOBEG
FOR
SET I=$ORDER(^PRC(443.75,"AJ1",1,SENDER,A,I))
if 'I!(I>PRCOSTOP)
QUIT
Begin DoDot:1
+11 SET J=0
FOR
SET J=$ORDER(^PRC(443.75,"AJ1",1,SENDER,A,I,J))
if 'J
QUIT
Begin DoDot:2
+12 IF A="PHA"
SET PHA=PHA+1
+13 IF A="RFQ"
SET RFQ=RFQ+1
+14 IF A="TXT"
SET TXT=TXT+1
+15 SET NOTCNT=NOTCNT+1
End DoDot:2
End DoDot:1
+16 ;
+17 ; write out summary results and quit
+18 ;
+19 DO HED
+20 WRITE !,"Summary of Processed Records: ",!
+21 WRITE !?5,"# of accepted (ACT) records - ",$JUSTIFY(ACNT,8)
+22 WRITE !?5,"# of rejected (RJT) records - ",$JUSTIFY(PCNT,8)
+23 WRITE !?35,"---------"
+24 WRITE !?35,$JUSTIFY(TCNT,8),!
+25 ;
+26 WRITE !,"Summary of Transactions Waiting Austin Processing",!
+27 WRITE !?5,"# of PHA records - ",$JUSTIFY(PHA,8)
+28 WRITE !?5,"# of RFQ records - ",$JUSTIFY(RFQ,8)
+29 WRITE !?5,"# of TXT records - ",$JUSTIFY(TXT,8)
+30 WRITE !?23,"---------"
+31 WRITE !?24,$JUSTIFY(NOTCNT,8)
+32 ;
STOP ; quit and return to listman
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$DATA(ZTQUEUED)
DO CLOSE
+3 KILL I,ACNT,PCNT,TCNT,PHA,RFQ,TXT,NOTCNT,PRCOPOP,PRCOBEG,PRCOSTOP,PRCOUT,PRCOA
+4 SET VALMBCK="R"
SET VALMBG=1
+5 WRITE !
+6 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^PRCOER
+7 QUIT
+8 ;
HED ; header for report
+1 WRITE !!
+2 SET HEADER=$SELECT(SENDER=0:"TRANSACTION SUMMARY STATISTICS REPORT",1:"TRANSACTION SUMMARY STATISTICS REPORT for "_$PIECE($GET(^VA(200,SENDER,0)),U))
+3 WRITE $$CJ^XLFSTR(HEADER,80),!
+4 WRITE $$CJ^XLFSTR($$REPEAT^XLFSTR("-",$LENGTH(HEADER)),80),!
+5 WRITE !?2,"Date Range for Report: ",$$FMTE^XLFDT(PRCOBEG)_" to "_$$FMTE^XLFDT(PRCOSTOP),!!
+6 QUIT
+7 ;
ZIS ; ASK DEVICE will return PRCOPOP if QUEUED
+1 ;
+2 KILL IOP,IO("Q"),PRCOPOP
+3 WRITE !
SET %ZIS="QMP"
DO ^%ZIS
if POP
QUIT
1 IF $DATA(IO("Q"))
SET PRCOPOP=1
KILL IO("Q"),ZTIO
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Request Queued",!,"Task #: ",$GET(ZTSK)
KILL ZTSK,ZTSAVE,ZTRTN,ZTIO
DO HOME^%ZIS
+1 QUIT
+2 ;
CLOSE IF '$DATA(ZTQUEUED)
DO ^%ZISC
+1 KILL IOP,ZTDESC,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTDTH,PRCOPOP,POP
+2 QUIT
+3 ; THIS IS NOT USED CURRENTLY. MAY HAVE TO DELETE
+4 ; this is called from the EDI protocols to display
+5 ; variable PRCO = line tag in routine to execute
+6 ;
+7 DO FULL^VALM1
+8 ;
EN2 NEW PRI,PRX
+1 SET VALMBCK="R"
+2 DO SEL^VALM2
if '$ORDER(VALMY(0))
GOTO END
+3 SET PRI=0
FOR
SET PRI=$ORDER(VALMY(0))
if 'PRI
QUIT
IF $DATA(^TMP("PRCOER",$JOB,PRI))
SET PRX=^(PRI)
DO @PRCO
Begin DoDot:1
+4 SET DIR(0)="E"
+5 SET DIR("A")="Press <ENTER> to "_$SELECT($ORDER(VALMY(PRI)):"view next selection",1:"return to list")
+6 DO ^DIR
KILL DIR
End DoDot:1
if 'Y
QUIT
+7 ;
+8 QUIT
END SET VALMBCK="R"
+1 QUIT
