PRCSP1B ;WISC/SAW-CONTROL POINT ACTIVITY ;10-11-91/10:24
V ;;5.1;IFCAP;**150**;Oct 20, 2000;Build 24
;Per VHA Directive 2004-038, this routine should not be modified.
PROJ ;PROJECT NUMBER REPORT
D EN1^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
S PRCSAZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
S L=0,DIC="^PRCS(410,",FLDS="[PRCSPROJ]",DHD="SORT GROUP REPORT - CP: "_PRC("CP"),BY="+49;S1,.01",FR="?,"_PRCSAZ_"-0001",TO="?,"_PRCSAZ_"-9999"
D EN1^DIP K L,DIC,FLDS,DHD,BY,FR,TO,PRC("CP"),PRCSAZ Q
TEMPT ;LIST OF TEMPORARY TRANSACTIONS
;Changed via PRC*5.1*150 ^DIP print logic to controlled print to handle FCP editing mid stream for reporting older temp tx
K ^TMP($J,"PRCSP1B")
D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
DATE S U="^",%DT="XEA",%DT("A")="Start Date of Request: " D ^%DT G:X[U!$D(DTOUT) TEXIT
I X="" W " Start Date REQUIRED" G DATE
S PRCDATE(1)=+Y
EDATE S %DT="XEA",%DT("A")="Go To Date of Request: " D ^%DT G:X[U!$D(DTOUT) TEXIT
I X="" W " Go to Date REQUIRED" G EDATE
S PRCDATE(2)=+Y
I PRCDATE(1)>PRCDATE(2) W !!,$C(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",! G EDATE
;
QUE S %ZIS="Q" D ^%ZIS G:POP EXIT I '$D(IO("Q")) U IO G TCMP
S ZTRTN="TCMP^PRCSP1B",ZTSAVE("DATE*")="",ZTSAVE("PRC*")="",ZTDESC="TEMPORARY TRANSACTION LISTING" D ^%ZTLOAD,HOME^%ZIS G TEXIT
;
TCMP ;COMPILE FCP TEMP REQUESTS
S PRCANX=$P(PRC("CP")," ")_" ",PRCANXH=PRCANX,PRCEND=0,PRCTTOT=0
TC1 S PRCANX=$O(^PRCS(410,"AN",PRCANX)),PRCSIEN=0 G TPRT:PRCANX=""!(+PRCANX>+PRCANXH)
TC2 S PRCSIEN=$O(^PRCS(410,"AN",PRCANX,PRCSIEN)) G TC1:PRCSIEN=""
I '$D(^PRCS(410,PRCSIEN)) G TC2
S PRCR0=$G(^PRCS(410,PRCSIEN,0)) G TC2:PRCR0=""
I +$P(PRCR0,U)'=0!($P(PRCR0,U,2)="CA") G TC2
S PRCR1=$G(^PRCS(410,PRCSIEN,1)) G TC2:PRCR1=""
I $P(PRCR1,U)<PRCDATE(1)!($P(PRCR1,U)>PRCDATE(2)) G TC2
S ^TMP($J,"PRCSP1B",$P(PRCR1,U),PRCSIEN)=""
G TC2
;
TPRT ;PRINT OF THE TEMP TX REPORT
S PRCNOW=$$NOW(),PRCDSH="",$P(PRCDSH,"-",81)="",PRCTTOT=0
S (PRCEND,PRCPAGE,PRCEXIT)=0 D HDR
S PRCDATEA=0
PT1 S PRCDATEA=$O(^TMP($J,"PRCSP1B",PRCDATEA)),PRCSIEN=0 I PRCDATEA="" S PRCEXIT=1 G TQUIT
PT2 S PRCSIEN=$O(^TMP($J,"PRCSP1B",PRCDATEA,PRCSIEN)) I PRCSIEN="" G PT1
S PRCTTOT=PRCTTOT+1
S PRCR0=$G(^PRCS(410,PRCSIEN,0)),PRCR1=$G(^PRCS(410,PRCSIEN,1)),PRCR2=$G(^PRCS(410,PRCSIEN,2)),PRCR4=$G(^PRCS(410,PRCSIEN,4)),PRCR7=$G(^PRCS(410,PRCSIEN,7))
S PRCRDATE=$P(PRCR1,U),PRCREQTR=$P(PRCR7,U),PRCVEND=$E($P(PRCR2,U),1,9),PRCCOST=$P(PRCR4,U)
S PRCFITEM=$P($G(^PRCS(410,PRCSIEN,"IT",1,1,1,0)),U),PRCREQTR=$E($G(^VA(200,PRCREQTR,0),U),1,9),PRCRDATE=$$FMTE^XLFDT(PRCRDATE)
W !,$P(PRCR0,U),?19,PRCRDATE,?32,PRCREQTR,?43,PRCVEND,?54,$E(PRCFITEM,1,15),?70,$J($FN(PRCCOST,",",2),10)
D HDR:$Y+2>IOSL G TEXIT:PRCEND
G PT2
TQUIT I PRCTTOT=0 W !!," << NO TEMPORARY TRANSACTIONS TO PRINT FOR TIME PERIOD SELECTED >>" S PRCPAGE=1
TEXIT S:$E(IOST,1,2)="C-" IOSL=24
K ^TMP($J,"PRCSP1B") D:$G(PRCPAGE)>0 HDR
D ^%ZISC
K PRCDATE,%DT,X,DTOUT,PRCANX,PRCANXH,ZTRTN,ZTSAVE,ZTDESC,PRCSIEN,PRCR0,PRCR1,PRCR2,PRCR4,PRCR7,PRCNOW,PRCDSH,PRCEND,PRCPAGE,PRCDATEA
K PRCRDATE,PRCREQTR,PRCVEND,PRCCOST,PRCFITEM,PRCTTOT,%ZIS,POP,NOW,PRCEXIT
Q
HDR ;PRINT HEADING
I PRCPAGE>0,$E(IOST,1,2)="C-" S PRCEND=$$EOP() Q:PRCEND
I PRCEXIT=1 W @IOF Q
S PRCPAGE=PRCPAGE+1 W @IOF,!,"TEMPORARY TRANSACTION LISTING - CONTROL POINT ",PRC("CP")
W !,?45,PRCNOW,"Page ",$J(PRCPAGE,3)
W !,"TEMPORARY",?19,"DATE OF",?54,"FIRST LINE ITEM COMM"
W !,"TRANSACTION #",?19,"REQUEST",?32,"REQUESTOR VENDOR",?54,"DESCRIPTION",?71,"COST"
W !,PRCDSH
QUIT
EOP() ; end of page check - return 1 to quit, 0 to continue
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
I $E(IOST,1,2)'="C-" Q 0 ; not to terminal
F I=1:1 Q:($Y>(IOSL-2)) W !
S DIR(0)="E"
D ^DIR
Q 'Y
;
;
NOW() ; return NOW in external format for print on reports
N X
S X=$$FMTE^XLFDT($$NOW^XLFDT())
Q $P($$UP^XLFSTR(X),":",1,2)
;
SUBCP ;SUB-CONTROL POINT REPORT
W !,"Would you like the report printed for a full Fiscal Year"
S %=1 D ^PRCFYN G EXIT:%<0 G S2:%=1
S1 D EN1^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
G:'$D(PRC("CP")) EXIT
S PRCSAZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
S DIC="^PRCS(410,",DHD="SUB-CONTROL POINT EXPENDITURES - "_PRC("CP")_" for FY-Q: "_PRC("FY")_"-"_PRC("QTR")
S FLDS="[PRCSSBCPT]",BY="16,+.01;S1,@.01",FR="?,"_PRCSAZ_"-0001"
S TO="?,"_PRCSAZ_"-9999",L=0 D EN1^DIP
K DIS(0),PRC("SCP"),PRC("CP"),PRC("QTR"),PRC("FY"),PRCS(1) G SUBCP
S2 D STA^PRCSUT G W2:'$D(PRC("SITE")) D FY^PRCSUT Q:'$D(PRC("FY")) Q:PRC("FY")="^" G EXIT:Y<0 D CP^PRCSUT
G EXIT:Y<0 ;S DIC="^PRCS(410.4,",DIC(0)="AEMQ" D ^DIC G S2:Y<0
S DIC="^PRCS(410," S DHD="SUB-CONTROL POINT EXPENDITURES - "_PRC("CP"),FLDS="[PRCSSBCPT1]"
S BY="16,+.01;S1,@.01",FR="?,"_PRC("SITE")_"-"_PRC("FY")_"-1-"_$P(PRC("CP")," ")_"-0001",TO="?,"_PRC("SITE")_"-"_PRC("FY")_"-4-"_$P(PRC("CP")," ")_"-9999",L=0
S DIS(0)="I $D(^PRCS(410,D0,0)),$P(^(0),""-"",4)=$P(PRC(""CP""),"" "")"
D EN1^DIP K DIS(0),PRC("CP"),PRC("FY"),PRCS(1) G EXIT
POS ;PURCHASE ORDER STATUS
D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
S DIC="^PRC(442,",DIC(0)="AEQM",DIC("A")="Select PURCHASE ORDER NUMBER: ",DIC("S")="I +^(0)=PRC(""SITE""),+$P(^(0),""^"",3)=+PRC(""CP"")" D ^DIC G EXIT:Y<0 K DIC S D0=+Y,X=$S($D(^PRC(442,+Y,7)):+^(7),1:0)
S X=$S($D(^PRCD(442.3,X,0)):^(0),1:"UNKNOWN") W !!,"Purchase Order Status: ",$P(X,"^") I $P(X,"^",2)<10 D EXIT G POS
POS1 W !!,"Would you like the purchase order display" S %=2 D YN^DICN G POS1:%=0 G:%=2 POS2 D:%=1 ^PRCHDP1 I %=-1 D EXIT,W1 Q:$D(PRCSX) G POS
POS2 W !!,"Would you like to review the entire purchase order" S %=2 D YN^DICN G POS2:%=0 I %'=1 D EXIT,W1 Q:$D(PRCSX) G POS
S PRCHQ="^PRCHFPNT",PRCHQ("DEST")="US" D ^PRCHQUE K IOP D EXIT,W1 K ZTSK Q:$D(PRCSX) G POS
S S L=0,DIC="^PRCS(410,"
D EN1^DIP Q
DEV K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q
W1 W !!,"Enter information for another report or an uparrow to return to the menu.",! Q
W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
NONE W !!,"A status has not yet been reported for this purchase order." 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 U IO(0)
EXIT K %,%DT,BY,C,C0,C2,C3,D,DA,DHD,DIC,DIE,PRCS,FLDS,FR,I,L,N,TO,X,Y,Z,Z1,ZTRTN,ZTSAVE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSP1B 6417 printed Nov 22, 2024@17:28:11 Page 2
PRCSP1B ;WISC/SAW-CONTROL POINT ACTIVITY ;10-11-91/10:24
V ;;5.1;IFCAP;**150**;Oct 20, 2000;Build 24
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
PROJ ;PROJECT NUMBER REPORT
+1 DO EN1^PRCSUT
if '$DATA(PRC("SITE"))
GOTO W2
if Y<0
GOTO EXIT
+2 SET PRCSAZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$PIECE(PRC("CP")," ")
+3 SET L=0
SET DIC="^PRCS(410,"
SET FLDS="[PRCSPROJ]"
SET DHD="SORT GROUP REPORT - CP: "_PRC("CP")
SET BY="+49;S1,.01"
SET FR="?,"_PRCSAZ_"-0001"
SET TO="?,"_PRCSAZ_"-9999"
+4 DO EN1^DIP
KILL L,DIC,FLDS,DHD,BY,FR,TO,PRC("CP"),PRCSAZ
QUIT
TEMPT ;LIST OF TEMPORARY TRANSACTIONS
+1 ;Changed via PRC*5.1*150 ^DIP print logic to controlled print to handle FCP editing mid stream for reporting older temp tx
+2 KILL ^TMP($JOB,"PRCSP1B")
+3 DO EN3^PRCSUT
if '$DATA(PRC("SITE"))
GOTO W2
if Y<0
GOTO EXIT
DATE SET U="^"
SET %DT="XEA"
SET %DT("A")="Start Date of Request: "
DO ^%DT
if X[U!$DATA(DTOUT)
GOTO TEXIT
+1 IF X=""
WRITE " Start Date REQUIRED"
GOTO DATE
+2 SET PRCDATE(1)=+Y
EDATE SET %DT="XEA"
SET %DT("A")="Go To Date of Request: "
DO ^%DT
if X[U!$DATA(DTOUT)
GOTO TEXIT
+1 IF X=""
WRITE " Go to Date REQUIRED"
GOTO EDATE
+2 SET PRCDATE(2)=+Y
+3 IF PRCDATE(1)>PRCDATE(2)
WRITE !!,$CHAR(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",!
GOTO EDATE
+4 ;
QUE SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
IF '$DATA(IO("Q"))
USE IO
GOTO TCMP
+1 SET ZTRTN="TCMP^PRCSP1B"
SET ZTSAVE("DATE*")=""
SET ZTSAVE("PRC*")=""
SET ZTDESC="TEMPORARY TRANSACTION LISTING"
DO ^%ZTLOAD
DO HOME^%ZIS
GOTO TEXIT
+2 ;
TCMP ;COMPILE FCP TEMP REQUESTS
+1 SET PRCANX=$PIECE(PRC("CP")," ")_" "
SET PRCANXH=PRCANX
SET PRCEND=0
SET PRCTTOT=0
TC1 SET PRCANX=$ORDER(^PRCS(410,"AN",PRCANX))
SET PRCSIEN=0
if PRCANX=""!(+PRCANX>+PRCANXH)
GOTO TPRT
TC2 SET PRCSIEN=$ORDER(^PRCS(410,"AN",PRCANX,PRCSIEN))
if PRCSIEN=""
GOTO TC1
+1 IF '$DATA(^PRCS(410,PRCSIEN))
GOTO TC2
+2 SET PRCR0=$GET(^PRCS(410,PRCSIEN,0))
if PRCR0=""
GOTO TC2
+3 IF +$PIECE(PRCR0,U)'=0!($PIECE(PRCR0,U,2)="CA")
GOTO TC2
+4 SET PRCR1=$GET(^PRCS(410,PRCSIEN,1))
if PRCR1=""
GOTO TC2
+5 IF $PIECE(PRCR1,U)<PRCDATE(1)!($PIECE(PRCR1,U)>PRCDATE(2))
GOTO TC2
+6 SET ^TMP($JOB,"PRCSP1B",$PIECE(PRCR1,U),PRCSIEN)=""
+7 GOTO TC2
+8 ;
TPRT ;PRINT OF THE TEMP TX REPORT
+1 SET PRCNOW=$$NOW()
SET PRCDSH=""
SET $PIECE(PRCDSH,"-",81)=""
SET PRCTTOT=0
+2 SET (PRCEND,PRCPAGE,PRCEXIT)=0
DO HDR
+3 SET PRCDATEA=0
PT1 SET PRCDATEA=$ORDER(^TMP($JOB,"PRCSP1B",PRCDATEA))
SET PRCSIEN=0
IF PRCDATEA=""
SET PRCEXIT=1
GOTO TQUIT
PT2 SET PRCSIEN=$ORDER(^TMP($JOB,"PRCSP1B",PRCDATEA,PRCSIEN))
IF PRCSIEN=""
GOTO PT1
+1 SET PRCTTOT=PRCTTOT+1
+2 SET PRCR0=$GET(^PRCS(410,PRCSIEN,0))
SET PRCR1=$GET(^PRCS(410,PRCSIEN,1))
SET PRCR2=$GET(^PRCS(410,PRCSIEN,2))
SET PRCR4=$GET(^PRCS(410,PRCSIEN,4))
SET PRCR7=$GET(^PRCS(410,PRCSIEN,7))
+3 SET PRCRDATE=$PIECE(PRCR1,U)
SET PRCREQTR=$PIECE(PRCR7,U)
SET PRCVEND=$EXTRACT($PIECE(PRCR2,U),1,9)
SET PRCCOST=$PIECE(PRCR4,U)
+4 SET PRCFITEM=$PIECE($GET(^PRCS(410,PRCSIEN,"IT",1,1,1,0)),U)
SET PRCREQTR=$EXTRACT($GET(^VA(200,PRCREQTR,0),U),1,9)
SET PRCRDATE=$$FMTE^XLFDT(PRCRDATE)
+5 WRITE !,$PIECE(PRCR0,U),?19,PRCRDATE,?32,PRCREQTR,?43,PRCVEND,?54,$EXTRACT(PRCFITEM,1,15),?70,$JUSTIFY($FNUMBER(PRCCOST,",",2),10)
+6 if $Y+2>IOSL
DO HDR
if PRCEND
GOTO TEXIT
+7 GOTO PT2
TQUIT IF PRCTTOT=0
WRITE !!," << NO TEMPORARY TRANSACTIONS TO PRINT FOR TIME PERIOD SELECTED >>"
SET PRCPAGE=1
TEXIT if $EXTRACT(IOST,1,2)="C-"
SET IOSL=24
+1 KILL ^TMP($JOB,"PRCSP1B")
if $GET(PRCPAGE)>0
DO HDR
+2 DO ^%ZISC
+3 KILL PRCDATE,%DT,X,DTOUT,PRCANX,PRCANXH,ZTRTN,ZTSAVE,ZTDESC,PRCSIEN,PRCR0,PRCR1,PRCR2,PRCR4,PRCR7,PRCNOW,PRCDSH,PRCEND,PRCPAGE,PRCDATEA
+4 KILL PRCRDATE,PRCREQTR,PRCVEND,PRCCOST,PRCFITEM,PRCTTOT,%ZIS,POP,NOW,PRCEXIT
+5 QUIT
HDR ;PRINT HEADING
+1 IF PRCPAGE>0
IF $EXTRACT(IOST,1,2)="C-"
SET PRCEND=$$EOP()
if PRCEND
QUIT
+2 IF PRCEXIT=1
WRITE @IOF
QUIT
+3 SET PRCPAGE=PRCPAGE+1
WRITE @IOF,!,"TEMPORARY TRANSACTION LISTING - CONTROL POINT ",PRC("CP")
+4 WRITE !,?45,PRCNOW,"Page ",$JUSTIFY(PRCPAGE,3)
+5 WRITE !,"TEMPORARY",?19,"DATE OF",?54,"FIRST LINE ITEM COMM"
+6 WRITE !,"TRANSACTION #",?19,"REQUEST",?32,"REQUESTOR VENDOR",?54,"DESCRIPTION",?71,"COST"
+7 WRITE !,PRCDSH
+8 QUIT
EOP() ; end of page check - return 1 to quit, 0 to continue
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 ; not to terminal
IF $EXTRACT(IOST,1,2)'="C-"
QUIT 0
+4 FOR I=1:1
if ($Y>(IOSL-2))
QUIT
WRITE !
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 QUIT 'Y
+8 ;
+9 ;
NOW() ; return NOW in external format for print on reports
+1 NEW X
+2 SET X=$$FMTE^XLFDT($$NOW^XLFDT())
+3 QUIT $PIECE($$UP^XLFSTR(X),":",1,2)
+4 ;
SUBCP ;SUB-CONTROL POINT REPORT
+1 WRITE !,"Would you like the report printed for a full Fiscal Year"
+2 SET %=1
DO ^PRCFYN
if %<0
GOTO EXIT
if %=1
GOTO S2
S1 DO EN1^PRCSUT
if '$DATA(PRC("SITE"))
GOTO W2
if Y<0
GOTO EXIT
+1 if '$DATA(PRC("CP"))
GOTO EXIT
+2 SET PRCSAZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$PIECE(PRC("CP")," ")
+3 SET DIC="^PRCS(410,"
SET DHD="SUB-CONTROL POINT EXPENDITURES - "_PRC("CP")_" for FY-Q: "_PRC("FY")_"-"_PRC("QTR")
+4 SET FLDS="[PRCSSBCPT]"
SET BY="16,+.01;S1,@.01"
SET FR="?,"_PRCSAZ_"-0001"
+5 SET TO="?,"_PRCSAZ_"-9999"
SET L=0
DO EN1^DIP
+6 KILL DIS(0),PRC("SCP"),PRC("CP"),PRC("QTR"),PRC("FY"),PRCS(1)
GOTO SUBCP
S2 DO STA^PRCSUT
if '$DATA(PRC("SITE"))
GOTO W2
DO FY^PRCSUT
if '$DATA(PRC("FY"))
QUIT
if PRC("FY")="^"
QUIT
if Y<0
GOTO EXIT
DO CP^PRCSUT
+1 ;S DIC="^PRCS(410.4,",DIC(0)="AEMQ" D ^DIC G S2:Y<0
if Y<0
GOTO EXIT
+2 SET DIC="^PRCS(410,"
SET DHD="SUB-CONTROL POINT EXPENDITURES - "_PRC("CP")
SET FLDS="[PRCSSBCPT1]"
+3 SET BY="16,+.01;S1,@.01"
SET FR="?,"_PRC("SITE")_"-"_PRC("FY")_"-1-"_$PIECE(PRC("CP")," ")_"-0001"
SET TO="?,"_PRC("SITE")_"-"_PRC("FY")_"-4-"_$PIECE(PRC("CP")," ")_"-9999"
SET L=0
+4 SET DIS(0)="I $D(^PRCS(410,D0,0)),$P(^(0),""-"",4)=$P(PRC(""CP""),"" "")"
+5 DO EN1^DIP
KILL DIS(0),PRC("CP"),PRC("FY"),PRCS(1)
GOTO EXIT
POS ;PURCHASE ORDER STATUS
+1 DO EN3^PRCSUT
if '$DATA(PRC("SITE"))
GOTO W2
if Y<0
GOTO EXIT
+2 SET DIC="^PRC(442,"
SET DIC(0)="AEQM"
SET DIC("A")="Select PURCHASE ORDER NUMBER: "
SET DIC("S")="I +^(0)=PRC(""SITE""),+$P(^(0),""^"",3)=+PRC(""CP"")"
DO ^DIC
if Y<0
GOTO EXIT
KILL DIC
SET D0=+Y
SET X=$SELECT($DATA(^PRC(442,+Y,7)):+^(7),1:0)
+3 SET X=$SELECT($DATA(^PRCD(442.3,X,0)):^(0),1:"UNKNOWN")
WRITE !!,"Purchase Order Status: ",$PIECE(X,"^")
IF $PIECE(X,"^",2)<10
DO EXIT
GOTO POS
POS1 WRITE !!,"Would you like the purchase order display"
SET %=2
DO YN^DICN
if %=0
GOTO POS1
if %=2
GOTO POS2
if %=1
DO ^PRCHDP1
IF %=-1
DO EXIT
DO W1
if $DATA(PRCSX)
QUIT
GOTO POS
POS2 WRITE !!,"Would you like to review the entire purchase order"
SET %=2
DO YN^DICN
if %=0
GOTO POS2
IF %'=1
DO EXIT
DO W1
if $DATA(PRCSX)
QUIT
GOTO POS
+1 SET PRCHQ="^PRCHFPNT"
SET PRCHQ("DEST")="US"
DO ^PRCHQUE
KILL IOP
DO EXIT
DO W1
KILL ZTSK
if $DATA(PRCSX)
QUIT
GOTO POS
S SET L=0
SET DIC="^PRCS(410,"
+1 DO EN1^DIP
QUIT
DEV KILL IO("Q")
SET %ZIS("B")="HOME"
SET %ZIS="MQ"
DO ^%ZIS
QUIT
W1 WRITE !!,"Enter information for another report or an uparrow to return to the menu.",!
QUIT
W2 WRITE !!,"You are not an authorized control point user.",!,"Contact your control point official."
READ X:5
GOTO EXIT
NONE WRITE !!,"A status has not yet been reported for this purchase order."
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
USE IO(0)
EXIT KILL %,%DT,BY,C,C0,C2,C3,D,DA,DHD,DIC,DIE,PRCS,FLDS,FR,I,L,N,TO,X,Y,Z,Z1,ZTRTN,ZTSAVE
QUIT
