PRCAHIS1 ;WASH-ISC@ALTOONA,PA/LDB-Transaction History Report (cont) ;9/27/93 10:33 AM
V ;;4.5;Accounts Receivable;**100**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
TRANS ;Build array of transactions
;Called from PRCAHIS
N PRCAHIST S PRCAHIST="THIST"
S PG=0,$P(LINE,"-",79)="-" K ^TMP("PRCAGT",$J) D DT^DICRW
S BDATE=(BDATE-1)_".999999999"
S EDATE=EDATE+.99999999
S:'TYP TYP="" D EN^PRCAGT(DEB,BDATE,EDATE,TYP)
TBAL D TBAL^PRCAGT(DEB,.TBAL)
I 'TYP!(TYP=45) S TYP(1)=TYP D
.F TYP=1:1:$S(TYP(1)=45:1,1:3) S DAT1=0 F S DAT1=$O(^RC(341,"AD",+DEB,TYP,DAT1)) Q:'DAT1 D
..S EVNT=0 F S EVNT=$O(^RC(341,"AD",+DEB,TYP,DAT1,EVNT)) Q:'EVNT I $D(^RC(341,+EVNT,0)) D
...S DAT2=$P(^RC(341,+EVNT,0),"^",7)
...I DAT2'<BDATE&(DAT2'>EDATE) D
....S ^TMP("PRCAGT",$J,+DEB,DAT2,0)="0^"_$P($G(^RC(341,+EVNT,0)),"^",2)_"^"_EVNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAHIS1 885 printed Oct 16, 2024@17:40:42 Page 2
PRCAHIS1 ;WASH-ISC@ALTOONA,PA/LDB-Transaction History Report (cont) ;9/27/93 10:33 AM
V ;;4.5;Accounts Receivable;**100**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
TRANS ;Build array of transactions
+1 ;Called from PRCAHIS
+2 NEW PRCAHIST
SET PRCAHIST="THIST"
+3 SET PG=0
SET $PIECE(LINE,"-",79)="-"
KILL ^TMP("PRCAGT",$JOB)
DO DT^DICRW
+4 SET BDATE=(BDATE-1)_".999999999"
+5 SET EDATE=EDATE+.99999999
+6 if 'TYP
SET TYP=""
DO EN^PRCAGT(DEB,BDATE,EDATE,TYP)
TBAL DO TBAL^PRCAGT(DEB,.TBAL)
+1 IF 'TYP!(TYP=45)
SET TYP(1)=TYP
Begin DoDot:1
+2 FOR TYP=1:1:$SELECT(TYP(1)=45:1,1:3)
SET DAT1=0
FOR
SET DAT1=$ORDER(^RC(341,"AD",+DEB,TYP,DAT1))
if 'DAT1
QUIT
Begin DoDot:2
+3 SET EVNT=0
FOR
SET EVNT=$ORDER(^RC(341,"AD",+DEB,TYP,DAT1,EVNT))
if 'EVNT
QUIT
IF $DATA(^RC(341,+EVNT,0))
Begin DoDot:3
+4 SET DAT2=$PIECE(^RC(341,+EVNT,0),"^",7)
+5 IF DAT2'<BDATE&(DAT2'>EDATE)
Begin DoDot:4
+6 SET ^TMP("PRCAGT",$JOB,+DEB,DAT2,0)="0^"_$PIECE($GET(^RC(341,+EVNT,0)),"^",2)_"^"_EVNT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
