PRCBE0.m

PRCBE0 ;WISC@ALTOONA/CTB-285 DISTRIBUTION ;4/14/93  11:27 AM

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

OUT K %,%X,%Y,D,D0,D1,D2,DD,DO,DQ,DA,DIC,DIE,DLAYGO,DQ,DR,DWLW,I,J,X,Y Q

 ;

EN4 ;DISTRIBUTION OF RD 2-285 DATA

 S PRCF("X")="AB" D ^PRCFSITE G:'% OUT4

EN41 S DIC("A")="Select TDA NUMBER FOR STATION "_PRC("SITE")_", FY "_PRC("FY")_": "

 S DIC("S")="S ZX=^(0) I $P(ZX,U,16)]"""",$P(ZX,""-"",1,2)=PRCF(""SIFY"")",DIC="^PRCF(421,",DIC(0)="AEQXZ",D="C" D IX^DIC K DIC,ZX,D G:+Y<0 OUT4 S DA=+Y,DIE="^PRCF(421,"

 I $P(Y(0),U,4)="" W !,"TRANSACTION NUMBER ",X," DOES NOT CONTAIN A TDA NUMBER, AND THEREFORE",!,"MAY NOT BE DISTRIBUTED FOR THE RD 2 285 REPORT",$C(7),! G EN41

 F I=1:1:4 S PX(I)=$P(Y(0),U,I+6) I PX(I)="" S PX(I)=0

EN42 W !!,"TDA IS DISTRIBUTED AS FOLLOWS: "

 S PX="1ST QTR^2ND QTR^3RD QTR^4TH QTR" W !! F I=1:1:4 W ?$X+10,$P(PX,U,I)

 W !! F I=1:1:4 W ?$X+2,$J(PX(I),15,0)

 W !!,"ENTER THE NON CUMULATIVE DISTRIBUTION FOR THIS TDA"

 W ! S DR="[PRCB RD2-285 ALL]",PY="" D ^DIE I $D(Y)'=0 D OUT4,OUT Q

 S:'$D(^PRCF(421,DA,3)) ^(3)="" S Q=^(3),Q(0)=0 F I=1:1:12 S Q(I)=Q(I-1)+$P(Q,U,I)

 F I=1:1:4 S Q(I+20)=Q(I*3)-Q(I-1*3)

 F I=1:1:4 I +Q(I+20)'=+PX(I) W !,"CUMULATIVE TOTAL FOR ",$P(PX,U,I)," IS NOT CORRECT",!,$C(7) S I(1)=1

 I $D(I(1)) K I W ! S %A="DO YOU WISH TO MAKE CORRECTIONS AT THIS TIME",%B="",%=1 D ^PRCFYN G:%=1 EN42 D OUT4 G OUT

 S Q="" K I F I=1:1:12 S Q=Q_Q(I)_U

 S ^PRCF(421,DA,2)=Q K I,J,Q,P,X,Y W !!,"DISTRIBUTION IS CORRECT BY QUARTER ",!! G EN41

OUT4 K I,J,Q,P,X,Y,PRCF Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCBE0   1576     printed  Apr 09, 2024@21:11:06                                                                                                                                                                                                      Page 2

PRCBE0    ;WISC@ALTOONA/CTB-285 DISTRIBUTION ;4/14/93  11:27 AM

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

OUT        KILL %,%X,%Y,D,D0,D1,D2,DD,DO,DQ,DA,DIC,DIE,DLAYGO,DQ,DR,DWLW,I,J,X,Y

           QUIT 

 +1       ;

EN4       ;DISTRIBUTION OF RD 2-285 DATA

 +1        SET PRCF("X")="AB"

           DO ^PRCFSITE

           if '%

               GOTO OUT4

EN41       SET DIC("A")="Select TDA NUMBER FOR STATION "_PRC("SITE")_", FY "_PRC("FY")_": "

 +1        SET DIC("S")="S ZX=^(0) I $P(ZX,U,16)]"""",$P(ZX,""-"",1,2)=PRCF(""SIFY"")"

           SET DIC="^PRCF(421,"

           SET DIC(0)="AEQXZ"

           SET D="C"

           DO IX^DIC

           KILL DIC,ZX,D

           if +Y<0

               GOTO OUT4

           SET DA=+Y

           SET DIE="^PRCF(421,"

 +2        IF $PIECE(Y(0),U,4)=""

               WRITE !,"TRANSACTION NUMBER ",X," DOES NOT CONTAIN A TDA NUMBER, AND THEREFORE",!,"MAY NOT BE DISTRIBUTED FOR THE RD 2 285 REPORT",$CHAR(7),!

               GOTO EN41

 +3        FOR I=1:1:4

               SET PX(I)=$PIECE(Y(0),U,I+6)

               IF PX(I)=""

                   SET PX(I)=0

EN42       WRITE !!,"TDA IS DISTRIBUTED AS FOLLOWS: "

 +1        SET PX="1ST QTR^2ND QTR^3RD QTR^4TH QTR"

           WRITE !!

           FOR I=1:1:4

               WRITE ?$X+10,$PIECE(PX,U,I)

 +2        WRITE !!

           FOR I=1:1:4

               WRITE ?$X+2,$JUSTIFY(PX(I),15,0)

 +3        WRITE !!,"ENTER THE NON CUMULATIVE DISTRIBUTION FOR THIS TDA"

 +4        WRITE !

           SET DR="[PRCB RD2-285 ALL]"

           SET PY=""

           DO ^DIE

           IF $DATA(Y)'=0

               DO OUT4

               DO OUT

               QUIT 

 +5        if '$DATA(^PRCF(421,DA,3))

               SET ^(3)=""

           SET Q=^(3)

           SET Q(0)=0

           FOR I=1:1:12

               SET Q(I)=Q(I-1)+$PIECE(Q,U,I)

 +6        FOR I=1:1:4

               SET Q(I+20)=Q(I*3)-Q(I-1*3)

 +7        FOR I=1:1:4

               IF +Q(I+20)'=+PX(I)

                   WRITE !,"CUMULATIVE TOTAL FOR ",$PIECE(PX,U,I)," IS NOT CORRECT",!,$CHAR(7)

                   SET I(1)=1

 +8        IF $DATA(I(1))

               KILL I

               WRITE !

               SET %A="DO YOU WISH TO MAKE CORRECTIONS AT THIS TIME"

               SET %B=""

               SET %=1

               DO ^PRCFYN

               if %=1

                   GOTO EN42

               DO OUT4

               GOTO OUT

 +9        SET Q=""

           KILL I

           FOR I=1:1:12

               SET Q=Q_Q(I)_U

 +10       SET ^PRCF(421,DA,2)=Q

           KILL I,J,Q,P,X,Y

           WRITE !!,"DISTRIBUTION IS CORRECT BY QUARTER ",!!

           GOTO EN41

OUT4       KILL I,J,Q,P,X,Y,PRCF

           QUIT