PRCUA ;WISC/PLT-One time use utility ; 01/03/94 8:37 AM
V ;;5.0;IFCAP;;4/21/95
QUIT ;invalid entry
EN1 ;Set 'p.o. date' in file 442 equal to 1358 request 'date obligated' in file 410
N PRC410,PRC442,PRCA,PRCB,ZTSTOP,X,Y
Q1 W !! D YN^PRC0A(.X,.Y,$P($T(EN1),";",2,999),"","YES") G EXIT:Y'=1
Q2 W ! D YN^PRC0A(.X,.Y,"Queue This Task","","") G Q1:Y?1"^".E
W ! I Y=1 D G EXIT
. S ZTSAVE("PRC*")="",ZTDESC=$P($T(EN1),";",2,999),ZTIO=""
. S ZTRTN="ETM^PRCUA" D ^%ZTLOAD
. W !,"TASK NUMBER ",$S($D(ZTSK):ZTSK_" assigned",1:"not assigned and try again")
. QUIT
ETM S PRCA="",ZTSTOP=""
F S PRCA=$O(^PRCS(410,"D",PRCA)) QUIT:PRCA="" D Q:ZTSTOP
. S PRC410=0 F S PRC410=$O(^PRCS(410,"D",PRCA,PRC410)) QUIT:PRC410'?1.N D Q:ZTSTOP=1
.. W:'$D(ZTQUEUED)&(PRC410#200=0) "."
.. I $D(ZTQUEUED),PRC410#30=0 S ZTSTOP=$$S^%ZTLOAD Q:ZTSTOP=1
.. S PRCB=$G(^PRCS(410,PRC410,0)) Q:$P(PRCB,"^",4)'=1
.. S PRCB=$G(^PRCS(410,PRC410,10)),PRC442=$P(PRCB,"^",3) Q:PRC442=""
.. S PRCB=$G(^PRCS(410,PRC410,4)) Q:$P(PRCB,"^",5)=""!($P(PRCB,"^",4)="")
.. Q:$P($G(^PRC(442,PRC442,1)),"^",15)'=""
.. S DA=PRC442,DIE="^PRC(442,",DR=".1////"_$P(PRCB,"^",4) D ^DIE
.. QUIT
. QUIT
W:'$D(ZTQUEUED) !!,"Set p.o. date in file 442 is done.",!!
K:ZTSTOP'=1 ZTSTOP
EXIT QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCUA 1286 printed Dec 13, 2024@02:19:29 Page 2
PRCUA ;WISC/PLT-One time use utility ; 01/03/94 8:37 AM
V ;;5.0;IFCAP;;4/21/95
+1 ;invalid entry
QUIT
EN1 ;Set 'p.o. date' in file 442 equal to 1358 request 'date obligated' in file 410
+1 NEW PRC410,PRC442,PRCA,PRCB,ZTSTOP,X,Y
Q1 WRITE !!
DO YN^PRC0A(.X,.Y,$PIECE($TEXT(EN1),";",2,999),"","YES")
if Y'=1
GOTO EXIT
Q2 WRITE !
DO YN^PRC0A(.X,.Y,"Queue This Task","","")
if Y?1"^".E
GOTO Q1
+1 WRITE !
IF Y=1
Begin DoDot:1
+2 SET ZTSAVE("PRC*")=""
SET ZTDESC=$PIECE($TEXT(EN1),";",2,999)
SET ZTIO=""
+3 SET ZTRTN="ETM^PRCUA"
DO ^%ZTLOAD
+4 WRITE !,"TASK NUMBER ",$SELECT($DATA(ZTSK):ZTSK_" assigned",1:"not assigned and try again")
+5 QUIT
End DoDot:1
GOTO EXIT
ETM SET PRCA=""
SET ZTSTOP=""
+1 FOR
SET PRCA=$ORDER(^PRCS(410,"D",PRCA))
if PRCA=""
QUIT
Begin DoDot:1
+2 SET PRC410=0
FOR
SET PRC410=$ORDER(^PRCS(410,"D",PRCA,PRC410))
if PRC410'?1.N
QUIT
Begin DoDot:2
+3 if '$DATA(ZTQUEUED)&(PRC410#200=0)
WRITE "."
+4 IF $DATA(ZTQUEUED)
IF PRC410#30=0
SET ZTSTOP=$$S^%ZTLOAD
if ZTSTOP=1
QUIT
+5 SET PRCB=$GET(^PRCS(410,PRC410,0))
if $PIECE(PRCB,"^",4)'=1
QUIT
+6 SET PRCB=$GET(^PRCS(410,PRC410,10))
SET PRC442=$PIECE(PRCB,"^",3)
if PRC442=""
QUIT
+7 SET PRCB=$GET(^PRCS(410,PRC410,4))
if $PIECE(PRCB,"^",5)=""!($PIECE(PRCB,"^",4)="")
QUIT
+8 if $PIECE($GET(^PRC(442,PRC442,1)),"^",15)'=""
QUIT
+9 SET DA=PRC442
SET DIE="^PRC(442,"
SET DR=".1////"_$PIECE(PRCB,"^",4)
DO ^DIE
+10 QUIT
End DoDot:2
if ZTSTOP=1
QUIT
+11 QUIT
End DoDot:1
if ZTSTOP
QUIT
+12 if '$DATA(ZTQUEUED)
WRITE !!,"Set p.o. date in file 442 is done.",!!
+13 if ZTSTOP'=1
KILL ZTSTOP
EXIT QUIT
+1 ;
