PRCSP1E ;WISC/SAW/DL-CONTROL POINT ACTIVITY PRINTS CON'T ; 1/30/98 1440
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
FACPT ;FISCAL AUDIT LIST
D EN1^PRCSUT G W1:'$D(PRC("SITE")),EXIT:Y<0
FACPT1 W !,"Enter the cutoff date for this reconciliation report" S %DT="AEX" D ^%DT G EXIT:Y<0
S PRCS("DAT1")=Y
; Change for PRC*5*250 to make date compare Y2K compliant
S Q=PRC("FY")+100-1
S %DT="X",X=$S(PRC("QTR")=1:1001,PRC("QTR")=2:"0101",PRC("QTR")=3:"0401",1:"0701")_$S(PRC("QTR")=1:$E(Q,$L(Q)-1,$L(Q)),1:PRC("FY"))
D ^%DT G EXIT:Y<0
S PRCS("DAT")=Y
; End of fix for PRC*5*250
I PRCS("DAT")>PRCS("DAT1") W $C(7),!," Cutoff date must be greater than first day of the quarter you selected." G FACPT1
S C2=PRC("SITE")_"-"_PRC("FY")_"-1-"_$P(PRC("CP")," ")_"-0001",C3=PRC("SITE")_"-"_PRC("FY")_"-4-"_$P(PRC("CP")," ")_"9999"
S BY="@15,@INTERNAL(#31),.01",FR=$P(PRC("CP")," ")_" ,"_PRCS("DAT")_","_C2,TO=$P(PRC("CP")," ")_" z,"_PRCS("DAT1")_","_C3,FLDS="[PRCSFACPT]" D S
N REPORT2 S REPORT2=1 D T2^PRCSAPP1 K PRC("CP"),PRCS G FACPT
S S L=0,DIC="^PRCS(410," D EN1^DIP Q
DEV K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q
W2 W !!,"Enter information for another report or an uparrow to return to the menu.",! Q
W1 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
W I (IO=IO(0))&('$D(ZTQUEUED)) W !!,"Press return to continue: " R X:DTIME
I (IO'=IO(0))!($D(ZTQUEUED)) D ^%ZISC
EXIT K %,%DT,%ZIS,BY,C2,C3,D,DA,DHD,DIC,DIE,PRCS,FLDS,FR,I,L,N,Q,TO,X,Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSP1E 1585 printed Dec 13, 2024@02:18:11 Page 2
PRCSP1E ;WISC/SAW/DL-CONTROL POINT ACTIVITY PRINTS CON'T ; 1/30/98 1440
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
FACPT ;FISCAL AUDIT LIST
+1 DO EN1^PRCSUT
if '$DATA(PRC("SITE"))
GOTO W1
if Y<0
GOTO EXIT
FACPT1 WRITE !,"Enter the cutoff date for this reconciliation report"
SET %DT="AEX"
DO ^%DT
if Y<0
GOTO EXIT
+1 SET PRCS("DAT1")=Y
+2 ; Change for PRC*5*250 to make date compare Y2K compliant
+3 SET Q=PRC("FY")+100-1
+4 SET %DT="X"
SET X=$SELECT(PRC("QTR")=1:1001,PRC("QTR")=2:"0101",PRC("QTR")=3:"0401",1:"0701")_$SELECT(PRC("QTR")=1:$EXTRACT(Q,$LENGTH(Q)-1,$LENGTH(Q)),1:PRC("FY"))
+5 DO ^%DT
if Y<0
GOTO EXIT
+6 SET PRCS("DAT")=Y
+7 ; End of fix for PRC*5*250
+8 IF PRCS("DAT")>PRCS("DAT1")
WRITE $CHAR(7),!," Cutoff date must be greater than first day of the quarter you selected."
GOTO FACPT1
+9 SET C2=PRC("SITE")_"-"_PRC("FY")_"-1-"_$PIECE(PRC("CP")," ")_"-0001"
SET C3=PRC("SITE")_"-"_PRC("FY")_"-4-"_$PIECE(PRC("CP")," ")_"9999"
+10 SET BY="@15,@INTERNAL(#31),.01"
SET FR=$PIECE(PRC("CP")," ")_" ,"_PRCS("DAT")_","_C2
SET TO=$PIECE(PRC("CP")," ")_" z,"_PRCS("DAT1")_","_C3
SET FLDS="[PRCSFACPT]"
DO S
+11 NEW REPORT2
SET REPORT2=1
DO T2^PRCSAPP1
KILL PRC("CP"),PRCS
GOTO FACPT
S SET L=0
SET DIC="^PRCS(410,"
DO EN1^DIP
QUIT
DEV KILL IO("Q")
SET %ZIS("B")="HOME"
SET %ZIS="MQ"
DO ^%ZIS
QUIT
W2 WRITE !!,"Enter information for another report or an uparrow to return to the menu.",!
QUIT
W1 WRITE !!,"You are not an authorized control point user.",!,"Contact your control point official."
READ X:5
GOTO EXIT
W IF (IO=IO(0))&('$DATA(ZTQUEUED))
WRITE !!,"Press return to continue: "
READ X:DTIME
+1 IF (IO'=IO(0))!($DATA(ZTQUEUED))
DO ^%ZISC
EXIT KILL %,%DT,%ZIS,BY,C2,C3,D,DA,DHD,DIC,DIE,PRCS,FLDS,FR,I,L,N,Q,TO,X,Y
QUIT
