- PSXSTRT ;BIR/BAB-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)
- Q
- 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
- Q
- QUE ;Entry point to queue interface background job
- I $P($G(^PSX(553,1,0)),"^")["LEAVENWORTH" G QUE^PSXYSTRT
- 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;Q:Query Request",DIR("??")="^D HELP^PSXSTRT",DIR("B")="A" D ^DIR K DIR G:$G(DTOUT)!($G(DUOUT)) EXIT G:"Aa"[X ALL G:"Pp"[X ^PSXQUE G:"Qq"[X QUERY
- 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^PSXSTRT",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
- Q
- QUERY D NOW^%DTC S XZ=$P(^PSX(553.1,0),"^",3),INT=$P(^PSX(553,1,0),"^",9) S:$G(INT)'>0 INT=1
- I $G(XZ) S LQRYTM=$P(^PSX(553.1,XZ,0),"^",2) S NEXT=$$FMADD^XLFDT(LQRYTM,0,$G(INT),0,0) I %'>NEXT S WAIT=$$FMDIFF^XLFDT(NEXT,%,2) W !!,"Another query can not be initiated for ",($G(WAIT)\60)," minutes." G EXIT
- S PSXQRY=1,ZTSAVE("PSXQRY")="",PSXQRYA=1,ZTSAVE("PSXQRYA")="" G ALL
- Q
- 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."
- W !!,"Q - Query Request. Allows the user to initiate a query request. Once the query",!,"request is complete the interface stops."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXSTRT 3583 printed Feb 18, 2025@23:11:40 Page 2
- PSXSTRT ;BIR/BAB-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 IF $PIECE($GET(^PSX(553,1,0)),"^")["LEAVENWORTH"
- GOTO QUE^PSXYSTRT
- +2 KILL PSXONE
- +3 IF $GET(^PSX(553,1,"P"))="R"
- WRITE !!,"INTERFACE CANNOT BE STARTED WHILE LABELS ARE PRINTING!......TRY LATER."
- QUIT
- +4 LOCK +^PSX(553,1,"S"):30
- IF '$TEST
- WRITE !!,"The CMOP Interface file is in use, try later."
- QUIT
- +5 IF $PIECE(^PSX(553,1,"S"),"^",1)="R"
- WRITE !!,"INTERFACE is already RUNNING, or PURGE is in progress!"
- QUIT
- +6 ;G ALL
- ASK SET DIR(0)="SM^A:All Transmissions Queued;S:Single Transmission;P:Prioritize Queue;Q:Query Request"
- SET DIR("??")="^D HELP^PSXSTRT"
- 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
- if "Qq"[X
- GOTO QUERY
- 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^PSXSTRT"
- 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
- QUERY DO NOW^%DTC
- SET XZ=$PIECE(^PSX(553.1,0),"^",3)
- SET INT=$PIECE(^PSX(553,1,0),"^",9)
- if $GET(INT)'>0
- SET INT=1
- +1 IF $GET(XZ)
- SET LQRYTM=$PIECE(^PSX(553.1,XZ,0),"^",2)
- SET NEXT=$$FMADD^XLFDT(LQRYTM,0,$GET(INT),0,0)
- IF %'>NEXT
- SET WAIT=$$FMDIFF^XLFDT(NEXT,%,2)
- WRITE !!,"Another query can not be initiated for ",($GET(WAIT)\60)," minutes."
- GOTO EXIT
- +2 SET PSXQRY=1
- SET ZTSAVE("PSXQRY")=""
- SET PSXQRYA=1
- SET ZTSAVE("PSXQRYA")=""
- GOTO ALL
- +3 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 WRITE !!,"Q - Query Request. Allows the user to initiate a query request. Once the query",!,"request is complete the interface stops."
- +4 QUIT
