PSXRSUS ;BIR/WPB,BAB,HTW-CMOP Transmission Handler ;15 Dec 2001
;;2.0;CMOP;**2,3,24,23,26,28,41,57,48**;11 Apr 97
;Reference to ^PS(52.5 supported by DBIA #1978
;Reference to ^PS(59 supported by DBIA #1976
;Reference to routine DEV1^PSOSULB1 supported by DBIA #2478
;
;Select CMOP Rx data from File 52.5,build HL7 segments,
;and transmit data
; This routine is called from PSOSULB1 'Print from Suspense'
;
START I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
I '$D(^XUSEC("PSX XMIT",DUZ)) W !,"You are not authorized to use this option!" Q
S (PSXFLAG,PSXTRANS)=0
L +^PSX(550.1):3 I '$T W !,"A lock on the RX QUEUE file was not obtainable. A transmission is in progress, try later." Q
; lock on 550.1 obtainable, clear flags
I $D(^PSX(550,"TR","T")) F S PSXSYS=$O(^PSX(550,"TR","T",0)) Q:PSXSYS'>0 S PSXSTAT="H" D PSXSTAT^PSXRSYU
D SET^PSXSYS
S STATUS=$P($G(^PSX(550,+PSXSYS,0)),"^",3) I STATUS'="H" W !,STATUS," no Manual Transmission nor Print CMOP Suspense allowed at this time" G EXIT
QRY W ! K DIR
S DIR(0)="NAO^1:5",DIR("A")="Select (1, 2, 3, 4, 5): "
S DIR("A",1)=" 1 - Initiate Standard CMOP Transmission"
S DIR("A",2)=" 2 - Initiate CS CMOP Transmission"
S DIR("A",3)=" 3 - Print Current Division - Standard CMOP from Suspense"
S DIR("A",4)=" 4 - Print Current Division - CS CMOP from Suspense"
S DIR("A",5)=" 5 - Standard Print from Suspense"
S DIR("A",6)=" "
S DIR("?")="Enter a number between 1 and 5.",DIR("??")="^D MSG1^PSXRHLP" D ^DIR I (Y<0)!($D(DIRUT)) K DIR G EXIT
W !!,DIR("A",X),!
S REPLY=X K Y,X
K DIRUT,DTOUT,DUOUT,DIROUT,DIR
DIRECT ;Set PSXCS, PSXTRANS & PSXFLAG as per user choice
I REPLY="5" G DEV1^PSOSULB1
I "24"[REPLY S PSXCS=1
I "12"[REPLY S (PSXTRANS,PSXFLAG)=1
I "34"[REPLY S PSXFLAG=2
K REPLY
;
ASK ;Ask 'all divisions y/n' & date range for data transmission & checks for data
W !
;ask all divisions y/n
I PSXFLAG=2 S PSXDIVML=0 G ASK2
K DIR S DIR(0)="Y",DIR("A")="Transmit Data for All Divisions ? ",DIR("B")="YES"
S DIR("?",1)="Yes - Transmit/Print All Divisions"
S DIR("?")="No - Transmit/Print One Division: "_$$GET1^DIQ(59,PSOSITE,.01)
D ^DIR K DIR
G:(Y<0)!($D(DIRUT)) EXIT
N PSXDIVML S PSXDIVML=+Y
ASK2 W !
S %DT="AEX",%DT("A")=$S(PSXFLAG=1:"TRANSMIT CMOP DATA THRU DATE: ",PSXFLAG=2:"PRINT CMOP LABELS THRU DATE: ",1:0),%DT("B")="TODAY" D ^%DT K %DT,%DT("A"),%DT("B")
S:Y<0 PFLAG=1 G:Y<0 EXIT
S (PDT,PRTDT,TPRTDT)=Y K Y S Y=PDT X ^DD("DD") S PDT=Y K Y
S CHKDT=$O(^PS(52.5,"AQ","")) I CHKDT>PRTDT W !!,$S(PSXFLAG=1:"NOTHING THRU THIS DATE TO TRANSMIT.",PSXFLAG=2:"NOTHING THRU THIS DATE TO PRINT.",1:0) S PFLAG=1 G EXIT
I '$O(^PS(52.5,"AQ",0)) W !!,$S(PSXFLAG=1:"NOTHING THRU THIS DATE TO TRANSMIT.",PSXFLAG=2:"NOTHING THRU THIS DATE TO PRINT.",1:0) S PFLAG=1 G EXIT
;
W ! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you wish to continue" D ^DIR K DIR S STOP=Y G:Y=0!($D(DIRUT))!($D(DUOUT)) EXIT K Y
S PSXSTAT="T" D PSXSTAT^PSXRSYU S PFLAG=0 I $G(PSXLOCK)>0 G EX1
;
DRIV ;calls the remaining routines to build the data for transmission and
S PSXDAYS=$P(PSOPAR,"^",27),X1=TPRTDT,X2=PSXDAYS D C^%DTC S PSXDTRG=X K X,X1,X2
S PSXVENDR=$S($P(^PSX(550,+$G(PSXSYS),0),"^")["HINE":"SI BAKER",$P(^PSX(550,+$G(PSXSYS),0),"^")["MURF":"SI BAKER",1:"ELECTROCOM")
;set up queue device PSX or printer
I PSXFLAG=2 D BEGIN^PSXRPPL G:$G(POP) EXIT ;select printer PSLION
QUE ; QUEUE the group/individual PSOSITE jobs for trans or the single job for print labels one division
S PSXDESC="CMOP "_$S($G(PSXCS)=1:"CS ",1:"NON-CS ")_"Transmission"
;
S ZTDESC=$S(PSXFLAG=1:$G(PSXDESC),PSXFLAG=2:"Print CMOP Suspense",1:"")
S:PSXFLAG=1 ZTIO="",ZTRTN="TRANDIVS^PSXRSUS"
S:PSXFLAG=2 ZTIO=PSLION,ZTRTN="PRT^PSXRSUS"
;
S PSXDUZ=DUZ,(PSOINST,PSXSITE)=+$P($G(PSXSYS),U,2)
S ZTDTH=$H
F X="PSXDIVML","PSOSITE","PSOLAP","PSOSYS","PSOPAR","PSXSYS","DUZ","PSXTRANS","PSXFLAG","PRTDT","PSOINST","PSXDUZ","PSXSITE","PSXVER" S ZTSAVE(X)=""
F X="PSXCS","PSXDAYS","PSXDTRG","PSOBARS","PSOBAR1","PSOBAR0","PSOPROP","PSXVENDR","PSLION","TPRTDT" S ZTSAVE(X)=""
;
K ZTSK
D ^%ZTLOAD ;****TESTING switch to tasking vs foreground
W:$G(ZTSK) !,"Tasked ",ZTSK H 4
;D @ZTRTN ;****TESTING run foreground, comment out above two lines
Q
;
TRANDIVS ;Entry from transmission tasking; loop all divisions / or process only 1
;process/transmit all divisions
LOCK ; >>>**** LOCK OF FILE 550.1 ****<<<
F I=1:1:3 L +^PSX(550.1):10 I $T S I=100
I I'=100 D CANMSG G EXIT ; could not get a lock in 18 minutes of waiting
D STOREVAR^PSXRSUS1 ; store critical variables
I $D(^PSX(550.2,"AQ")) D EN1^PSXRCVRY
I PSXDIVML N PSOSITE,PSOPAR D G EXIT
. S PSOSITE=0 F S PSOSITE=$O(^PS(59,PSOSITE)) Q:PSOSITE'>0 D
.. I '$D(^XTMP("PSXAUTOERR")) N $ETRAP,$ESTACK S $ETRAP="D TRAPERR^PSXRSUS"
.. D RESETVAR^PSXRSUS1 ;retrieve critical variables
.. S PSOPAR=^PS(59,PSOSITE,1),PRTDT=TPRTDT
.. S PSXDAYS=$P(PSOPAR,"^",27),X1=PRTDT,X2=PSXDAYS D C^%DTC S PSXDTRG=X K X,X1,X2 ;adjusts variables per divisional parameters.
.. D TRANS
; process a single division
D
. I '$D(^XTMP("PSXAUTOERR")) N $ETRAP,$ESTACK S $ETRAP="D TRAPERR^PSXRSUS"
. D TRANS
G EXIT
;
;Called by Taskman to build CMOP PRINT data
TRANS ;;Called by PSXAUTO Taskman to begin CMOP transmissions one division
S PSXZTSK=$G(ZTSK),PSXERFLG=0,PSXDUZ=DUZ
S PSXTST=0,PSXIN=$$GET1^DIQ(59,PSOSITE,2004,"I")
S:PSXIN'=""&(PSXIN<(DT+.1)) PSXTST=1
Q:PSXTST ;division inactivated
;VMP OIFO BAY PINES;ELR;PSX*2*57 CK IF ALL NECESSARY ELEMENTS OF DIVISION ARE HERE
NEW PSXDIVER S PSXPRECK=1 D DIV^PSXBLD1 K PSXPRECK I $G(PSXDIVER) Q
S PSXSTAT="T" D PSXSTAT^PSXRSYU
I $G(PSXCS)=1 S X=$$FMADD^XLFDT(DT,+2) S ^XTMP("PSXCS"_PSOSITE,0)=X_U_DT_U_"CMOP CS TRANSMISSION"
D SDT^PSXRPPL I PSXERFLG=1 S PSXJOB=7 D ^PSXERR
I '$G(PSXBAT) D OERRCLR Q ;no RXs found nor loaded into 550.2
RTR ;
;Clear 550.1 of entries (INSURE NO MERGE) prior to transmission
K DIK,DA S DIK="^PSX(550.1,",DA=0 F S DA=$O(^PSX(550.1,DA)) Q:DA'>0 D ^DIK ;****TESTING
D EN^PSXBLD ; build entries into 550.1 by alpha patient
I PSXERFLG=1 S PFLAG=1 D EN^PSXERR
D EN^PSXRTR ;complete and send mailman message to CMOP
;Clear 550.1 of entries (INSURE NO MERGE) after transmission complete
K DIK,DA S DIK="^PSX(550.1,",DA=0 F S DA=$O(^PSX(550.1,DA)) Q:DA'>0 D ^DIK ;****TESTING
D OERRCLR
Q
PRT ; print from CMOP suspense
F I=1:1:3 L +^PSX(550.1):60 I $T S I=100
I I'=100 D CANMSG G EXIT ; could not get a lock in 3 minutes of waiting
; set auto error trapping
D
. I '$D(^XTMP("PSXAUTOERR")) N $ETRAP,$ESTACK S $ETRAP="D PRTERR^PSXRPPL1"
. D PRT1
D OERRCLR
G EX1
PRT1 S ZTREQ="@",PSXERFLG=0,NFLAG=2
D SDT^PSXRPPL
I $G(PSXBAT),$D(^PSX(550.2,PSXBAT,15)) D PRT^PSXRPPL
I PSXERFLG=1 S PSXJOB=7 D ^PSXERR
;remove the batch from the transmission file as it was used only to hold the RXs for printing and not transmission
I $G(PSXBAT) K DIK,DA S DA=PSXBAT,DIK="^PSX(550.2," D ^DIK K DIK,DA ;****TESTING
G EX1
EXIT ;
I $G(POP) S PSXSTAT="H" D PSXSTAT^PSXRSYU ;exit from 'no printer selected' of print labels CMOP
;I $G(PFLAG)=1 S PSXSTAT="H" D PSXSTAT^PSXRSYU
K DA,DIE,DR
S DA=+PSXSYS,DIE="^PSX(550,",DR="9///@"
L +^PSX(550,DA):600 D ^DIE L -^PSX(550,DA)
K DA,DIE,DR
S PSXSTAT="H" D PSXSTAT^PSXRSYU
EX1 K ^PSX("CMOP TRAN")
K CNAME,DFN,FILNUM,PNAME,PSXDAYS,PSXDTRG,^TMP($J,"PSX"),J,Y
K PSXPTR,REC,REF,REPLY,SDT,X,X1,X2,Y,ANSWER,PSXOK,RXNUM,PSXSITE,DIR,DIRUT,DTOUT,DUOUT,DIROUT,PSXCS,TXT,TEXT
K XDFN,STATUS,PSXSTAT,^TMP($J,"PSXDFN"),PDT,PSXDUZ,SITE,CHKDT,PSXERFLG,PSXRXERR,RXEX,FDATE,PSXJOB,PFLAG,PSXZTSK,PSXVENDR,ORSUB,ORST
L -^PSX(550.1)
Q
OERRCLR ; clear any locks left in ^XTMP("OERR-"
S (ORST,ORSUB)="ORLK-"
F S ORSUB=$O(^XTMP(ORSUB)) Q:ORSUB'[ORST I ^XTMP(ORSUB,0)["CPRS/CMOP" K ^XTMP(ORSUB)
Q
CANMSG ; lock on 550.1 not achieved send transmission/print cancelled message
S PSXCS=+$G(PSXCS)
S XMSUB=$S($G(PSXCS):"",1:"NON-")_"CS Manual Scheduled Transmission Canceled"
S:PSXFLAG=2 XMSUB="Print CMOP Suspense Cancelled."
S XMTEXT="TXT("
S TXT(1,0)="The "_$S($G(PSXCS):"",1:"NON-")_"CS Manual Transmission was cancelled"
S:PSXFLAG=2 TXT(1,0)="Print from CMOP Suspense was cancelled"
S TXT(2,0)="It could not obtain a lock on the RX QUEUE file. #550.1"
S TXT(3,0)="This indicates that a transmission was in progress."
S TXT(6,0)=" "
S TXT(7,0)="If you are getting this message frequently, please contact your IRM Group"
D GRP1^PSXNOTE
;S XMY(DUZ)=""
D ^XMD
Q
TRAPERR ; trap/process error
S XXERR=$$EC^%ZOSV
S PSXDIVNM=$$GET1^DIQ(59,PSOSITE,.01)
;save an image of the transient file 550.1 for 2 days
D NOW^%DTC S DTTM=%
;VMP OIFO BAY PINES;ELR;PSX*2*57 CHANGE PURGE DAYS TO T+12 FROM T+2
S X=$$FMADD^XLFDT(DT,+12) S ^XTMP("PSXERR "_DTTM,0)=X_U_DT_U_"CMOP "_XXERR
M ^XTMP("PSXERR "_DTTM,550.1)=^PSX(550.1)
S XMSUB="CMOP Error "_PSXDIVNM_" "_$$GET1^DIQ(550.2,+$G(PSXBAT),.01)
D GRP1^PSXNOTE
;S XMY(DUZ)=""
S XMTEXT="TEXT("
S TEXT(1,0)=$S($G(PSXCS):"",1:"NON-")_"CS CMOP Transmission encountered the following error. Please investigate"
S TEXT(2,0)="Division: "_PSXDIVNM
S TEXT(3,0)="Type/Batch "_$S($G(PSXCS):"CS",1:"NON-CS")_" / "_$$GET1^DIQ(550.2,+$G(PSXBAT),.01)
S TEXT(4,0)="Error: "_XXERR
S TEXT(5,0)="The prescriptions have been reset and other divisions' transmissions are continuing."
S TEXT(6,0)="A copy of the file 550.1 can be found in ^XTMP(""PSXERR "_DTTM_""")"
D ^%ZTER
D ^XMD
;I $E(IOST)="C" F XX=1:1:5 W !,TEXT(XX,0)
S PSXXDIV=PSOSITE
D EN1^PSXRCVRY ;hopefully no errors will be experienced in recovery
S PSOSITE=PSXXDIV
G UNWIND^%ZTER
Q
STOPET ;disable auto error trapping
S ^XTMP("PSXAUTOERR",0)=DT_U_DT_U_"disable PSX CMOP auto error trapping for today"
Q
STARTET ;enable auto error trapping
K ^XTMP("PSXAUTOERR",0)
Q
PSXRSUS ;BIR/WPB,BAB,HTW-CMOP Transmission Handler ;15 Dec 2001
+1 ;;2.0;CMOP;**2,3,24,23,26,28,41,57,48**;11 Apr 97
+2 ;Reference to ^PS(52.5 supported by DBIA #1978
+3 ;Reference to ^PS(59 supported by DBIA #1976
+4 ;Reference to routine DEV1^PSOSULB1 supported by DBIA #2478
+5 ;
+6 ;Select CMOP Rx data from File 52.5,build HL7 segments,
+7 ;and transmit data
+8 ; This routine is called from PSOSULB1 'Print from Suspense'
+9 ;
START IF '$DATA(^XUSEC("PSXCMOPMGR",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+1 IF '$DATA(^XUSEC("PSX XMIT",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+2 SET (PSXFLAG,PSXTRANS)=0
+3 LOCK +^PSX(550.1):3
IF '$TEST
WRITE !,"A lock on the RX QUEUE file was not obtainable. A transmission is in progress, try later."
QUIT
+4 ; lock on 550.1 obtainable, clear flags
+5 IF $DATA(^PSX(550,"TR","T"))
FOR
SET PSXSYS=$ORDER(^PSX(550,"TR","T",0))
IF PSXSYS'>0
QUIT
SET PSXSTAT="H"
DO PSXSTAT^PSXRSYU
+6 DO SET^PSXSYS
+7 SET STATUS=$PIECE($GET(^PSX(550,+PSXSYS,0)),"^",3)
IF STATUS'="H"
WRITE !,STATUS," no Manual Transmission nor Print CMOP Suspense allowed at this time"
GOTO EXIT
QRY WRITE !
KILL DIR
+1 SET DIR(0)="NAO^1:5"
SET DIR("A")="Select (1, 2, 3, 4, 5): "
+2 SET DIR("A",1)=" 1 - Initiate Standard CMOP Transmission"
+3 SET DIR("A",2)=" 2 - Initiate CS CMOP Transmission"
+4 SET DIR("A",3)=" 3 - Print Current Division - Standard CMOP from Suspense"
+5 SET DIR("A",4)=" 4 - Print Current Division - CS CMOP from Suspense"
+6 SET DIR("A",5)=" 5 - Standard Print from Suspense"
+7 SET DIR("A",6)=" "
+8 SET DIR("?")="Enter a number between 1 and 5."
SET DIR("??")="^D MSG1^PSXRHLP"
DO ^DIR
IF (Y<0)!($DATA(DIRUT))
KILL DIR
GOTO EXIT
+9 WRITE !!,DIR("A",X),!
+10 SET REPLY=X
KILL Y,X
+11 KILL DIRUT,DTOUT,DUOUT,DIROUT,DIR
DIRECT ;Set PSXCS, PSXTRANS & PSXFLAG as per user choice
+1 IF REPLY="5"
GOTO DEV1^PSOSULB1
+2 IF "24"[REPLY
SET PSXCS=1
+3 IF "12"[REPLY
SET (PSXTRANS,PSXFLAG)=1
+4 IF "34"[REPLY
SET PSXFLAG=2
+5 KILL REPLY
+6 ;
ASK ;Ask 'all divisions y/n' & date range for data transmission & checks for data
+1 WRITE !
+2 ;ask all divisions y/n
+3 IF PSXFLAG=2
SET PSXDIVML=0
GOTO ASK2
+4 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Transmit Data for All Divisions ? "
SET DIR("B")="YES"
+5 SET DIR("?",1)="Yes - Transmit/Print All Divisions"
+6 SET DIR("?")="No - Transmit/Print One Division: "_$$GET1^DIQ(59,PSOSITE,.01)
+7 DO ^DIR
KILL DIR
+8 IF (Y<0)!($DATA(DIRUT))
GOTO EXIT
+9 NEW PSXDIVML
SET PSXDIVML=+Y
ASK2 WRITE !
+1 SET %DT="AEX"
SET %DT("A")=$SELECT(PSXFLAG=1:"TRANSMIT CMOP DATA THRU DATE: ",PSXFLAG=2:"PRINT CMOP LABELS THRU DATE: ",1:0)
SET %DT("B")="TODAY"
DO ^%DT
KILL %DT,%DT("A"),%DT("B")
+2 IF Y<0
SET PFLAG=1
IF Y<0
GOTO EXIT
+3 SET (PDT,PRTDT,TPRTDT)=Y
KILL Y
SET Y=PDT
XECUTE ^DD("DD")
SET PDT=Y
KILL Y
+4 SET CHKDT=$ORDER(^PS(52.5,"AQ",""))
IF CHKDT>PRTDT
WRITE !!,$SELECT(PSXFLAG=1:"NOTHING THRU THIS DATE TO TRANSMIT.",PSXFLAG=2:"NOTHING THRU THIS DATE TO PRINT.",1:0)
SET PFLAG=1
GOTO EXIT
+5 IF '$ORDER(^PS(52.5,"AQ",0))
WRITE !!,$SELECT(PSXFLAG=1:"NOTHING THRU THIS DATE TO TRANSMIT.",PSXFLAG=2:"NOTHING THRU THIS DATE TO PRINT.",1:0)
SET PFLAG=1
GOTO EXIT
+6 ;
+7 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you wish to continue"
DO ^DIR
KILL DIR
SET STOP=Y
IF Y=0!($DATA(DIRUT))!($DATA(DUOUT))
GOTO EXIT
KILL Y
+8 SET PSXSTAT="T"
DO PSXSTAT^PSXRSYU
SET PFLAG=0
IF $GET(PSXLOCK)>0
GOTO EX1
+9 ;
DRIV ;calls the remaining routines to build the data for transmission and
+1 SET PSXDAYS=$PIECE(PSOPAR,"^",27)
SET X1=TPRTDT
SET X2=PSXDAYS
DO C^%DTC
SET PSXDTRG=X
KILL X,X1,X2
+2 SET PSXVENDR=$SELECT($PIECE(^PSX(550,+$GET(PSXSYS),0),"^")["HINE":"SI BAKER",$PIECE(^PSX(550,+$GET(PSXSYS),0),"^")["MURF":"SI BAKER",1:"ELECTROCOM")
+3 ;set up queue device PSX or printer
+4 ;select printer PSLION
IF PSXFLAG=2
DO BEGIN^PSXRPPL
IF $GET(POP)
GOTO EXIT
QUE ; QUEUE the group/individual PSOSITE jobs for trans or the single job for print labels one division
+1 SET PSXDESC="CMOP "_$SELECT($GET(PSXCS)=1:"CS ",1:"NON-CS ")_"Transmission"
+2 ;
+3 SET ZTDESC=$SELECT(PSXFLAG=1:$GET(PSXDESC),PSXFLAG=2:"Print CMOP Suspense",1:"")
+4 IF PSXFLAG=1
SET ZTIO=""
SET ZTRTN="TRANDIVS^PSXRSUS"
+5 IF PSXFLAG=2
SET ZTIO=PSLION
SET ZTRTN="PRT^PSXRSUS"
+6 ;
+7 SET PSXDUZ=DUZ
SET (PSOINST,PSXSITE)=+$PIECE($GET(PSXSYS),U,2)
+8 SET ZTDTH=$HOROLOG
+9 FOR X="PSXDIVML","PSOSITE","PSOLAP","PSOSYS","PSOPAR","PSXSYS","DUZ","PSXTRANS","PSXFLAG","PRTDT","PSOINST","PSXDUZ","PSXSITE","PSXVER"
SET ZTSAVE(X)=""
+10 FOR X="PSXCS","PSXDAYS","PSXDTRG","PSOBARS","PSOBAR1","PSOBAR0","PSOPROP","PSXVENDR","PSLION","TPRTDT"
SET ZTSAVE(X)=""
+11 ;
+12 KILL ZTSK
+13 ;****TESTING switch to tasking vs foreground
DO ^%ZTLOAD
+14 IF $GET(ZTSK)
WRITE !,"Tasked ",ZTSK
HANG 4
+15 ;D @ZTRTN ;****TESTING run foreground, comment out above two lines
+16 QUIT
+17 ;
TRANDIVS ;Entry from transmission tasking; loop all divisions / or process only 1
+1 ;process/transmit all divisions
LOCK ; >>>**** LOCK OF FILE 550.1 ****<<<
+1 FOR I=1:1:3
LOCK +^PSX(550.1):10
IF $TEST
SET I=100
+2 ; could not get a lock in 18 minutes of waiting
IF I'=100
DO CANMSG
GOTO EXIT
+3 ; store critical variables
DO STOREVAR^PSXRSUS1
+4 IF $DATA(^PSX(550.2,"AQ"))
DO EN1^PSXRCVRY
+5 IF PSXDIVML
NEW PSOSITE,PSOPAR
Begin DoDot:1
+6 SET PSOSITE=0
FOR
SET PSOSITE=$ORDER(^PS(59,PSOSITE))
IF PSOSITE'>0
QUIT
Begin DoDot:2
+7 IF '$DATA(^XTMP("PSXAUTOERR"))
NEW $ETRAP,$ESTACK
SET $ETRAP="D TRAPERR^PSXRSUS"
+8 ;retrieve critical variables
DO RESETVAR^PSXRSUS1
+9 SET PSOPAR=^PS(59,PSOSITE,1)
SET PRTDT=TPRTDT
+10 ;adjusts variables per divisional parameters.
SET PSXDAYS=$PIECE(PSOPAR,"^",27)
SET X1=PRTDT
SET X2=PSXDAYS
DO C^%DTC
SET PSXDTRG=X
KILL X,X1,X2
+11 DO TRANS
End DoDot:2
End DoDot:1
GOTO EXIT
+12 ; process a single division
+13 Begin DoDot:1
+14 IF '$DATA(^XTMP("PSXAUTOERR"))
NEW $ETRAP,$ESTACK
SET $ETRAP="D TRAPERR^PSXRSUS"
+15 DO TRANS
End DoDot:1
+16 GOTO EXIT
+17 ;
+18 ;Called by Taskman to build CMOP PRINT data
TRANS ;;Called by PSXAUTO Taskman to begin CMOP transmissions one division
+1 SET PSXZTSK=$GET(ZTSK)
SET PSXERFLG=0
SET PSXDUZ=DUZ
+2 SET PSXTST=0
SET PSXIN=$$GET1^DIQ(59,PSOSITE,2004,"I")
+3 IF PSXIN'=""&(PSXIN<(DT+.1))
SET PSXTST=1
+4 ;division inactivated
IF PSXTST
QUIT
+5 ;VMP OIFO BAY PINES;ELR;PSX*2*57 CK IF ALL NECESSARY ELEMENTS OF DIVISION ARE HERE
+6 NEW PSXDIVER
SET PSXPRECK=1
DO DIV^PSXBLD1
KILL PSXPRECK
IF $GET(PSXDIVER)
QUIT
+7 SET PSXSTAT="T"
DO PSXSTAT^PSXRSYU
+8 IF $GET(PSXCS)=1
SET X=$$FMADD^XLFDT(DT,+2)
SET ^XTMP("PSXCS"_PSOSITE,0)=X_U_DT_U_"CMOP CS TRANSMISSION"
+9 DO SDT^PSXRPPL
IF PSXERFLG=1
SET PSXJOB=7
DO ^PSXERR
+10 ;no RXs found nor loaded into 550.2
IF '$GET(PSXBAT)
DO OERRCLR
QUIT
RTR ;
+1 ;Clear 550.1 of entries (INSURE NO MERGE) prior to transmission
+2 ;****TESTING
KILL DIK,DA
SET DIK="^PSX(550.1,"
SET DA=0
FOR
SET DA=$ORDER(^PSX(550.1,DA))
IF DA'>0
QUIT
DO ^DIK
+3 ; build entries into 550.1 by alpha patient
DO EN^PSXBLD
+4 IF PSXERFLG=1
SET PFLAG=1
DO EN^PSXERR
+5 ;complete and send mailman message to CMOP
DO EN^PSXRTR
+6 ;Clear 550.1 of entries (INSURE NO MERGE) after transmission complete
+7 ;****TESTING
KILL DIK,DA
SET DIK="^PSX(550.1,"
SET DA=0
FOR
SET DA=$ORDER(^PSX(550.1,DA))
IF DA'>0
QUIT
DO ^DIK
+8 DO OERRCLR
+9 QUIT
PRT ; print from CMOP suspense
+1 FOR I=1:1:3
LOCK +^PSX(550.1):60
IF $TEST
SET I=100
+2 ; could not get a lock in 3 minutes of waiting
IF I'=100
DO CANMSG
GOTO EXIT
+3 ; set auto error trapping
+4 Begin DoDot:1
+5 IF '$DATA(^XTMP("PSXAUTOERR"))
NEW $ETRAP,$ESTACK
SET $ETRAP="D PRTERR^PSXRPPL1"
+6 DO PRT1
End DoDot:1
+7 DO OERRCLR
+8 GOTO EX1
PRT1 SET ZTREQ="@"
SET PSXERFLG=0
SET NFLAG=2
+1 DO SDT^PSXRPPL
+2 IF $GET(PSXBAT)
IF $DATA(^PSX(550.2,PSXBAT,15))
DO PRT^PSXRPPL
+3 IF PSXERFLG=1
SET PSXJOB=7
DO ^PSXERR
+4 ;remove the batch from the transmission file as it was used only to hold the RXs for printing and not transmission
+5 ;****TESTING
IF $GET(PSXBAT)
KILL DIK,DA
SET DA=PSXBAT
SET DIK="^PSX(550.2,"
DO ^DIK
KILL DIK,DA
+6 GOTO EX1
EXIT ;
+1 ;exit from 'no printer selected' of print labels CMOP
IF $GET(POP)
SET PSXSTAT="H"
DO PSXSTAT^PSXRSYU
+2 ;I $G(PFLAG)=1 S PSXSTAT="H" D PSXSTAT^PSXRSYU
+3 KILL DA,DIE,DR
+4 SET DA=+PSXSYS
SET DIE="^PSX(550,"
SET DR="9///@"
+5 LOCK +^PSX(550,DA):600
DO ^DIE
LOCK -^PSX(550,DA)
+6 KILL DA,DIE,DR
+7 SET PSXSTAT="H"
DO PSXSTAT^PSXRSYU
EX1 KILL ^PSX("CMOP TRAN")
+1 KILL CNAME,DFN,FILNUM,PNAME,PSXDAYS,PSXDTRG,^TMP($JOB,"PSX"),J,Y
+2 KILL PSXPTR,REC,REF,REPLY,SDT,X,X1,X2,Y,ANSWER,PSXOK,RXNUM,PSXSITE,DIR,DIRUT,DTOUT,DUOUT,DIROUT,PSXCS,TXT,TEXT
+3 KILL XDFN,STATUS,PSXSTAT,^TMP($JOB,"PSXDFN"),PDT,PSXDUZ,SITE,CHKDT,PSXERFLG,PSXRXERR,RXEX,FDATE,PSXJOB,PFLAG,PSXZTSK,PSXVENDR,ORSUB,ORST
+4 LOCK -^PSX(550.1)
+5 QUIT
OERRCLR ; clear any locks left in ^XTMP("OERR-"
+1 SET (ORST,ORSUB)="ORLK-"
+2 FOR
SET ORSUB=$ORDER(^XTMP(ORSUB))
IF ORSUB'[ORST
QUIT
IF ^XTMP(ORSUB,0)["CPRS/CMOP"
KILL ^XTMP(ORSUB)
+3 QUIT
CANMSG ; lock on 550.1 not achieved send transmission/print cancelled message
+1 SET PSXCS=+$GET(PSXCS)
+2 SET XMSUB=$SELECT($GET(PSXCS):"",1:"NON-")_"CS Manual Scheduled Transmission Canceled"
+3 IF PSXFLAG=2
SET XMSUB="Print CMOP Suspense Cancelled."
+4 SET XMTEXT="TXT("
+5 SET TXT(1,0)="The "_$SELECT($GET(PSXCS):"",1:"NON-")_"CS Manual Transmission was cancelled"
+6 IF PSXFLAG=2
SET TXT(1,0)="Print from CMOP Suspense was cancelled"
+7 SET TXT(2,0)="It could not obtain a lock on the RX QUEUE file. #550.1"
+8 SET TXT(3,0)="This indicates that a transmission was in progress."
+9 SET TXT(6,0)=" "
+10 SET TXT(7,0)="If you are getting this message frequently, please contact your IRM Group"
+11 DO GRP1^PSXNOTE
+12 ;S XMY(DUZ)=""
+13 DO ^XMD
+14 QUIT
TRAPERR ; trap/process error
+1 SET XXERR=$$EC^%ZOSV
+2 SET PSXDIVNM=$$GET1^DIQ(59,PSOSITE,.01)
+3 ;save an image of the transient file 550.1 for 2 days
+4 DO NOW^%DTC
SET DTTM=%
+5 ;VMP OIFO BAY PINES;ELR;PSX*2*57 CHANGE PURGE DAYS TO T+12 FROM T+2
+6 SET X=$$FMADD^XLFDT(DT,+12)
SET ^XTMP("PSXERR "_DTTM,0)=X_U_DT_U_"CMOP "_XXERR
+7 MERGE ^XTMP("PSXERR "_DTTM,550.1)=^PSX(550.1)
+8 SET XMSUB="CMOP Error "_PSXDIVNM_" "_$$GET1^DIQ(550.2,+$GET(PSXBAT),.01)
+9 DO GRP1^PSXNOTE
+10 ;S XMY(DUZ)=""
+11 SET XMTEXT="TEXT("
+12 SET TEXT(1,0)=$SELECT($GET(PSXCS):"",1:"NON-")_"CS CMOP Transmission encountered the following error. Please investigate"
+13 SET TEXT(2,0)="Division: "_PSXDIVNM
+14 SET TEXT(3,0)="Type/Batch "_$SELECT($GET(PSXCS):"CS",1:"NON-CS")_" / "_$$GET1^DIQ(550.2,+$GET(PSXBAT),.01)
+15 SET TEXT(4,0)="Error: "_XXERR
+16 SET TEXT(5,0)="The prescriptions have been reset and other divisions' transmissions are continuing."
+17 SET TEXT(6,0)="A copy of the file 550.1 can be found in ^XTMP(""PSXERR "_DTTM_""")"
+18 DO ^%ZTER
+19 DO ^XMD
+20 ;I $E(IOST)="C" F XX=1:1:5 W !,TEXT(XX,0)
+21 SET PSXXDIV=PSOSITE
+22 ;hopefully no errors will be experienced in recovery
DO EN1^PSXRCVRY
+23 SET PSOSITE=PSXXDIV
+24 GOTO UNWIND^%ZTER
+25 QUIT
STOPET ;disable auto error trapping
+1 SET ^XTMP("PSXAUTOERR",0)=DT_U_DT_U_"disable PSX CMOP auto error trapping for today"
+2 QUIT
STARTET ;enable auto error trapping
+1 KILL ^XTMP("PSXAUTOERR",0)
+2 QUIT
