VistA-WorldVistAEHR/r/CMOP-PSX/PSXQUE.m

59 lines
4.0 KiB
Mathematica

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