Routine: PSXYSTRT

PSXYSTRT ;BIR/HTW-Dual Start Interface ;[ 03/10/99  11:08 AM ]

 ;;2.0;CMOP;**17**;11 Apr 97

START ;Start here when queued

 S:'$D(^PSX(553,1,"X",0)) ^PSX(553,1,"X",0)="^553.01DA^^"

 S TERM=13,SOH=1,STX=2,ETB=23,ETX=3,EOT=4,ENQ=5,NAK=21,ACK=16

 S PSXABORT=0,ZCNT=1 D NOW^%DTC S XCNT=% K %

 D SETPAR,PURG G STRT^PSXJOB

SETPAR ;Set parameters (TIMERS,LINE BID,RETRIES)

 S PSXPAR0=$G(^PSX(553,1,0)),PSXPART=$G(^PSX(553,1,"T"))

 S PSXDLTA=$P(PSXPART,"^"),PSXDLTB=$P(PSXPART,"^",2)

 S PSXDLTD=$P(PSXPART,"^",3),PSXDLTE=$P(PSXPART,"^",4)

 S PSXTRYM=$P(PSXPAR0,"^",6),PSXTRYL=$P(PSXPAR0,"^",5)

 S PSXVNDR=$S(^PSX(553,1,0)["MURF":1,^PSX(553,1,0)["HIN":2,^PSX(553,1,0)["CHAR":2,1:0)

PURG ;Purge CMOP log file

 S PSXPURG=0 F PSXCNT=1:1 S PSXPURG=$O(^PSX(553,1,"X",PSXPURG)) Q:'PSXPURG  I PSXCNT>1000 S DA=PSXPURG,DA(1)=1,DIK="^PSX(553,"_DA(1)_",""X""," D ^DIK

 K PSXCNT,PSXPURG,DA,DIK

QUE ;Entry point to queue interface background job

 K PSXONE

 I $G(^PSX(553,1,"P"))="R" W !!,"INTERFACE CANNOT BE STARTED WHILE LABELS ARE PRINTING!......TRY LATER." Q

 ;L +^PSX(553,1,"S"):30 I '$T W !!,"The CMOP Interface file is in use, try later." Q

 ;I $P(^PSX(553,1,"S"),"^",1)="R" W !!,"INTERFACE is already RUNNING, or PURGE is in progress!" Q

 ;G ALL

ASK S DIR(0)="SM^A:All Transmissions Queued;S:Single Transmission;P:Prioritize Queue",DIR("??")="^D HELP^PSXYSTRT",DIR("B")="A" D ^DIR K DIR G:$G(DTOUT)!($G(DUOUT)) EXIT G:"Aa"[X ALL G:"Pp"[X ^PSXQUE

ONE K DIRUT,DUOUT,DTOUT,DIROUT,Y,X

 S DIC(0)="AEOX",DIC("A")="Enter Transmission Number: ",DIC="^PSX(552.1,",DIC("S")="I $P(^PSX(552.1,+Y,0),U,4)>0&($P(^PSX(552.1,+Y,0),U,2)=""2""),($D(^PSX(552.1,""AQ"",$P(^PSX(552.1,+Y,0),U,4),X,+Y)))"

 D ^DIC K DIC S TRAN=+Y,PSXONE=$G(X) I Y'>0!($D(DTOUT))!($D(DUOUT)) K PSXIN G EXIT

 K DUOUT,DTOUT,Y

 S DIR(0)="Y",DIR("A")="Download Transmission "_$G(X),DIR("B")="YES" D ^DIR K DIR I Y'>0!($G(DTOUT))!($D(DUOUT))!($D(DIROUT))!($D(DIRUT)) K PSXIN G EXIT

 S ZTSAVE("PSXONE")=""

 K DIR,DIRUT,DUOUT,DTOUT,DIROUT,Y,X,TRAN

ALL S ^PSX(553,1,"S")="R",PSXIN=1

 L -^PSX(553,1,"S")

 U IO(0) W !!,?10,"*** Interface STARTED ***"

 S ZTIO="CMOP",ZTRTN="START^PSXYSTRT",ZTDTH=$H,ZTREQ="@"

 S ZTDESC="CMOP Interface"

 D ^%ZTLOAD

EXIT K ACK,ENQ,EOT,ETB,ETX,NAK,PSXABORT,PSXDLTA,PSXDLTB,PSXDLTD,PSXDLTE,LOG,PSXTME,PSXTMOUT,PSXTRASH,TRAN,PSXONE,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,WAIT,INT,XZ,%,LQRYTM,NEXT,WAIT

 G:$G(PSXIN)>0 ^PSXHSYS

HELP W !,"A - All Transmissions Queued. Sends all transmissions in the queue to the",!,"vendor. The interface will NOT stop after all transmissions have been sent to",!,"the vendor system."

 W !!,"S - Single Transmission. Only sends the transmission selected to the vendor.",!,"The interface will stop when the transmission download has completed."

 W !!,"P - Prioritize Queue. Allows the user to establish a priority for sending",!,"transmissions to the vendor. The interface will NOT stop after all transmissions",!,"have been sent to the vendor."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXYSTRT   2990     printed  Feb 18, 2025@23:11:55                                                                                                                                                                                                    Page 2

PSXYSTRT  ;BIR/HTW-Dual Start Interface ;[ 03/10/99  11:08 AM ]

 +1       ;;2.0;CMOP;**17**;11 Apr 97

START     ;Start here when queued

 +1        if '$DATA(^PSX(553,1,"X",0))

               SET ^PSX(553,1,"X",0)="^553.01DA^^"

 +2        SET TERM=13

           SET SOH=1

           SET STX=2

           SET ETB=23

           SET ETX=3

           SET EOT=4

           SET ENQ=5

           SET NAK=21

           SET ACK=16

 +3        SET PSXABORT=0

           SET ZCNT=1

           DO NOW^%DTC

           SET XCNT=%

           KILL %

 +4        DO SETPAR

           DO PURG

           GOTO STRT^PSXJOB

SETPAR    ;Set parameters (TIMERS,LINE BID,RETRIES)

 +1        SET PSXPAR0=$GET(^PSX(553,1,0))

           SET PSXPART=$GET(^PSX(553,1,"T"))

 +2        SET PSXDLTA=$PIECE(PSXPART,"^")

           SET PSXDLTB=$PIECE(PSXPART,"^",2)

 +3        SET PSXDLTD=$PIECE(PSXPART,"^",3)

           SET PSXDLTE=$PIECE(PSXPART,"^",4)

 +4        SET PSXTRYM=$PIECE(PSXPAR0,"^",6)

           SET PSXTRYL=$PIECE(PSXPAR0,"^",5)

 +5        SET PSXVNDR=$SELECT(^PSX(553,1,0)["MURF":1,^PSX(553,1,0)["HIN":2,^PSX(553,1,0)["CHAR":2,1:0)

 +6        QUIT

PURG      ;Purge CMOP log file

 +1        SET PSXPURG=0

           FOR PSXCNT=1:1

               SET PSXPURG=$ORDER(^PSX(553,1,"X",PSXPURG))

               if 'PSXPURG

                   QUIT

               IF PSXCNT>1000

                   SET DA=PSXPURG

                   SET DA(1)=1

                   SET DIK="^PSX(553,"_DA(1)_",""X"","

                   DO ^DIK

 +2        KILL PSXCNT,PSXPURG,DA,DIK

 +3        QUIT

QUE       ;Entry point to queue interface background job

 +1        KILL PSXONE

 +2        IF $GET(^PSX(553,1,"P"))="R"

               WRITE !!,"INTERFACE CANNOT BE STARTED WHILE LABELS ARE PRINTING!......TRY LATER."

               QUIT

 +3       ;L +^PSX(553,1,"S"):30 I '$T W !!,"The CMOP Interface file is in use, try later." Q

 +4       ;I $P(^PSX(553,1,"S"),"^",1)="R" W !!,"INTERFACE is already RUNNING, or PURGE is in progress!" Q

 +5       ;G ALL

ASK        SET DIR(0)="SM^A:All Transmissions Queued;S:Single Transmission;P:Prioritize Queue"

           SET DIR("??")="^D HELP^PSXYSTRT"

           SET DIR("B")="A"

           DO ^DIR

           KILL DIR

           if $GET(DTOUT)!($GET(DUOUT))

               GOTO EXIT

           if "Aa"[X

               GOTO ALL

           if "Pp"[X

               GOTO ^PSXQUE

ONE        KILL DIRUT,DUOUT,DTOUT,DIROUT,Y,X

 +1        SET DIC(0)="AEOX"

           SET DIC("A")="Enter Transmission Number: "

           SET DIC="^PSX(552.1,"

           SET DIC("S")="I $P(^PSX(552.1,+Y,0),U,4)>0&($P(^PSX(552.1,+Y,0),U,2)=""2""),($D(^PSX(552.1,""AQ"",$P(^PSX(552.1,+Y,0),U,4),X,+Y)))"

 +2        DO ^DIC

           KILL DIC

           SET TRAN=+Y

           SET PSXONE=$GET(X)

           IF Y'>0!($DATA(DTOUT))!($DATA(DUOUT))

               KILL PSXIN

               GOTO EXIT

 +3        KILL DUOUT,DTOUT,Y

 +4        SET DIR(0)="Y"

           SET DIR("A")="Download Transmission "_$GET(X)

           SET DIR("B")="YES"

           DO ^DIR

           KILL DIR

           IF Y'>0!($GET(DTOUT))!($DATA(DUOUT))!($DATA(DIROUT))!($DATA(DIRUT))

               KILL PSXIN

               GOTO EXIT

 +5        SET ZTSAVE("PSXONE")=""

 +6        KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT,Y,X,TRAN

ALL        SET ^PSX(553,1,"S")="R"

           SET PSXIN=1

 +1        LOCK -^PSX(553,1,"S")

 +2        USE IO(0)

           WRITE !!,?10,"*** Interface STARTED ***"

 +3        SET ZTIO="CMOP"

           SET ZTRTN="START^PSXYSTRT"

           SET ZTDTH=$HOROLOG

           SET ZTREQ="@"

 +4        SET ZTDESC="CMOP Interface"

 +5        DO ^%ZTLOAD

EXIT       KILL ACK,ENQ,EOT,ETB,ETX,NAK,PSXABORT,PSXDLTA,PSXDLTB,PSXDLTD,PSXDLTE,LOG,PSXTME,PSXTMOUT,PSXTRASH,TRAN,PSXONE,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,WAIT,INT,XZ,%,LQRYTM,NEXT,WAIT

 +1        if $GET(PSXIN)>0

               GOTO ^PSXHSYS

 +2        QUIT

HELP       WRITE !,"A - All Transmissions Queued. Sends all transmissions in the queue to the",!,"vendor. The interface will NOT stop after all transmissions have been sent to",!,"the vendor system."

 +1        WRITE !!,"S - Single Transmission. Only sends the transmission selected to the vendor.",!,"The interface will stop when the transmission download has completed."

 +2        WRITE !!,"P - Prioritize Queue. Allows the user to establish a priority for sending",!,"transmissions to the vendor. The interface will NOT stop after all transmissions",!,"have been sent to the vendor."

 +3        QUIT

PSXYSTRT.m