PRCOER3 ;WIRMFO-EDI RECONCILLIATION REPORT ; [8/31/98 1:46pm]
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
I $S('$G(PRCOBEG):1,'$G(PRCOSTOP):1,'+$G(LIST):1,1:0) G STOP^PRCOER2
S ZTSAVE("PRCOBEG")=""
S ZTSAVE("PRCOSTOP")=""
S ZTSAVE("LIST")=""
S ZTSAVE("SENDER")=""
S ZTRTN="START^PRCOER3"
S ZTDESC="EC/EDI Reconciliation Report"
D ZIS^PRCOER2
I $G(POP) G STOP^PRCOER2
I $G(PRCOPOP) G STOP^PRCOER2
;
START ; enter from tasked job
;
U IO
K ^TMP($J)
I $E(IOST,1,2)="C-" W @IOF
D UNLIST
;
N A,HEADER
;
; Get all records between start and stop times for any sender.
;
; IN "AL" X-REF 2=PROGRESS LEVEL
; A=INCOMMING TYPE OF TRANSACTION ('ACT' OR 'PRJ')
; I=DATE/TIME PROCESSED
; J=IEN OF FILE 443.75 RECORD
;
I SENDER=0 F A="ACT","PRJ" D
. 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 S PRCO(0)=$G(^PRC(443.75,J,0)),PRCO(1)=^(1) I PRCOA[$P(PRCO(0),U,4) D
. . . I $S($P(PRCO(0),U,4)']"":1,'$P(PRCO(0),U,7):1,'J:1,1:0) Q
. . . 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:"")
. . . Q
. . Q
. Q
;
SINGLE ; Come here from start to display a single SENDERs entries.
;
; IN "AL1" X-REF 2=PROGRESS LEVEL
; S=SENDER
; A=INCOMMING TYPE OF TRANSACTION ('ACT' OR 'PRJ')
; I=DATE/TIME PROCESSED
; J=IEN OF FILE 443.75 RECORD
;
I SENDER>0 S S=SENDER F A="ACT","PRJ" D
. S I=PRCOBEG
. F S I=$O(^PRC(443.75,"AL1",2,S,A,I)) Q:'I!(I>PRCOSTOP) D
. . S J=0
. . 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
. . . I $S($P(PRCO(0),U,4)']"":1,'$P(PRCO(0),U,7):1,'J:1,1:0) Q
. . . 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:"")
. . . Q
. . Q
. Q
;
D WRITE
K ^TMP($J)
G STOP^PRCOER2
;
UNLIST ; take LIST variable from PRCOER1 and convert to user selection
; returns PRCOA with transaction type delimited by '^'
;
; 1 = PHA
; 2 = RFQ
; 3 = TXT
; 7 = ALL of the above (1,2,3,)
;
K PRCOA
I '+$G(LIST) K LIST Q
I +LIST=7 S PRCOA="PHA^RFQ" Q
N I,J,K
S J=""
F I=1:1 S J=$P(LIST,",",I) Q:J']"" D
. S K=$S(J=1:"PHA",J=2:"RFQ",J=3:"TXT",1:"") D
.. S PRCOA=$S($G(PRCOA)]"":PRCOA_U_K,1:K)
Q
;
PHA ; call to retrieve PHA records to display
Q
HED ; write header for report
W !!
S HEADER=$S(SENDER=0:"EC/EDI RECONCILIATION REPORT",1:"EC/EDI RECONCILIATION 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),!
W !,"TRANS",?7,"DOCUMENT #",?32,"TRANSACTION",?55,"AUSTIN ACCEPTANCE",!,"TYPE",?35,"DATE",?62,"DATE",!,$$REPEAT^XLFSTR("-",$S($G(IOM):IOM,1:79)),!
Q
WRITE ; write out record to report sorted by transaction type and date
; stored in ^TMP($J,Transaction Type,Trans.date,ien)=PO/RFQ^austin date^incoming transaction^reject code
;
D HED
I $O(^TMP($J,0))']"" W !,"No transactions for the date range selected.",! Q
N I,J,K
S I=""
S (J,K)=0
F S I=$O(^TMP($J,I)) Q:I=""!($G(PRCOUT)) D
. F S J=$O(^TMP($J,I,J)) Q:'J!($G(PRCOUT)) D
. . F S K=$O(^TMP($J,I,J,K)) Q:'K!($G(PRCOUT)) D
. . . I $G(^TMP($J,I,J,K))]"" S K(0)=^(K) D Q:$G(PRCOUT)
. . . . W !,I,?7,$P(K(0),U),?32,$$FMTE^XLFDT(J,"2P"),?55,$$FMTE^XLFDT($P(K(0),U,2),"2P")
. . . . I $P(K(0),U,3)="PRJ" D
. . . . . W !?2,"** REJECT CODE==> ",$P($G(^PRC(443.76,+$P(K(0),U,4),0)),U,2)
. . . . D HANG Q:$G(PRCOUT)
. . . Q
. . Q
. Q
Q
;
HANG ; call at end of screen if output sent to CRT
; returns PRCOUT=1 if user exits(^,timeout)
N DIRUT,DUOUT,DTOUT
K PRCOUT
I ($Y+5)>IOSL,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:'Y PRCOUT=1 Q:$G(PRCOUT)
I $Y+5>IOSL W @IOF D HED
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOER3 4196 printed Dec 13, 2024@02:11:57 Page 2
PRCOER3 ;WIRMFO-EDI RECONCILLIATION REPORT ; [8/31/98 1:46pm]
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 IF $SELECT('$GET(PRCOBEG):1,'$GET(PRCOSTOP):1,'+$GET(LIST):1,1:0)
GOTO STOP^PRCOER2
+5 SET ZTSAVE("PRCOBEG")=""
+6 SET ZTSAVE("PRCOSTOP")=""
+7 SET ZTSAVE("LIST")=""
+8 SET ZTSAVE("SENDER")=""
+9 SET ZTRTN="START^PRCOER3"
+10 SET ZTDESC="EC/EDI Reconciliation Report"
+11 DO ZIS^PRCOER2
+12 IF $GET(POP)
GOTO STOP^PRCOER2
+13 IF $GET(PRCOPOP)
GOTO STOP^PRCOER2
+14 ;
START ; enter from tasked job
+1 ;
+2 USE IO
+3 KILL ^TMP($JOB)
+4 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+5 DO UNLIST
+6 ;
+7 NEW A,HEADER
+8 ;
+9 ; Get all records between start and stop times for any sender.
+10 ;
+11 ; IN "AL" X-REF 2=PROGRESS LEVEL
+12 ; A=INCOMMING TYPE OF TRANSACTION ('ACT' OR 'PRJ')
+13 ; I=DATE/TIME PROCESSED
+14 ; J=IEN OF FILE 443.75 RECORD
+15 ;
+16 IF SENDER=0
FOR A="ACT","PRJ"
Begin DoDot:1
+17 SET I=PRCOBEG
+18 FOR
SET I=$ORDER(^PRC(443.75,"AL",2,A,I))
if 'I!(I>PRCOSTOP)
QUIT
Begin DoDot:2
+19 SET J=0
+20 FOR
SET J=$ORDER(^PRC(443.75,"AL",2,A,I,J))
if 'J
QUIT
SET PRCO(0)=$GET(^PRC(443.75,J,0))
SET PRCO(1)=^(1)
IF PRCOA[$PIECE(PRCO(0),U,4)
Begin DoDot:3
+21 IF $SELECT($PIECE(PRCO(0),U,4)']"":1,'$PIECE(PRCO(0),U,7):1,'J:1,1:0)
QUIT
+22 SET ^TMP($JOB,$PIECE(PRCO(0),U,4),$PIECE(PRCO(0),U,7),J)=$PIECE(PRCO(0),U,2)_U_$PIECE(PRCO(1),U,2)_U_$PIECE(PRCO(1),U)_U_$SELECT($PIECE(PRCO(1),U)="PRJ":$PIECE(PRCO(1),U,7),1:"")
+23 QUIT
End DoDot:3
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 ;
SINGLE ; Come here from start to display a single SENDERs entries.
+1 ;
+2 ; IN "AL1" X-REF 2=PROGRESS LEVEL
+3 ; S=SENDER
+4 ; A=INCOMMING TYPE OF TRANSACTION ('ACT' OR 'PRJ')
+5 ; I=DATE/TIME PROCESSED
+6 ; J=IEN OF FILE 443.75 RECORD
+7 ;
+8 IF SENDER>0
SET S=SENDER
FOR A="ACT","PRJ"
Begin DoDot:1
+9 SET I=PRCOBEG
+10 FOR
SET I=$ORDER(^PRC(443.75,"AL1",2,S,A,I))
if 'I!(I>PRCOSTOP)
QUIT
Begin DoDot:2
+11 SET J=0
+12 FOR
SET J=$ORDER(^PRC(443.75,"AL1",2,S,A,I,J))
if 'J
QUIT
SET PRCO(0)=$GET(^PRC(443.75,J,0))
SET PRCO(1)=^(1)
IF PRCOA[$PIECE(PRCO(0),U,4)
Begin DoDot:3
+13 IF $SELECT($PIECE(PRCO(0),U,4)']"":1,'$PIECE(PRCO(0),U,7):1,'J:1,1:0)
QUIT
+14 SET ^TMP($JOB,$PIECE(PRCO(0),U,4),$PIECE(PRCO(0),U,7),J)=$PIECE(PRCO(0),U,2)_U_$PIECE(PRCO(1),U,2)_U_$PIECE(PRCO(1),U)_U_$SELECT($PIECE(PRCO(1),U)="PRJ":$PIECE(PRCO(1),U,7),1:"")
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 ;
+19 DO WRITE
+20 KILL ^TMP($JOB)
+21 GOTO STOP^PRCOER2
+22 ;
UNLIST ; take LIST variable from PRCOER1 and convert to user selection
+1 ; returns PRCOA with transaction type delimited by '^'
+2 ;
+3 ; 1 = PHA
+4 ; 2 = RFQ
+5 ; 3 = TXT
+6 ; 7 = ALL of the above (1,2,3,)
+7 ;
+8 KILL PRCOA
+9 IF '+$GET(LIST)
KILL LIST
QUIT
+10 IF +LIST=7
SET PRCOA="PHA^RFQ"
QUIT
+11 NEW I,J,K
+12 SET J=""
+13 FOR I=1:1
SET J=$PIECE(LIST,",",I)
if J']""
QUIT
Begin DoDot:1
+14 SET K=$SELECT(J=1:"PHA",J=2:"RFQ",J=3:"TXT",1:"")
Begin DoDot:2
+15 SET PRCOA=$SELECT($GET(PRCOA)]"":PRCOA_U_K,1:K)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
PHA ; call to retrieve PHA records to display
+1 QUIT
HED ; write header for report
+1 WRITE !!
+2 SET HEADER=$SELECT(SENDER=0:"EC/EDI RECONCILIATION REPORT",1:"EC/EDI RECONCILIATION 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 WRITE !,"TRANS",?7,"DOCUMENT #",?32,"TRANSACTION",?55,"AUSTIN ACCEPTANCE",!,"TYPE",?35,"DATE",?62,"DATE",!,$$REPEAT^XLFSTR("-",$SELECT($GET(IOM):IOM,1:79)),!
+7 QUIT
WRITE ; write out record to report sorted by transaction type and date
+1 ; stored in ^TMP($J,Transaction Type,Trans.date,ien)=PO/RFQ^austin date^incoming transaction^reject code
+2 ;
+3 DO HED
+4 IF $ORDER(^TMP($JOB,0))']""
WRITE !,"No transactions for the date range selected.",!
QUIT
+5 NEW I,J,K
+6 SET I=""
+7 SET (J,K)=0
+8 FOR
SET I=$ORDER(^TMP($JOB,I))
if I=""!($GET(PRCOUT))
QUIT
Begin DoDot:1
+9 FOR
SET J=$ORDER(^TMP($JOB,I,J))
if 'J!($GET(PRCOUT))
QUIT
Begin DoDot:2
+10 FOR
SET K=$ORDER(^TMP($JOB,I,J,K))
if 'K!($GET(PRCOUT))
QUIT
Begin DoDot:3
+11 IF $GET(^TMP($JOB,I,J,K))]""
SET K(0)=^(K)
Begin DoDot:4
+12 WRITE !,I,?7,$PIECE(K(0),U),?32,$$FMTE^XLFDT(J,"2P"),?55,$$FMTE^XLFDT($PIECE(K(0),U,2),"2P")
+13 IF $PIECE(K(0),U,3)="PRJ"
Begin DoDot:5
+14 WRITE !?2,"** REJECT CODE==> ",$PIECE($GET(^PRC(443.76,+$PIECE(K(0),U,4),0)),U,2)
End DoDot:5
+15 DO HANG
if $GET(PRCOUT)
QUIT
End DoDot:4
if $GET(PRCOUT)
QUIT
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
HANG ; call at end of screen if output sent to CRT
+1 ; returns PRCOUT=1 if user exits(^,timeout)
+2 NEW DIRUT,DUOUT,DTOUT
+3 KILL PRCOUT
+4 IF ($Y+5)>IOSL
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET PRCOUT=1
if $GET(PRCOUT)
QUIT
+5 IF $Y+5>IOSL
WRITE @IOF
DO HED
+6 QUIT
