- PRCB1G ;WISC/PLT-IFCAP CURRENT DETAIL OCCRUAL ;12/2/97 14:03
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- QUIT ;invalid entry
- ;
- EN ;year to date detail accrual
- N PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRC,PRCDES,PRCTD
- N A,B,C
- Q1 ;station
- S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT
- S PRCRI(420)=+PRC("SITE"),PRCOPT=1
- 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 report") 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 YN^PRC0A(.X,.Y,"Ready to Print","O","NO")
- I X["^"!(X="")!'Y G Q4
- D ACCR
- D EN^DDIOL(" "),EN^DDIOL(" ") G Q4
- ;
- EXIT QUIT
- ;
- ;
- ACCR ;start accrual
- N PRCDUZ
- S PRCDUZ=DUZ
- S ZTDESC="IFCAP YTD Detail Accrual for Fiscal Year: "_$P(PRCA,"^")
- S PRCDES=ZTDESC
- S ZTRTN="TMEN^PRCB1G1" F A="PRCOPT","PRCA","PRCTD","PRCDUZ","PRCDES","DUZ*" S ZTSAVE(A)=""
- D ^PRCFQ
- QUIT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCB1G 1406 printed Jan 18, 2025@03:01:35 Page 2
- PRCB1G ;WISC/PLT-IFCAP CURRENT DETAIL OCCRUAL ;12/2/97 14:03
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;invalid entry
- QUIT
- +3 ;
- EN ;year to date detail accrual
- +1 NEW PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRC,PRCDES,PRCTD
- +2 NEW A,B,C
- Q1 ;station
- +1 SET PRCF("X")="AS"
- DO ^PRCFSITE
- if '%
- GOTO EXIT
- +2 SET PRCRI(420)=+PRC("SITE")
- SET PRCOPT=1
- 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 report")
- 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 DO YN^PRC0A(.X,.Y,"Ready to Print","O","NO")
- +1 IF X["^"!(X="")!'Y
- GOTO Q4
- +2 DO ACCR
- +3 DO EN^DDIOL(" ")
- DO EN^DDIOL(" ")
- GOTO Q4
- +4 ;
- EXIT QUIT
- +1 ;
- +2 ;
- ACCR ;start accrual
- +1 NEW PRCDUZ
- +2 SET PRCDUZ=DUZ
- +3 SET ZTDESC="IFCAP YTD Detail Accrual for Fiscal Year: "_$PIECE(PRCA,"^")
- +4 SET PRCDES=ZTDESC
- +5 SET ZTRTN="TMEN^PRCB1G1"
- FOR A="PRCOPT","PRCA","PRCTD","PRCDUZ","PRCDES","DUZ*"
- SET ZTSAVE(A)=""
- +6 DO ^PRCFQ
- +7 QUIT
- +8 ;