PRCSP1E.m

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 ---PRCSP1E   1585     printed  Apr 09, 2024@21:00:50                                                                                                                                                                                                     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