- 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 Feb 18, 2025@23:11:08 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
