- PRCSOUT ;WISC/KMB-OUTSTANDING APPROVED REQUESTS REPORT ;1-24-94 13:06
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;
- N PAGE,XDA,I,J,LL,OUT,OUT1,LOOP,LOOP1,LOOP2,TODAY,TODAY1 S (OUT,OUT1,I)=1,(LOOP1,LOOP2,PAGE)=0
- S (OUT,OUT1,I)=1,(LOOP1,LOOP2,PAGE)=0
- W @IOF D EN1^PRCSUT G W1:'$D(PRC("SITE")),EXIT:Y<0
- PROCESS ;
- W @IOF D NOW^%DTC S TODAY=$P(%,"."),Y=% D DD^%DT S TODAY1=Y
- W !,"Processing entries...",!
- S LOOP=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," "),LOOP1=LOOP_"-0000"
- F I=0:1 S LOOP1=$O(^PRCS(410,"B",LOOP1)) Q:$P(LOOP1,"-",1,4)'=LOOP D
- .S LOOP2=0 F S LOOP2=$O(^PRCS(410,"B",LOOP1,LOOP2)) Q:LOOP2="" S XDA=LOOP2 D
- ..N ZEROTH,FIRST,SECOND,THIRD,FOURTH,FIFTH,SIXTH
- ..S FIFTH=$P($G(^PRCS(410,XDA,1)),"^",4) Q:FIFTH>TODAY
- ..S FIRST=$P($G(^PRCS(410,XDA,7)),"^",5) Q:FIRST=""
- ..Q:$P($G(^PRCS(410,XDA,0)),"^",2)'["O"
- ..S ZEROTH=$P($G(^PRCS(410,XDA,0)),"^"),SECOND=$P($G(^PRCS(410,XDA,9)),"^",2),THIRD=$P($G(^PRCS(410,XDA,2)),"^",1),FOURTH=$P($G(^PRCS(410,XDA,4)),"^",4)
- ..S SIXTH=$P($G(^PRCS(410,XDA,4)),"^",5)
- ..S ^TMP($J,I)=FIRST_"*"_SECOND_"*"_THIRD_"*"_FOURTH_"*"_FIFTH_"*"_SIXTH_"*"_ZEROTH_"*"_XDA
- I '$D(^TMP($J)) U IO(0) W !,"No outstanding transactions found for this quarter.",! G START
- WRITE ;
- S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS G EXIT:POP
- S ZTSAVE("PRC*")="",ZTSAVE("OUT")="",ZTSAVE("I")="",ZTSAVE("TODAY1")="",ZTSAVE("PAGE")=""
- I IO'=IO(0) S OUT1=0
- I $D(IO("Q")) S ZTDESC="REQUEST REPORT",ZTRTN="WRITE1^PRCSOUT",ZTSAVE("OUT1")="",ZTSAVE("DA")="",ZTSAVE("^TMP($J,")="",ZTSAVE("D0")="" D ^%ZTLOAD D ^%ZISC,EXIT,WRITE2 G START
- D WRITE1 D ^%ZISC,EXIT,WRITE2 G START
- WRITE1 ;
- U IO D HEADER F K=1:1:I-1 I $G(^TMP($J,K))'="" D
- .Q:OUT=U D:IOSL-($Y#IOSL)<6 HOLD Q:OUT=U
- .W !,?2,$P(^TMP($J,K),"*",7)
- .S D0=$P(^TMP($J,K),"*",8) D:D0'="" STATUS^PRCSES W ?22,$E(X,1,25)
- .W ?50,$E($P(^TMP($J,K),"*",3),1,30)
- .W ! S Y=$P(^TMP($J,K),"*") D DD^%DT W Y
- .S Y=$P(^TMP($J,K),"*",2) D DD^%DT W ?15,Y
- .W ?35,$P(^TMP($J,K),"*",6)
- .S Y=$P(^TMP($J,K),"*",4) D DD^%DT W ?50,Y
- .S Y=$P(^TMP($J,K),"*",5) D DD^%DT W ?65,Y
- I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
- Q
- WRITE2 ;
- U IO(0) W !!,"------------------",!,"End of processing",! H 2 Q
- W1 W !!,"You are not an authorized control point user.",!,"Please contact your control point official." R I:5 G EXIT
- S PAGE=PAGE+1
- I PAGE'=1 W @IOF
- W !,"OUTSTANDING APPROVED REQUEST REPORT - CP ",$P(PRC("CP")," "),?49,TODAY1,?72,"PAGE ",PAGE
- W !!,"TRANSACTION NUMBER",?22,"TRANSACTION STATUS",?50,"VENDOR"
- W !,"DATE SIGNED",?15,"EST. DEL. DATE",?35,"PO #",?50,"DATE OBL.",?65,"DATE REQ."
- S LL="",$P(LL,"-",IOM)="-" W !,LL S LL="" Q
- HOLD ;
- G HEADER:IO'=IO(0),HEADER:$D(ZTQUEUED) W !,"Press return to continue, uparrow (^) to exit: " R OUT:100 S:'$T OUT=U D:OUT'=U HEADER Q
- EXIT K ^TMP($J),PRCS Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSOUT 2887 printed Feb 18, 2025@23:44:14 Page 2
- PRCSOUT ;WISC/KMB-OUTSTANDING APPROVED REQUESTS REPORT ;1-24-94 13:06
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;
- +1 NEW PAGE,XDA,I,J,LL,OUT,OUT1,LOOP,LOOP1,LOOP2,TODAY,TODAY1
- SET (OUT,OUT1,I)=1
- SET (LOOP1,LOOP2,PAGE)=0
- +2 SET (OUT,OUT1,I)=1
- SET (LOOP1,LOOP2,PAGE)=0
- +3 WRITE @IOF
- DO EN1^PRCSUT
- if '$DATA(PRC("SITE"))
- GOTO W1
- if Y<0
- GOTO EXIT
- PROCESS ;
- +1 WRITE @IOF
- DO NOW^%DTC
- SET TODAY=$PIECE(%,".")
- SET Y=%
- DO DD^%DT
- SET TODAY1=Y
- +2 WRITE !,"Processing entries...",!
- +3 SET LOOP=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$PIECE(PRC("CP")," ")
- SET LOOP1=LOOP_"-0000"
- +4 FOR I=0:1
- SET LOOP1=$ORDER(^PRCS(410,"B",LOOP1))
- if $PIECE(LOOP1,"-",1,4)'=LOOP
- QUIT
- Begin DoDot:1
- +5 SET LOOP2=0
- FOR
- SET LOOP2=$ORDER(^PRCS(410,"B",LOOP1,LOOP2))
- if LOOP2=""
- QUIT
- SET XDA=LOOP2
- Begin DoDot:2
- +6 NEW ZEROTH,FIRST,SECOND,THIRD,FOURTH,FIFTH,SIXTH
- +7 SET FIFTH=$PIECE($GET(^PRCS(410,XDA,1)),"^",4)
- if FIFTH>TODAY
- QUIT
- +8 SET FIRST=$PIECE($GET(^PRCS(410,XDA,7)),"^",5)
- if FIRST=""
- QUIT
- +9 if $PIECE($GET(^PRCS(410,XDA,0)),"^",2)'["O"
- QUIT
- +10 SET ZEROTH=$PIECE($GET(^PRCS(410,XDA,0)),"^")
- SET SECOND=$PIECE($GET(^PRCS(410,XDA,9)),"^",2)
- SET THIRD=$PIECE($GET(^PRCS(410,XDA,2)),"^",1)
- SET FOURTH=$PIECE($GET(^PRCS(410,XDA,4)),"^",4)
- +11 SET SIXTH=$PIECE($GET(^PRCS(410,XDA,4)),"^",5)
- +12 SET ^TMP($JOB,I)=FIRST_"*"_SECOND_"*"_THIRD_"*"_FOURTH_"*"_FIFTH_"*"_SIXTH_"*"_ZEROTH_"*"_XDA
- End DoDot:2
- End DoDot:1
- +13 IF '$DATA(^TMP($JOB))
- USE IO(0)
- WRITE !,"No outstanding transactions found for this quarter.",!
- GOTO START
- WRITE ;
- +1 SET %ZIS("B")="HOME"
- SET %ZIS="MQ"
- DO ^%ZIS
- if POP
- GOTO EXIT
- +2 SET ZTSAVE("PRC*")=""
- SET ZTSAVE("OUT")=""
- SET ZTSAVE("I")=""
- SET ZTSAVE("TODAY1")=""
- SET ZTSAVE("PAGE")=""
- +3 IF IO'=IO(0)
- SET OUT1=0
- +4 IF $DATA(IO("Q"))
- SET ZTDESC="REQUEST REPORT"
- SET ZTRTN="WRITE1^PRCSOUT"
- SET ZTSAVE("OUT1")=""
- SET ZTSAVE("DA")=""
- SET ZTSAVE("^TMP($J,")=""
- SET ZTSAVE("D0")=""
- DO ^%ZTLOAD
- DO ^%ZISC
- DO EXIT
- DO WRITE2
- GOTO START
- +5 DO WRITE1
- DO ^%ZISC
- DO EXIT
- DO WRITE2
- GOTO START
- WRITE1 ;
- +1 USE IO
- DO HEADER
- FOR K=1:1:I-1
- IF $GET(^TMP($JOB,K))'=""
- Begin DoDot:1
- +2 if OUT=U
- QUIT
- if IOSL-($Y#IOSL)<6
- DO HOLD
- if OUT=U
- QUIT
- +3 WRITE !,?2,$PIECE(^TMP($JOB,K),"*",7)
- +4 SET D0=$PIECE(^TMP($JOB,K),"*",8)
- if D0'=""
- DO STATUS^PRCSES
- WRITE ?22,$EXTRACT(X,1,25)
- +5 WRITE ?50,$EXTRACT($PIECE(^TMP($JOB,K),"*",3),1,30)
- +6 WRITE !
- SET Y=$PIECE(^TMP($JOB,K),"*")
- DO DD^%DT
- WRITE Y
- +7 SET Y=$PIECE(^TMP($JOB,K),"*",2)
- DO DD^%DT
- WRITE ?15,Y
- +8 WRITE ?35,$PIECE(^TMP($JOB,K),"*",6)
- +9 SET Y=$PIECE(^TMP($JOB,K),"*",4)
- DO DD^%DT
- WRITE ?50,Y
- +10 SET Y=$PIECE(^TMP($JOB,K),"*",5)
- DO DD^%DT
- WRITE ?65,Y
- End DoDot:1
- +11 IF $DATA(ZTSK)
- DO KILL^%ZTLOAD
- KILL ZTSK
- +12 QUIT
- WRITE2 ;
- +1 USE IO(0)
- WRITE !!,"------------------",!,"End of processing",!
- HANG 2
- QUIT
- W1 WRITE !!,"You are not an authorized control point user.",!,"Please contact your control point official."
- READ I:5
- GOTO EXIT
- +1 SET PAGE=PAGE+1
- +2 IF PAGE'=1
- WRITE @IOF
- +3 WRITE !,"OUTSTANDING APPROVED REQUEST REPORT - CP ",$PIECE(PRC("CP")," "),?49,TODAY1,?72,"PAGE ",PAGE
- +4 WRITE !!,"TRANSACTION NUMBER",?22,"TRANSACTION STATUS",?50,"VENDOR"
- +5 WRITE !,"DATE SIGNED",?15,"EST. DEL. DATE",?35,"PO #",?50,"DATE OBL.",?65,"DATE REQ."
- +6 SET LL=""
- SET $PIECE(LL,"-",IOM)="-"
- WRITE !,LL
- SET LL=""
- QUIT
- HOLD ;
- +1 if IO'=IO(0)
- GOTO HEADER
- if $DATA(ZTQUEUED)
- GOTO HEADER
- WRITE !,"Press return to continue, uparrow (^) to exit: "
- READ OUT:100
- if '$TEST
- SET OUT=U
- if OUT'=U
- DO HEADER
- QUIT
- EXIT KILL ^TMP($JOB),PRCS
- QUIT