PRCB1GE.m

PRCB1GE ;OI&T/PLT-LKG-YEAR TO DATE ACCRUAL EXTRACT ;11/5/21  10:09

V ;;5.1;IFCAP;**225**;Oct 20, 2000;Build 3

 ;Per VA Directive 6402, this routine should not be modified.

 QUIT  ;invalid entry

 ;

EN ;year to date detail accrual

 N PRCA,PRCRI,PRCDUZ,PRC,PRCTD,PRCF,%

 N A,B,C,E,X,Y

Q1 ;station

 S PRCF("X")="AS" D ^PRCFSITE G:'$G(%) EXIT

 S PRCRI(420)=+PRC("SITE")

Q4 ;prompt fiscal year

 S A=$$DATE^PRC0C("T","E"),PRCTD=$P(A,"^",1,2)

 S E="O^2:4^K:X'?2N&(X'?4N) X",Y(1)="Enter a fiscal year in format: YY OR YYYY. For example: 96 or 1996"

 D FT^PRC0A(.X,.Y,"For Fiscal Year",E,$P(PRCTD,"^"))

 G:X["^"!(X="")!(Y'?2.4N) EXIT

 S:Y?2N Y=$$YEAR^PRC0C(Y) I Y>PRCTD D EN^DDIOL("Too early to run this extract") G Q4

 S A=$$QTRDATE^PRC0D(Y,$S(+PRCTD=Y:$P(PRCTD,"^",2),1:4)),PRCA=A W "     Fiscal Year: ",$P(PRCA,"^")

 S $P(PRCA,"^",11)=$P(PRCA,"^",8)_"-"_PRC("SITE")

 I $O(^PRCH(440.6,"ST","N~",0)) D EN^DDIOL("Warning: An unregistered card exists in your file. Contact the P.C. Coordinator.")

Q5 ;

 D ACCR

 S:$D(ZTQUEUED) ZTREQ="@"

 ;

EXIT QUIT

 ;

 ;

ACCR ;start accrual

 N PRCDUZ,ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK

 S PRCDUZ=DUZ

 S ZTDESC="IFCAP YTD Detail Accrual for Fiscal Year: "_$P(PRCA,"^")

 S ZTIO=""

 S ZTRTN="TMEN^PRCB1GE1" F A="PRCA","PRCTD","PRCDUZ","DUZ*" S ZTSAVE(A)=""

 D ^%ZTLOAD

 D:$G(ZTSK) EN^DDIOL("Compilation is queued task #"_ZTSK,"","!!")

 QUIT

 ;

TASKED(PRCFY,PRCSITE) ; Module to task extraction from other application

 D EN^DDIOL("Generating YTD Accrual Data Extract...","","!!")

 N A,PRCTD,PRCA,PRCDUZ,ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK

 S PRCTD=$P($$DATE^PRC0C("T","E"),"^",1,2)

 S PRCA=$$QTRDATE^PRC0D(PRCFY,$S(+PRCTD=PRCFY:$P(PRCTD,"^",2),1:4))

 S $P(PRCA,"^",11)=$P(PRCA,"^",8)_"-"_PRCSITE

 S PRCDUZ=DUZ,ZTDESC="IFCAP YTD Detail Accrual for Fiscal Year: "_PRCFY

 S ZTIO="",ZTRTN="TMEN^PRCB1GE1"

 F A="PRCA","PRCTD","PRCDUZ","DUZ*" S ZTSAVE(A)=""

 D ^%ZTLOAD

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCB1GE   1926     printed  Mar 13, 2025@21:05:14                                                                                                                                                                                                     Page 2

PRCB1GE   ;OI&T/PLT-LKG-YEAR TO DATE ACCRUAL EXTRACT ;11/5/21  10:09

V         ;;5.1;IFCAP;**225**;Oct 20, 2000;Build 3

 +1       ;Per VA Directive 6402, this routine should not be modified.

 +2       ;invalid entry

           QUIT 

 +3       ;

EN        ;year to date detail accrual

 +1        NEW PRCA,PRCRI,PRCDUZ,PRC,PRCTD,PRCF,%

 +2        NEW A,B,C,E,X,Y

Q1        ;station

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

           DO ^PRCFSITE

           if '$GET(%)

               GOTO EXIT

 +2        SET PRCRI(420)=+PRC("SITE")

Q4        ;prompt fiscal year

 +1        SET A=$$DATE^PRC0C("T","E")

           SET PRCTD=$PIECE(A,"^",1,2)

 +2        SET E="O^2:4^K:X'?2N&(X'?4N) X"

           SET Y(1)="Enter a fiscal year in format: YY OR YYYY. For example: 96 or 1996"

 +3        DO FT^PRC0A(.X,.Y,"For Fiscal Year",E,$PIECE(PRCTD,"^"))

 +4        if X["^"!(X="")!(Y'?2.4N)

               GOTO EXIT

 +5        if Y?2N

               SET Y=$$YEAR^PRC0C(Y)

           IF Y>PRCTD

               DO EN^DDIOL("Too early to run this extract")

               GOTO Q4

 +6        SET A=$$QTRDATE^PRC0D(Y,$SELECT(+PRCTD=Y:$PIECE(PRCTD,"^",2),1:4))

           SET PRCA=A

           WRITE "     Fiscal Year: ",$PIECE(PRCA,"^")

 +7        SET $PIECE(PRCA,"^",11)=$PIECE(PRCA,"^",8)_"-"_PRC("SITE")

 +8        IF $ORDER(^PRCH(440.6,"ST","N~",0))

               DO EN^DDIOL("Warning: An unregistered card exists in your file. Contact the P.C. Coordinator.")

Q5        ;

 +1        DO ACCR

 +2        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3       ;

EXIT       QUIT 

 +1       ;

 +2       ;

ACCR      ;start accrual

 +1        NEW PRCDUZ,ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK

 +2        SET PRCDUZ=DUZ

 +3        SET ZTDESC="IFCAP YTD Detail Accrual for Fiscal Year: "_$PIECE(PRCA,"^")

 +4        SET ZTIO=""

 +5        SET ZTRTN="TMEN^PRCB1GE1"

           FOR A="PRCA","PRCTD","PRCDUZ","DUZ*"

               SET ZTSAVE(A)=""

 +6        DO ^%ZTLOAD

 +7        if $GET(ZTSK)

               DO EN^DDIOL("Compilation is queued task #"_ZTSK,"","!!")

 +8        QUIT 

 +9       ;

TASKED(PRCFY,PRCSITE) ; Module to task extraction from other application

 +1        DO EN^DDIOL("Generating YTD Accrual Data Extract...","","!!")

 +2        NEW A,PRCTD,PRCA,PRCDUZ,ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK

 +3        SET PRCTD=$PIECE($$DATE^PRC0C("T","E"),"^",1,2)

 +4        SET PRCA=$$QTRDATE^PRC0D(PRCFY,$SELECT(+PRCTD=PRCFY:$PIECE(PRCTD,"^",2),1:4))

 +5        SET $PIECE(PRCA,"^",11)=$PIECE(PRCA,"^",8)_"-"_PRCSITE

 +6        SET PRCDUZ=DUZ

           SET ZTDESC="IFCAP YTD Detail Accrual for Fiscal Year: "_PRCFY

 +7        SET ZTIO=""

           SET ZTRTN="TMEN^PRCB1GE1"

 +8        FOR A="PRCA","PRCTD","PRCDUZ","DUZ*"

               SET ZTSAVE(A)=""

 +9        DO ^%ZTLOAD

 +10       QUIT