source: FOIAVistA/tag/r/CMOP-PSX/PSXQUE.m

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