PSXQUE ;BIR/WPB-Displays the Batch Queue at the Host ; [ 04/08/97 2:06 PM ]
;;2.0;CMOP;;11 Apr 97
EN ;
I $G(^PSX(553,1,"S"))="R" W !,"The interface must be stopped in order to prioritize the queue!!",!! Q
I '$D(^PSX(552.1,"AQ"))&('$D(^PSX(552.1,"APQ"))) W !,?21,"********** Queue is empty. *********" Q
K ^TMP("PSXQUE",$J),^TMP("PSXQ",$J),TORD,TRX
S COM="CMOP TRANSMISSION QUEUE",RCDT=$P($$HTE^XLFDT($H),":",1,2),SP=(80-$L(COM))\2,SP2=(80-$L(RCDT))\2
G:$D(^PSX(552.1,"APQ")) PRIOR G:$G(STOP) EXIT
S TOT=0 F S TOT=$O(^PSX(552.1,"AQ",TOT)) Q:TOT'>0 S TOTAL=$G(TOTAL)+1
D HDR
S (CNT,RDT)=0 F S RDT=$O(^PSX(552.1,"AQ",RDT)) Q:RDT'>0 S BAT="" F S BAT=$O(^PSX(552.1,"AQ",RDT,BAT)) Q:BAT="" S REC=0 F S REC=$O(^PSX(552.1,"AQ",RDT,BAT,REC)) Q:REC'>0 G:$G(STOP)=1 ASK D DATA
;W !,"TOTALS",?9,TOTAL,?64,TORD_"/"_TRX
K DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,TRX,TORD,TOTAL
ASK S DIR(0)="Y",DIR("A")="Accept Sequence",DIR("B")="YES",DIR("?")="Yes - Download in FIFO sequence. No - Set a priority to download to the vendor." D ^DIR K DIR,STOP G:Y=1!($G(DIRUT))!($G(DTOUT))!($G(DUOUT))!($G(DIROUT)) EXIT G:Y'>0 SELECT
HDR W @IOF
S LCNT=0
W !,?SP,COM,!,?SP2,RCDT
I $D(^PSX(552.1,"APQ")) W !,?SP3,COM1
W !,?2,"SEQ #",?9,"TRANSMISSION",?25,"DIVISION",?49,"RECEIVED DATE",?64,"ORDERS/RXS",!
F I=0:1:79 W "-"
K I,Y,X,DIRUT,DIROUT,DTOUT,DUOUT W ! S LCNT=7
Q
EXIT K RDT,BAT,REC,FROM,ORD,R,RECV,RR,RXS,TOT,TOTAL,Y,CNT,STOP,TORD,TRX,LCNT,SP,SP2,COM,AQ1,RCDT,DIRUT,DIROUT,DTOUT,DUOUT,X,LIST,BAT1,BAT2,SEQ,HH,PP,JJ,COM1,SP3,LIST1
S DIR(0)="E",DIR("A")="Press RETURN to start interface, ""^"" to quit" D ^DIR G:Y=1 ALL^PSXSTRT
Q
DATA ;
S FROM=$P($G(^PSX(552.1,REC,"P")),U,1),ORD=$P($G(^PSX(552.1,REC,1)),U,3),RXS=$P($G(^PSX(552.1,REC,1)),U,4),Y=$P($G(^PSX(552.1,REC,0)),U,4) X ^DD("DD") S RECV=$P(Y,"@",1),RR=$P(Y,"@",2),R=$P(RR,":",1,2) K Y
S:'($G(AQ1)) TORD=$G(TORD)+ORD,TRX=$G(TRX)+RXS
G:$P(^PSX(552.1,REC,0),"^",7)'=""&('$G(AQ1)) CK
S CNT=CNT+1,^TMP("PSXQUE",$J,CNT)=REC_"^"_BAT
W $S($G(AQ1):"*",1:" "),$J(CNT,5),?9,BAT,?25,FROM,?49,$P(RECV,",",1)_"@"_R,?64,ORD_"/"_RXS,!
S LCNT=LCNT+1
CK I LCNT>22 S DIR(0)="E" D ^DIR K DIR S:Y=0 STOP=1 Q:Y=0 D HDR
Q
SELECT K DIR,Y,DIROUT,DUOUT,DTOUT,DIRUT
I $D(^PSX(552.1,"APQ")) S DIR(0)="Y",DIR("A")="Reset to Original Sequence",DIR("B")="YES" D ^DIR K DIR G:Y=1 RESET G:$G(DIRUT)!($G(DTOUT))!($G(DUOUT))!($G(DIROUT)) EXIT
K DIR,Y,DIROUT,DUOUT,DTOUT,DIRUT
S DIR(0)="L^1:"_CNT_"",DIR("A")="Enter priority" D ^DIR K DIR S LIST=Y G:$G(LIST)'>0 EXIT F N=1:1 S M=$P(LIST,",",N) Q:M="" S MN=$G(MN)+1
I $G(LIST1) F HH=1:1 S PP=$P(LIST1,"^",HH) Q:PP="" S BAT2=$P(^TMP("PSXQUE",$J,PP),"^",1) S NSEQ=$P(^PSX(552.1,BAT2,0),"^",7)+MN,DIE="^PSX(552.1,",DR="20////"_NSEQ,DA=BAT2 D ^DIE K DIE,DA,DR,NSEQ
F SEQ=1:1 S JJ=$P(LIST,",",SEQ) Q:JJ="" S BAT1=$P(^TMP("PSXQUE",$J,JJ),"^",1) S DIE="^PSX(552.1,",DR="20////"_SEQ,DA=BAT1 D ^DIE K DIE,DA,DR,BAT1
K JJ,HH,PP,BAT1,LIST,SEQ,BAT1,LIST1,N,M,MN
D PRIOR
;G EXIT
Q
PRIOR N FROM,REC,ORD,RXS,Y,RECV,RR,R,BAT
S TOT=0 F S TOT=$O(^PSX(552.1,"AQ",TOT)) Q:TOT'>0 S TOTAL=$G(TOTAL)+1
S COM1="* Priority",SP3=(80-$L(COM1))\2
D HDR
S (CNT,RDT)=0 F S RDT=$O(^PSX(552.1,"APQ",RDT)) Q:RDT'>0 S LIST1=$G(LIST1)_RDT_"^" S BAT="" F S BAT=$O(^PSX(552.1,"APQ",RDT,BAT)) Q:BAT="" S REC=0 F S REC=$O(^PSX(552.1,"APQ",RDT,BAT,REC)) Q:REC'>0 G:$G(STOP)=1 ASK1 S AQ1=1 D DATA
N FROM,REC,Y,RECV,RR,R,BAT K AQ1
S RDT=0 F S RDT=$O(^PSX(552.1,"AQ",RDT)) Q:RDT'>0 S BAT="" F S BAT=$O(^PSX(552.1,"AQ",RDT,BAT)) Q:BAT="" S REC=0 F S REC=$O(^PSX(552.1,"AQ",RDT,BAT,REC)) Q:REC'>0 G:$G(STOP)=1 ASK1 D DATA
W !,"TOTALS",?9,TOTAL,?64,TORD_"/"_TRX
K DIR,DIRUT,DUOUT,DTOUT,DIROUT,Y,TOTAL,TRX,TORD,TTORD,TTRX
ASK1 S DIR(0)="Y",DIR("A")="Accept",DIR("B")="YES" D ^DIR K DIR,STOP G:(Y>0)!($G(DIRUT))!($G(DTOUT))!($G(DUOUT))!($G(DIROUT)) EXIT G:Y'>0 SELECT
Q
RESET S W1=0 F S W1=$O(^PSX(552.1,"APQ",W1)) Q:W1'>0 S W2="" F S W2=$O(^PSX(552.1,"APQ",W1,W2)) Q:'W2 S W3=0 F S W3=$O(^PSX(552.1,"APQ",W1,W2,W3)) Q:W3'>0 S DA=W3,DR="20////@",DIE="^PSX(552.1," D ^DIE K DIE,DA,DR
K W1,W2,W3,DIE,DR,DA,LIST1
G EN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXQUE 4146 printed Oct 16, 2024@17:45:36 Page 2
PSXQUE ;BIR/WPB-Displays the Batch Queue at the Host ; [ 04/08/97 2:06 PM ]
+1 ;;2.0;CMOP;;11 Apr 97
EN ;
+1 IF $GET(^PSX(553,1,"S"))="R"
WRITE !,"The interface must be stopped in order to prioritize the queue!!",!!
QUIT
+2 IF '$DATA(^PSX(552.1,"AQ"))&('$DATA(^PSX(552.1,"APQ")))
WRITE !,?21,"********** Queue is empty. *********"
QUIT
+3 KILL ^TMP("PSXQUE",$JOB),^TMP("PSXQ",$JOB),TORD,TRX
+4 SET COM="CMOP TRANSMISSION QUEUE"
SET RCDT=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
SET SP=(80-$LENGTH(COM))\2
SET SP2=(80-$LENGTH(RCDT))\2
+5 if $DATA(^PSX(552.1,"APQ"))
GOTO PRIOR
if $GET(STOP)
GOTO EXIT
+6 SET TOT=0
FOR
SET TOT=$ORDER(^PSX(552.1,"AQ",TOT))
if TOT'>0
QUIT
SET TOTAL=$GET(TOTAL)+1
+7 DO HDR
+8 SET (CNT,RDT)=0
FOR
SET RDT=$ORDER(^PSX(552.1,"AQ",RDT))
if RDT'>0
QUIT
SET BAT=""
FOR
SET BAT=$ORDER(^PSX(552.1,"AQ",RDT,BAT))
if BAT=""
QUIT
SET REC=0
FOR
SET REC=$ORDER(^PSX(552.1,"AQ",RDT,BAT,REC))
if REC'>0
QUIT
if $GET(STOP)=1
GOTO ASK
DO DATA
+9 ;W !,"TOTALS",?9,TOTAL,?64,TORD_"/"_TRX
+10 KILL DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,TRX,TORD,TOTAL
ASK SET DIR(0)="Y"
SET DIR("A")="Accept Sequence"
SET DIR("B")="YES"
SET DIR("?")="Yes - Download in FIFO sequence. No - Set a priority to download to the vendor."
DO ^DIR
KILL DIR,STOP
if Y=1!($GET(DIRUT))!($GET(DTOUT))!($GET(DUOUT))!($GET(DIROUT))
GOTO EXIT
if Y'>0
GOTO SELECT
HDR WRITE @IOF
+1 SET LCNT=0
+2 WRITE !,?SP,COM,!,?SP2,RCDT
+3 IF $DATA(^PSX(552.1,"APQ"))
WRITE !,?SP3,COM1
+4 WRITE !,?2,"SEQ #",?9,"TRANSMISSION",?25,"DIVISION",?49,"RECEIVED DATE",?64,"ORDERS/RXS",!
+5 FOR I=0:1:79
WRITE "-"
+6 KILL I,Y,X,DIRUT,DIROUT,DTOUT,DUOUT
WRITE !
SET LCNT=7
+7 QUIT
EXIT KILL RDT,BAT,REC,FROM,ORD,R,RECV,RR,RXS,TOT,TOTAL,Y,CNT,STOP,TORD,TRX,LCNT,SP,SP2,COM,AQ1,RCDT,DIRUT,DIROUT,DTOUT,DUOUT,X,LIST,BAT1,BAT2,SEQ,HH,PP,JJ,COM1,SP3,LIST1
+1 SET DIR(0)="E"
SET DIR("A")="Press RETURN to start interface, ""^"" to quit"
DO ^DIR
if Y=1
GOTO ALL^PSXSTRT
+2 QUIT
DATA ;
+1 SET FROM=$PIECE($GET(^PSX(552.1,REC,"P")),U,1)
SET ORD=$PIECE($GET(^PSX(552.1,REC,1)),U,3)
SET RXS=$PIECE($GET(^PSX(552.1,REC,1)),U,4)
SET Y=$PIECE($GET(^PSX(552.1,REC,0)),U,4)
XECUTE ^DD("DD")
SET RECV=$PIECE(Y,"@",1)
SET RR=$PIECE(Y,"@",2)
SET R=$PIECE(RR,":",1,2)
KILL Y
+2 if '($GET(AQ1))
SET TORD=$GET(TORD)+ORD
SET TRX=$GET(TRX)+RXS
+3 if $PIECE(^PSX(552.1,REC,0),"^",7)'=""&('$GET(AQ1))
GOTO CK
+4 SET CNT=CNT+1
SET ^TMP("PSXQUE",$JOB,CNT)=REC_"^"_BAT
+5 WRITE $SELECT($GET(AQ1):"*",1:" "),$JUSTIFY(CNT,5),?9,BAT,?25,FROM,?49,$PIECE(RECV,",",1)_"@"_R,?64,ORD_"/"_RXS,!
+6 SET LCNT=LCNT+1
CK IF LCNT>22
SET DIR(0)="E"
DO ^DIR
KILL DIR
if Y=0
SET STOP=1
if Y=0
QUIT
DO HDR
+1 QUIT
SELECT KILL DIR,Y,DIROUT,DUOUT,DTOUT,DIRUT
+1 IF $DATA(^PSX(552.1,"APQ"))
SET DIR(0)="Y"
SET DIR("A")="Reset to Original Sequence"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
if Y=1
GOTO RESET
if $GET(DIRUT)!($GET(DTOUT))!($GET(DUOUT))!($GET(DIROUT))
GOTO EXIT
+2 KILL DIR,Y,DIROUT,DUOUT,DTOUT,DIRUT
+3 SET DIR(0)="L^1:"_CNT_""
SET DIR("A")="Enter priority"
DO ^DIR
KILL DIR
SET LIST=Y
if $GET(LIST)'>0
GOTO EXIT
FOR N=1:1
SET M=$PIECE(LIST,",",N)
if M=""
QUIT
SET MN=$GET(MN)+1
+4 IF $GET(LIST1)
FOR HH=1:1
SET PP=$PIECE(LIST1,"^",HH)
if PP=""
QUIT
SET BAT2=$PIECE(^TMP("PSXQUE",$JOB,PP),"^",1)
SET NSEQ=$PIECE(^PSX(552.1,BAT2,0),"^",7)+MN
SET DIE="^PSX(552.1,"
SET DR="20////"_NSEQ
SET DA=BAT2
DO ^DIE
KILL DIE,DA,DR,NSEQ
+5 FOR SEQ=1:1
SET JJ=$PIECE(LIST,",",SEQ)
if JJ=""
QUIT
SET BAT1=$PIECE(^TMP("PSXQUE",$JOB,JJ),"^",1)
SET DIE="^PSX(552.1,"
SET DR="20////"_SEQ
SET DA=BAT1
DO ^DIE
KILL DIE,DA,DR,BAT1
+6 KILL JJ,HH,PP,BAT1,LIST,SEQ,BAT1,LIST1,N,M,MN
+7 DO PRIOR
+8 ;G EXIT
+9 QUIT
PRIOR NEW FROM,REC,ORD,RXS,Y,RECV,RR,R,BAT
+1 SET TOT=0
FOR
SET TOT=$ORDER(^PSX(552.1,"AQ",TOT))
if TOT'>0
QUIT
SET TOTAL=$GET(TOTAL)+1
+2 SET COM1="* Priority"
SET SP3=(80-$LENGTH(COM1))\2
+3 DO HDR
+4 SET (CNT,RDT)=0
FOR
SET RDT=$ORDER(^PSX(552.1,"APQ",RDT))
if RDT'>0
QUIT
SET LIST1=$GET(LIST1)_RDT_"^"
SET BAT=""
FOR
SET BAT=$ORDER(^PSX(552.1,"APQ",RDT,BAT))
if BAT=""
QUIT
SET REC=0
FOR
SET REC=$ORDER(^PSX(552.1,"APQ",RDT,BAT,REC))
if REC'>0
QUIT
if $GET(STOP)=1
GOTO ASK1
SET AQ1=1
DO DATA
+5 NEW FROM,REC,Y,RECV,RR,R,BAT
KILL AQ1
+6 SET RDT=0
FOR
SET RDT=$ORDER(^PSX(552.1,"AQ",RDT))
if RDT'>0
QUIT
SET BAT=""
FOR
SET BAT=$ORDER(^PSX(552.1,"AQ",RDT,BAT))
if BAT=""
QUIT
SET REC=0
FOR
SET REC=$ORDER(^PSX(552.1,"AQ",RDT,BAT,REC))
if REC'>0
QUIT
if $GET(STOP)=1
GOTO ASK1
DO DATA
+7 WRITE !,"TOTALS",?9,TOTAL,?64,TORD_"/"_TRX
+8 KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT,Y,TOTAL,TRX,TORD,TTORD,TTRX
ASK1 SET DIR(0)="Y"
SET DIR("A")="Accept"
SET DIR("B")="YES"
DO ^DIR
KILL DIR,STOP
if (Y>0)!($GET(DIRUT))!($GET(DTOUT))!($GET(DUOUT))!($GET(DIROUT))
GOTO EXIT
if Y'>0
GOTO SELECT
+1 QUIT
RESET SET W1=0
FOR
SET W1=$ORDER(^PSX(552.1,"APQ",W1))
if W1'>0
QUIT
SET W2=""
FOR
SET W2=$ORDER(^PSX(552.1,"APQ",W1,W2))
if 'W2
QUIT
SET W3=0
FOR
SET W3=$ORDER(^PSX(552.1,"APQ",W1,W2,W3))
if W3'>0
QUIT
SET DA=W3
SET DR="20////@"
SET DIE="^PSX(552.1,"
DO ^DIE
KILL DIE,DA,DR
+1 KILL W1,W2,W3,DIE,DR,DA,LIST1
+2 GOTO EN
