PRCAHIS1.m

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 ---PRCAHIS1   885     printed  Apr 09, 2024@20:52:09                                                                                                                                                                                                     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