Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSXRSUS

PSXRSUS.m

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