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

Last change on this file since 719 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1PSXQUE ;BIR/WPB-Displays the Batch Queue at the Host ; [ 04/08/97 2:06 PM ]
2 ;;2.0;CMOP;;11 Apr 97
3EN ;
4 I $G(^PSX(553,1,"S"))="R" W !,"The interface must be stopped in order to prioritize the queue!!",!! Q
5 I '$D(^PSX(552.1,"AQ"))&('$D(^PSX(552.1,"APQ"))) W !,?21,"********** Queue is empty. *********" Q
6 K ^TMP("PSXQUE",$J),^TMP("PSXQ",$J),TORD,TRX
7 S COM="CMOP TRANSMISSION QUEUE",RCDT=$P($$HTE^XLFDT($H),":",1,2),SP=(80-$L(COM))\2,SP2=(80-$L(RCDT))\2
8 G:$D(^PSX(552.1,"APQ")) PRIOR G:$G(STOP) EXIT
9 S TOT=0 F S TOT=$O(^PSX(552.1,"AQ",TOT)) Q:TOT'>0 S TOTAL=$G(TOTAL)+1
10 D HDR
11 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
12 ;W !,"TOTALS",?9,TOTAL,?64,TORD_"/"_TRX
13 K DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,TRX,TORD,TOTAL
14ASK 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
15HDR W @IOF
16 S LCNT=0
17 W !,?SP,COM,!,?SP2,RCDT
18 I $D(^PSX(552.1,"APQ")) W !,?SP3,COM1
19 W !,?2,"SEQ #",?9,"TRANSMISSION",?25,"DIVISION",?49,"RECEIVED DATE",?64,"ORDERS/RXS",!
20 F I=0:1:79 W "-"
21 K I,Y,X,DIRUT,DIROUT,DTOUT,DUOUT W ! S LCNT=7
22 Q
23EXIT 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
24 S DIR(0)="E",DIR("A")="Press RETURN to start interface, ""^"" to quit" D ^DIR G:Y=1 ALL^PSXSTRT
25 Q
26DATA ;
27 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
28 S:'($G(AQ1)) TORD=$G(TORD)+ORD,TRX=$G(TRX)+RXS
29 G:$P(^PSX(552.1,REC,0),"^",7)'=""&('$G(AQ1)) CK
30 S CNT=CNT+1,^TMP("PSXQUE",$J,CNT)=REC_"^"_BAT
31 W $S($G(AQ1):"*",1:" "),$J(CNT,5),?9,BAT,?25,FROM,?49,$P(RECV,",",1)_"@"_R,?64,ORD_"/"_RXS,!
32 S LCNT=LCNT+1
33CK I LCNT>22 S DIR(0)="E" D ^DIR K DIR S:Y=0 STOP=1 Q:Y=0 D HDR
34 Q
35SELECT K DIR,Y,DIROUT,DUOUT,DTOUT,DIRUT
36 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
37 K DIR,Y,DIROUT,DUOUT,DTOUT,DIRUT
38 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
39 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
40 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
41 K JJ,HH,PP,BAT1,LIST,SEQ,BAT1,LIST1,N,M,MN
42 D PRIOR
43 ;G EXIT
44 Q
45PRIOR N FROM,REC,ORD,RXS,Y,RECV,RR,R,BAT
46 S TOT=0 F S TOT=$O(^PSX(552.1,"AQ",TOT)) Q:TOT'>0 S TOTAL=$G(TOTAL)+1
47 S COM1="* Priority",SP3=(80-$L(COM1))\2
48 D HDR
49 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
50 N FROM,REC,Y,RECV,RR,R,BAT K AQ1
51 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
52 W !,"TOTALS",?9,TOTAL,?64,TORD_"/"_TRX
53 K DIR,DIRUT,DUOUT,DTOUT,DIROUT,Y,TOTAL,TRX,TORD,TTORD,TTRX
54ASK1 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
55 Q
56RESET 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
57 K W1,W2,W3,DIE,DR,DA,LIST1
58 G EN
Note: See TracBrowser for help on using the repository browser.