- PSXRSUS ;BIR/WPB,BAB,HTW-CMOP Transmission Handler ;15 Dec 2001
- ;;2.0;CMOP;**2,3,24,23,26,28,41,57,48,70,75,90,97**;11 Apr 97;Build 12
- ;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
- N PSXCS ;p90
- 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=$S($G(PSXCS)=1:$P(PSOPAR,"^",9),1:$P(PSOPAR,"^",35)),X1=TPRTDT,X2=PSXDAYS D C^%DTC S PSXDTRG=X K X,X1,X2 ;p97
- 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","PSOFDAPT" 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=$S($G(PSXCS)=1:$P(PSOPAR,"^",9),1:$P(PSOPAR,"^",35)),X1=PRTDT,X2=PSXDAYS D C^%DTC S PSXDTRG=X K X,X1,X2 ;adjusts variables per divisional parameters. p97
- .. 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXRSUS 10098 printed Jan 18, 2025@02:46:14 Page 2
- PSXRSUS ;BIR/WPB,BAB,HTW-CMOP Transmission Handler ;15 Dec 2001
- +1 ;;2.0;CMOP;**2,3,24,23,26,28,41,57,48,70,75,90,97**;11 Apr 97;Build 12
- +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 ;p90
- NEW PSXCS
- +2 IF REPLY="5"
- GOTO DEV1^PSOSULB1
- +3 IF "24"[REPLY
- SET PSXCS=1
- +4 IF "12"[REPLY
- SET (PSXTRANS,PSXFLAG)=1
- +5 IF "34"[REPLY
- SET PSXFLAG=2
- +6 KILL REPLY
- +7 ;
- 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 ;p97
- SET PSXDAYS=$SELECT($GET(PSXCS)=1:$PIECE(PSOPAR,"^",9),1:$PIECE(PSOPAR,"^",35))
- 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","PSOFDAPT"
- 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. p97
- SET PSXDAYS=$SELECT($GET(PSXCS)=1:$PIECE(PSOPAR,"^",9),1:$PIECE(PSOPAR,"^",35))
- 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