- 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 Mar 13, 2025@21:22:58 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
