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

PSXAUTO.m

Go to the documentation of this file.
  1. PSXAUTO ;BIR/WPB-Routine to Automatically Run CMOP Suspense ;14 DEC 2001
  1. ;;2.0;CMOP;**1,2,3,24,28,36,41**;11 Apr 97
  1. ;Reference to ^XUSEC( supported by DBIA #10076
  1. ;This routine will be called from a menu option and will allow
  1. ;the user to start or change auto-processing. The user must hold
  1. ;the PSXAUTOX security key.
  1. G START
  1. STARTCS ; entry from edit auto CS Schedule menu option (future - post *41))
  1. S PSXCS=1
  1. START ;
  1. S PSXCS=+$G(PSXCS)
  1. I '$D(^XUSEC("PSXAUTOX",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. I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
  1. D SET^PSXSYS I $G(PSXSYS)="" W !!,"The Station number is missing in the Institution file.",!,"The Station number is required for CMOP transmissions.",!,"Please contact your IRM and have this problem corrected, then try again." Q
  1. I '$D(^PSX(550,"C")) W !,"The CMOP is not an active CMOP site and can not schedule auto transmissions." Q
  1. I $D(^PSX(550,"TR","T")) W !,"A transmission is in progress, try later." Q
  1. L +^PSX(550.1):5 I '$T W !,"A transmission is in progress, try later." Q
  1. S PSXSTAT="T" D PSXSTAT^PSXRSYU I $G(PSXLOCK) G EXIT
  1. S PSXDUZ=DUZ
  1. F PSXCS=0,1 D GETSCH S DTTM(PSXCS)=PSXDATE ; store pre-edit schedule values
  1. ASK D EDTBSCH ; edit both schedules
  1. FILE ; if either schedule changed send appropriate message
  1. F PSXCS=0,1 D GETSCH D
  1. . I DTTM(PSXCS)=PSXDATE Q ;no change - quit
  1. . I 'PSXDATE,DTTM(PSXCS) S (PSXAUTO,PSXHOUR)=0 D AUTOMSG^PSXMSGS,SERV^PSXMISC W !,$S(PSXCS:"",1:"NON-"),"CS Cancel Schedule Sent to CMOP" H 3 Q ; schedule deleted
  1. . S PSXAUTO=1 D AUTOMSG^PSXMSGS,SERV^PSXMISC W !,$S(PSXCS:"",1:"NON-"),"CS New Schedule Sent to CMOP" H 3 ; new/changed schedule to send
  1. K DTTM
  1. G EXIT
  1. ;
  1. ENCS ; entry from auto CS Tasking Option Schedule (future-post *41)
  1. S PSXCS=1
  1. EN ;Entry from Kernel Option Tasking NON-CS
  1. S PSXCS=+$G(PSXCS)
  1. Q:'$D(^PSX(550,"C")) ;no CMOP selected M xref
  1. Q:'$D(^PSX(550,"ST","A")) ;no CMOP selected Regular xref
  1. S ZTSK=$G(ZTSK),PSXZTSK=ZTSK,PSXCS=+$G(PSXCS)
  1. ; test if previous job still running
  1. LOCK ; >>>**** LOCK OF FILE 550.1 ****<<<
  1. L +^PSX(550.1):60 I '$T D RQUEMSG G EXIT ; no lock then reque 30 minutes later
  1. ;if a lock is obtainable , no transmission is running
  1. TFLAG I $D(^PSX(550,"TR","T")) D G TFLAG ;clear 'T' flags
  1. . D ^PSXRCVRY
  1. . N PSXSYS S PSXSYS=$O(^PSX(550,"TR","T",0)) S PSXSTAT="H" D PSXSTAT^PSXRSYU
  1. ; proceeding to process files
  1. D SET^PSXSYS Q:$P(PSXSYS,"^",2)=""
  1. I $D(^PSX(550.2,"AQ")) D EN1^PSXRCVRY
  1. ; set running task into 550 RUNNING TASK
  1. K DIC,DIE,DR,DA S DIE=550,DA=+PSXSYS,DR="9////"_$G(ZTSK) D ^DIE K DIC,DIE,DR,DA
  1. ; proceed tp process, setup variables, call into LOCK^PSXRSUS
  1. S XX=$S('PSXCS:11,1:12) S THRU=+$$GET1^DIQ(550,+PSXSYS,XX)
  1. S TPRTDT=DT S:$G(THRU)>0 TPRTDT=$$FMADD^XLFDT(DT,THRU,0,0,0)
  1. S PSXDIVML=1,PSXFLAG=1,PSXTRANS=1,PSOINST=$P(PSXSYS,"^",2)
  1. G LOCK^PSXRSUS
  1. ;
  1. EDTBSCH ; display/edit both schedules as they are interactive with each other
  1. W @IOF D DSPSCH
  1. K DIR S DIR(0)="SO^C:Controlled Substance;N:NON-Controlled Substance;",DIR("A")="Edit CS <C> or NON-CS <N> "
  1. D ^DIR K DIR
  1. I Y'="C",Y'="N" Q
  1. N PSXCS
  1. S PSXCS=$S(Y="C":1,1:0)
  1. D EDIT
  1. G EDTBSCH
  1. ;
  1. EDIT ;Edit scheduling of transmissions and parameter "Number of days to transmit"
  1. ;schedules must be separated by 2 hours
  1. S PSXCS=+$G(PSXCS)
  1. S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
  1. D EDIT^XUTMOPT(XX)
  1. I '$D(PSXSYS) D SET^PSXSYS
  1. I +PSXSYS S DIE=550,DR="11",DA=+PSXSYS S:PSXCS DR="12" D ^DIE
  1. ;check for 2 hour difference
  1. I $$CHKSCH() Q ; 2 hour difference satisfied
  1. W @IOF,!,"Sorry, there has to be at least 2 hours between the daily transmission runs.",!
  1. D DELSCH
  1. W !! K DIR S DIR(0)="E",DIR("A")="The "_$S(PSXCS:"CS",1:"NON-CS")_" schedule has been cleared for RE-EDIT. <cr>" D ^DIR
  1. Q
  1. ;
  1. CHKSCH() ;CHECK Task schedules for 2 hour difference
  1. N PSXCS,CSTSK,CSDATE,CSTHRU,CSHOUR,NCSTSK,NCSDATE,NCSTHRU,NCSHOUR,TSDIF
  1. S PSXCS=1 D GETSCH
  1. S CSTSK=+TSK(1),CSDATE=PSXDATE,CSHOUR=PSXHOUR,CSTHRU=THRU
  1. S PSXCS=0 D GETSCH
  1. S NCSTSK=+TSK(1),NCSDATE=PSXDATE,NCSHOUR=PSXHOUR,NCSTHRU=THRU
  1. I NCSTSK,CSTSK I 1
  1. E Q 1 ; quit test if either is not scheduled
  1. S CSDATE=(CSDATE#1)+DT,NCSDATE=(NCSDATE#1)+DT
  1. S X1=CSDATE,X2=NCSDATE
  1. I CSDATE>NCSDATE S X1=NCSDATE,X2=CSDATE
  1. S TSDIF=$$FMDIFF^XLFDT(X2,X1,2)
  1. ;W ! ZW X1,X2,XX,NCSDATE,CSDATE H 5
  1. I TSDIF<7200 Q 0
  1. I TSDIF>79200 Q 0
  1. Q 1
  1. ;
  1. DELSCH ;Delete startup time and its pending task
  1. S PSXCS=+$G(PSXCS)
  1. S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
  1. D RESCH^XUTMOPT(XX,"@")
  1. D:'+PSXSYS SET^PSXSYS
  1. Q
  1. ;
  1. GETSCH ; get schedule information from Kernel Option Scheduling
  1. S PSXCS=+$G(PSXCS)
  1. D:'$D(PSXSYS) SET^PSXSYS
  1. S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
  1. K TSK D OPTSTAT^XUTMOPT(XX,.TSK) S TSK(1)=$G(TSK(1))
  1. S (PSXDATE,PSXHOUR,THRU)=""
  1. S PSXZTSK=+TSK(1),PSXDATE=$P(TSK(1),U,2),PSXHOUR=$P(TSK(1),U,3)
  1. S XX=$S('PSXCS:11,1:12) S THRU=$$GET1^DIQ(550,+PSXSYS,XX)
  1. Q
  1. ;
  1. DSPSCH ;Display schedules for transmissions
  1. N PSXCS,CSTSK,CSDATE,CSTHRU,CSHOUR,NCSTSK,NCSDATE,NCSTHRU,NCSHOUR
  1. S PSXCS=1 D GETSCH
  1. S CSTSK=+TSK(1),CSDATE=PSXDATE,CSHOUR=PSXHOUR,CSTHRU=THRU
  1. S PSXCS=0 D GETSCH
  1. S NCSTSK=+TSK(1),NCSDATE=PSXDATE,NCSHOUR=PSXHOUR,NCSTHRU=THRU
  1. S Y=CSDATE X ^DD("DD") S CSDATE=Y S Y=NCSDATE X ^DD("DD") S NCSDATE=Y
  1. W !,?25,"CS Transmission",?55,"Non-CS Transmission"
  1. W !,"Scheduled to Run",?25,CSDATE,?55,NCSDATE
  1. W !,"Frequency (hrs)",?25,CSHOUR,?55,NCSHOUR
  1. W !,"Thru days",?25,CSTHRU,?55,NCSTHRU
  1. W !,"Tasking ID",?25,CSTSK,?55,NCSTSK
  1. Q
  1. ;
  1. RQUEMSG ; lock on 550.1 not achieved send transmission requeued message
  1. S PSXCS=+$G(PSXCS)
  1. S ZTSAVE("PSXCS")=""
  1. D NOW^%DTC
  1. S ZTDTH=$$FMADD^XLFDT(%,,,30)
  1. S Y=% X ^DD("DD") S DTTM=Y
  1. S ZTDESC="CMOP "_$S(PSXCS:"",1:"NON-")_"CS AUTO TRANSMISSION REQUEUE"
  1. S ZTRTN="EN^PSXAUTO",ZTIO=""
  1. D ^%ZTLOAD
  1. S XMDUZ="Postmaster",XMSUB=$S($G(PSXCS):"",1:"NON-")_"CS Scheduled Transmission RE-Queued"
  1. S XMTEXT="TXT("
  1. S TXT(1,0)="The "_$S($G(PSXCS):"",1:"NON-")_"CS Scheduled Transmission for "_DTTM
  1. S TXT(2,0)="was re-queued with task # "_ZTSK_" to run again in 30 minutes."
  1. S TXT(3,0)="It could not obtain a lock on the RX QUEUE file #550.1."
  1. S TXT(4,0)="That indicates that a transmission was in progress."
  1. S TXT(5,0)=" "
  1. S TXT(6,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. EXIT ;
  1. L -^PSX(550.1)
  1. D:'$D(PSXSYS) SET^PSXSYS
  1. S PSXSTAT="H" D PSXSTAT^PSXRSYU
  1. K TIME,STDATE,NUM,X,Y,FREQ,PSXZTSK,START,ZTSK,%,%DT,DTE,LCNT,LL,N,RECD,RR,SITE,XMDUN,XMDUZ,XMSUB,XMZ,PSXDUZ,PSXAUTO,PSXDATE,PSXHOUR,DTTM
  1. K ZTSAVE,ZTDESC,ZTRTN,ZTIO,ZTREQ,ZTDTH,SDATE,DIR,DIRUT,DUOUT,DTOUT
  1. K PSXSYS,DIROUT,THRU,NEXT,RE,PSXLOCK,XX,PSXXDIV
  1. S ZTREQ="@"
  1. Q
  1. STOPET ; set a stop auto-error-trap node
  1. S ^XTMP("PSXAUTOERR")=DT_"^"_DT_"^AUTO ERROR TRAP STOP NODE"
  1. Q
  1. STARTET ; remove any stop node
  1. K ^XTMP("PSXAUTOERR")
  1. Q