Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCOER3

PRCOER3.m

Go to the documentation of this file. 
  1. PRCOER3 ;WIRMFO-EDI RECONCILLIATION REPORT ; [8/31/98 1:46pm]
  1.  ;;5.1;IFCAP;;Oct 20, 2000
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  I $S('$G(PRCOBEG):1,'$G(PRCOSTOP):1,'+$G(LIST):1,1:0) G STOP^PRCOER2
  1.  S ZTSAVE("PRCOBEG")=""
  1.  S ZTSAVE("PRCOSTOP")=""
  1.  S ZTSAVE("LIST")=""
  1.  S ZTSAVE("SENDER")=""
  1.  S ZTRTN="START^PRCOER3"
  1.  S ZTDESC="EC/EDI Reconciliation Report"
  1.  D ZIS^PRCOER2
  1.  I $G(POP) G STOP^PRCOER2
  1.  I $G(PRCOPOP) G STOP^PRCOER2
  1.  ;
  1. START ; enter from tasked job
  1.  ;
  1.  U IO
  1.  K ^TMP($J)
  1.  I $E(IOST,1,2)="C-" W @IOF
  1.  D UNLIST
  1.  ;
  1.  N A,HEADER
  1.  ;
  1.  ; Get all records between start and stop times for any sender.
  1.  ;
  1.  ; IN "AL" X-REF 2=PROGRESS LEVEL
  1.  ;               A=INCOMMING TYPE OF TRANSACTION ('ACT' OR 'PRJ')
  1.  ;               I=DATE/TIME PROCESSED
  1.  ;               J=IEN OF FILE 443.75 RECORD
  1.  ;
  1.  I SENDER=0 F A="ACT","PRJ" D
  1.  . S I=PRCOBEG
  1.  . F  S I=$O(^PRC(443.75,"AL",2,A,I)) Q:'I!(I>PRCOSTOP)  D
  1.  . . S J=0
  1.  . . 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
  1.  . . . I $S($P(PRCO(0),U,4)']"":1,'$P(PRCO(0),U,7):1,'J:1,1:0) Q
  1.  . . . 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:"")
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  ;
  1. SINGLE ; Come here from start to display a single SENDERs entries.
  1.  ;
  1.  ; IN "AL1" X-REF 2=PROGRESS LEVEL
  1.  ;                S=SENDER
  1.  ;                A=INCOMMING TYPE OF TRANSACTION ('ACT' OR 'PRJ')
  1.  ;                I=DATE/TIME PROCESSED
  1.  ;                J=IEN OF FILE 443.75 RECORD
  1.  ;
  1.  I SENDER>0 S S=SENDER F A="ACT","PRJ" D
  1.  . S I=PRCOBEG
  1.  . F  S I=$O(^PRC(443.75,"AL1",2,S,A,I)) Q:'I!(I>PRCOSTOP)  D
  1.  . . S J=0
  1.  . . 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
  1.  . . . I $S($P(PRCO(0),U,4)']"":1,'$P(PRCO(0),U,7):1,'J:1,1:0) Q
  1.  . . . 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:"")
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  ;
  1.  D WRITE
  1.  K ^TMP($J)
  1.  G STOP^PRCOER2
  1.  ;
  1. UNLIST ; take LIST variable from PRCOER1 and convert to user selection
  1.  ; returns PRCOA with transaction type delimited by '^'
  1.  ;
  1.  ; 1 = PHA
  1.  ; 2 = RFQ
  1.  ; 3 = TXT
  1.  ; 7 = ALL of the above (1,2,3,)
  1.  ;
  1.  K PRCOA
  1.  I '+$G(LIST) K LIST Q
  1.  I +LIST=7 S PRCOA="PHA^RFQ" Q
  1.  N I,J,K
  1.  S J=""
  1.  F I=1:1 S J=$P(LIST,",",I) Q:J']""  D
  1.  . S K=$S(J=1:"PHA",J=2:"RFQ",J=3:"TXT",1:"") D
  1.  .. S PRCOA=$S($G(PRCOA)]"":PRCOA_U_K,1:K)
  1.  Q
  1.  ;
  1. PHA ; call to retrieve PHA records to display
  1.  Q
  1. HED ; write header for report
  1.  W !!
  1.  S HEADER=$S(SENDER=0:"EC/EDI RECONCILIATION REPORT",1:"EC/EDI RECONCILIATION REPORT for "_$P($G(^VA(200,SENDER,0)),U))
  1.  W $$CJ^XLFSTR(HEADER,80),!
  1.  W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",$L(HEADER)),80),!
  1.  W !?2,"Date Range for Report: ",$$FMTE^XLFDT(PRCOBEG)_" to "_$$FMTE^XLFDT(PRCOSTOP),!
  1.  W !,"TRANS",?7,"DOCUMENT #",?32,"TRANSACTION",?55,"AUSTIN ACCEPTANCE",!,"TYPE",?35,"DATE",?62,"DATE",!,$$REPEAT^XLFSTR("-",$S($G(IOM):IOM,1:79)),!
  1.  Q
  1. 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
  1.  ;
  1.  D HED
  1.  I $O(^TMP($J,0))']"" W !,"No transactions for the date range selected.",! Q
  1.  N I,J,K
  1.  S I=""
  1.  S (J,K)=0
  1.  F  S I=$O(^TMP($J,I)) Q:I=""!($G(PRCOUT))  D
  1.  .  F  S J=$O(^TMP($J,I,J)) Q:'J!($G(PRCOUT))  D
  1.  .  .  F  S K=$O(^TMP($J,I,J,K)) Q:'K!($G(PRCOUT))  D
  1.  .  .  .  I $G(^TMP($J,I,J,K))]"" S K(0)=^(K) D  Q:$G(PRCOUT)
  1.  .  .  .  .  W !,I,?7,$P(K(0),U),?32,$$FMTE^XLFDT(J,"2P"),?55,$$FMTE^XLFDT($P(K(0),U,2),"2P")
  1.  .  .  .  .  I $P(K(0),U,3)="PRJ" D
  1.  .  .  .  .  .  W !?2,"** REJECT CODE==> ",$P($G(^PRC(443.76,+$P(K(0),U,4),0)),U,2)
  1.  .  .  .  .  D HANG Q:$G(PRCOUT)
  1.  .  .  .  Q
  1.  .  .  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. HANG ; call at end of screen if output sent to CRT
  1.  ; returns PRCOUT=1 if user exits(^,timeout)
  1.  N DIRUT,DUOUT,DTOUT
  1.  K PRCOUT
  1.  I ($Y+5)>IOSL,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:'Y PRCOUT=1 Q:$G(PRCOUT)
  1.  I $Y+5>IOSL W @IOF D HED
  1.  Q