PRCSD11 ;WISC/SAW-CONTROL POINT ACTIVITY 1358 DISPLAY ;4/21/93 08:36
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
U IO W @IOF S U="^",PRCSP=1 D NOW^%DTC S Y=% D DD^%DT W !,$P(^PRCS(410,DA,0),U),?34,Y,?73,"PAGE ",PRCSP S L="",$P(L,"_",IOM)="_" W !,L
D NEWP1 W !,"Requestor:",?34,"|Date Requested:",?62,"|Obligation No.:"
W ?34,"|" I $D(^PRCS(410,DA,1)) S Y=$P(^(1),U) I Y D DD^%DT W Y
W ?62,"|" I $D(^PRCS(410,DA,4)),$P(^(4),U,5)'="" S PRCSPO=$P(^(4),U,5) W ?65,PRC("SITE")_"-"_PRCSPO
W !,L W !,"Vendor:",?34,"|Contract Number:"
W ! I $D(^PRCS(410,DA,2)) S X=$P(^(2),U) I X]"" W $E(X,1,31)
W ?34,"|" K PRCSG I $D(^PRCS(410,DA,3)) S PRCSG=^(3) I $P(PRCSG,U,10)]"" W $P(PRCSG,U,10)
W !,L W !,"Name and Title Approving Off.:",?34,"|Signature:",?62,"|Date Signed:"
N PRSHLA S PRSHLA=^DD(410,42,0) K P W ! I $D(P1),$P(PRSHLA,"^",2)[200 S P=$P(P1,U,3) S X=$S($D(^VA(200,+P,20)):$P(^(20),U,2),1:"") W $E(X,1,30)
W ?34,"|" I $D(P),P,$P(P1,U,6)'="" W "/ES/"_$$DECODE^PRCSC1(DA)
W ?62,"|" I $D(P1) S Y=$S($P(P1,U,7):$P(P1,U,7),1:$P(P1,U,5)) I Y D DD^%DT W Y K Y
W ! I $D(P1) W $P(P1,U,4)
W ?34,"|",?62,"|" W !,L W !,"FUND CERTIFICATION: The supplies and services listed on this request are"
W !,"properly chargeable to the following allotments, the available balances of"
W !,"which are sufficient to cover the cost thereof, and funds have been obligated."
W !,L,!,"Appropriation & Acct. Symbols:",?34,"|Obligated By: ",?62,"|Date Obligated:"
S DIWL=0,DIWR=80,DIWF="" K ^UTILITY($J)
I $D(^PRCS(410,DA,8,0)) S X1=0 F I=1:1 S X1=$O(^PRCS(410,DA,8,X1)) Q:X1="" S X=^(X1,0) D DIWP^PRCUTL($G(DA))
S P=PRC("SITE") I $D(PRCSG) S:$P(PRCSG,U,2)]"" P=P_"-"_$P(PRCSG,U,2) S P=P_"-"_$P(PRC("CP")," ") S:$P(PRCSG,U,3)]"" P=P_"-"_$P($P(PRCSG,U,3)," ") S:$P(PRCSG,U,6)]"" P=P_"-"_+$P(PRCSG,U,6)
W !,P,?34,"|" K PRCSG I $D(^PRCS(410,DA,4)) S PRCSG=^(4) I $P(PRCSG,U,9),$P(PRCSG,U,10)'="" W "/ES/"_$$DECODE^PRCSC2(DA)
W ?62,"|" I $D(PRCSG) S Y=$P(PRCSG,U,4) I Y D DD^%DT W Y
W !,L D HOLD G EXIT:Z3=U D NEWP
W !,"Purpose:" I $D(^UTILITY($J,"W",DIWL)) S Z=^UTILITY($J,"W",DIWL) F I=1:1:Z W !,^UTILITY($J,"W",DIWL,I,0) I IOSL-$Y<3 W !,L D HOLD Q:Z3=U D NEWP
G EXIT:Z3=U W !,L I IOSL-$Y<6 D HOLD G EXIT:Z3=U D NEWP
D ^PRCSD111 I Z3'=U D HOLD
EXIT K %DT,CT,UT,P1,P,PRCSP,PRCSA,PRCSG,PRCSPO,X,X1,Y,DIWL,DIWR,DIWF,Z,Z1,Z2,Z3,DA,I,L,^UTILITY($J) D:$D(ZTSK) KILL^%ZTLOAD Q
NEWP ;PRINT HEADER FOR NEW PAGE
W @IOF S PRCSP=PRCSP+1 W !,$P(^PRCS(410,DA,0),U) W:$D(PRCSPO) ?35,PRC("SITE")_"-"_PRCSPO W ?73,"PAGE ",PRCSP W !,L
NEWP1 W !,?11,"ESTIMATED MISCELLANEOUS OBLIGATION OR CHANGE IN OBLIGATION" W !,L
Q
HOLD S Z3="" W !,"Press return to continue, ""^"" to exit: " R Z3:DTIME S:'$T Z3=U Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSD11 2767 printed Dec 13, 2024@02:17:20 Page 2
PRCSD11 ;WISC/SAW-CONTROL POINT ACTIVITY 1358 DISPLAY ;4/21/93 08:36
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 USE IO
WRITE @IOF
SET U="^"
SET PRCSP=1
DO NOW^%DTC
SET Y=%
DO DD^%DT
WRITE !,$PIECE(^PRCS(410,DA,0),U),?34,Y,?73,"PAGE ",PRCSP
SET L=""
SET $PIECE(L,"_",IOM)="_"
WRITE !,L
+3 DO NEWP1
WRITE !,"Requestor:",?34,"|Date Requested:",?62,"|Obligation No.:"
+4 WRITE ?34,"|"
IF $DATA(^PRCS(410,DA,1))
SET Y=$PIECE(^(1),U)
IF Y
DO DD^%DT
WRITE Y
+5 WRITE ?62,"|"
IF $DATA(^PRCS(410,DA,4))
IF $PIECE(^(4),U,5)'=""
SET PRCSPO=$PIECE(^(4),U,5)
WRITE ?65,PRC("SITE")_"-"_PRCSPO
+6 WRITE !,L
WRITE !,"Vendor:",?34,"|Contract Number:"
+7 WRITE !
IF $DATA(^PRCS(410,DA,2))
SET X=$PIECE(^(2),U)
IF X]""
WRITE $EXTRACT(X,1,31)
+8 WRITE ?34,"|"
KILL PRCSG
IF $DATA(^PRCS(410,DA,3))
SET PRCSG=^(3)
IF $PIECE(PRCSG,U,10)]""
WRITE $PIECE(PRCSG,U,10)
+9 WRITE !,L
WRITE !,"Name and Title Approving Off.:",?34,"|Signature:",?62,"|Date Signed:"
+10 NEW PRSHLA
SET PRSHLA=^DD(410,42,0)
KILL P
WRITE !
IF $DATA(P1)
IF $PIECE(PRSHLA,"^",2)[200
SET P=$PIECE(P1,U,3)
SET X=$SELECT($DATA(^VA(200,+P,20)):$PIECE(^(20),U,2),1:"")
WRITE $EXTRACT(X,1,30)
+11 WRITE ?34,"|"
IF $DATA(P)
IF P
IF $PIECE(P1,U,6)'=""
WRITE "/ES/"_$$DECODE^PRCSC1(DA)
+12 WRITE ?62,"|"
IF $DATA(P1)
SET Y=$SELECT($PIECE(P1,U,7):$PIECE(P1,U,7),1:$PIECE(P1,U,5))
IF Y
DO DD^%DT
WRITE Y
KILL Y
+13 WRITE !
IF $DATA(P1)
WRITE $PIECE(P1,U,4)
+14 WRITE ?34,"|",?62,"|"
WRITE !,L
WRITE !,"FUND CERTIFICATION: The supplies and services listed on this request are"
+15 WRITE !,"properly chargeable to the following allotments, the available balances of"
+16 WRITE !,"which are sufficient to cover the cost thereof, and funds have been obligated."
+17 WRITE !,L,!,"Appropriation & Acct. Symbols:",?34,"|Obligated By: ",?62,"|Date Obligated:"
+18 SET DIWL=0
SET DIWR=80
SET DIWF=""
KILL ^UTILITY($JOB)
+19 IF $DATA(^PRCS(410,DA,8,0))
SET X1=0
FOR I=1:1
SET X1=$ORDER(^PRCS(410,DA,8,X1))
if X1=""
QUIT
SET X=^(X1,0)
DO DIWP^PRCUTL($GET(DA))
+20 SET P=PRC("SITE")
IF $DATA(PRCSG)
if $PIECE(PRCSG,U,2)]""
SET P=P_"-"_$PIECE(PRCSG,U,2)
SET P=P_"-"_$PIECE(PRC("CP")," ")
if $PIECE(PRCSG,U,3)]""
SET P=P_"-"_$PIECE($PIECE(PRCSG,U,3)," ")
if $PIECE(PRCSG,U,6)]""
SET P=P_"-"_+$PIECE(PRCSG,U,6)
+21 WRITE !,P,?34,"|"
KILL PRCSG
IF $DATA(^PRCS(410,DA,4))
SET PRCSG=^(4)
IF $PIECE(PRCSG,U,9)
IF $PIECE(PRCSG,U,10)'=""
WRITE "/ES/"_$$DECODE^PRCSC2(DA)
+22 WRITE ?62,"|"
IF $DATA(PRCSG)
SET Y=$PIECE(PRCSG,U,4)
IF Y
DO DD^%DT
WRITE Y
+23 WRITE !,L
DO HOLD
if Z3=U
GOTO EXIT
DO NEWP
+24 WRITE !,"Purpose:"
IF $DATA(^UTILITY($JOB,"W",DIWL))
SET Z=^UTILITY($JOB,"W",DIWL)
FOR I=1:1:Z
WRITE !,^UTILITY($JOB,"W",DIWL,I,0)
IF IOSL-$Y<3
WRITE !,L
DO HOLD
if Z3=U
QUIT
DO NEWP
+25 if Z3=U
GOTO EXIT
WRITE !,L
IF IOSL-$Y<6
DO HOLD
if Z3=U
GOTO EXIT
DO NEWP
+26 DO ^PRCSD111
IF Z3'=U
DO HOLD
EXIT KILL %DT,CT,UT,P1,P,PRCSP,PRCSA,PRCSG,PRCSPO,X,X1,Y,DIWL,DIWR,DIWF,Z,Z1,Z2,Z3,DA,I,L,^UTILITY($JOB)
if $DATA(ZTSK)
DO KILL^%ZTLOAD
QUIT
NEWP ;PRINT HEADER FOR NEW PAGE
+1 WRITE @IOF
SET PRCSP=PRCSP+1
WRITE !,$PIECE(^PRCS(410,DA,0),U)
if $DATA(PRCSPO)
WRITE ?35,PRC("SITE")_"-"_PRCSPO
WRITE ?73,"PAGE ",PRCSP
WRITE !,L
NEWP1 WRITE !,?11,"ESTIMATED MISCELLANEOUS OBLIGATION OR CHANGE IN OBLIGATION"
WRITE !,L
+1 QUIT
HOLD SET Z3=""
WRITE !,"Press return to continue, ""^"" to exit: "
READ Z3:DTIME
if '$TEST
SET Z3=U
QUIT
