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

PSXBKD.m

Go to the documentation of this file. 
  1. PSXBKD ;BIR/WPB,PWC-Routine to Control Host Background Jobs ;08 Apr 98  4:22 AM
  1.  ;;2.0;CMOP;**38,44**;11 Apr 97
  1. DELREL W !!
  1.  I $D(^PSX(554,"AR")) S DIR(0)="Y",DIR("B")="NO",DIR("A",1)="This job is already scheduled.",DIR("A")="Do you want to unschedule this job" D ^DIR K DIR G:(Y<1)!($D(DIRUT)) EXIT G:Y=1 UNSCH
  1.  S %DT="AEXR",%DT("A")="Enter starting date/time: ",%DT("B")="TODAY@2300" D ^%DT G:Y<0!($D(DTOUT)) EXIT S PSXDATE=Y K %DT,%DT("A"),%DT("B"),Y,X
  1.  S ZTIO="",ZTDTH=PSXDATE,ZTDESC="CMOP Background Purge for CMOP Release File",ZTRTN="DEL513A^PSXBKD" D ^%ZTLOAD
  1.  I $G(ZTSK)>0 W !,"Job Started.",! D
  1.  .K DD,DO
  1.  .S:'$D(^PSX(554,1,1,0)) ^PSX(554,1,1,0)="^554.01SA^^"
  1.  .S DIC(0)="Z",DA(1)=1,DIC="^PSX(554,"_DA(1)_",1,",X=2,DIC("DR")="1////"_PSXDATE_";2////"_ZTSK_";3////S;4////"_DUZ D FILE^DICN K DIC,DIC(0),DIC("DR"),Y,X
  1.  S ZTREQ="@"
  1. EXIT K Y,%DT("A"),%DT("B"),N,PSXDATE,STDATE,TIME,DIR,DIRUT,DIROUT,DTOUT,DUOUT
  1.  Q
  1.  ;Called by Taskman to update 554 and purge 552.3
  1. DEL513A S PSXTSK1=ZTSK D RESCH
  1. D513AA S REC=$O(^PSX(554,"AR","")) L +^PSX(554,1,1,REC):600 G:'$T D513AA
  1.  S DA=REC,DA(1)=1,DIE="^PSX(554,"_DA(1)_",1,",DR="3////R" D ^DIE
  1.  L -^PSX(554,1,1,REC) K DIE,DA,DR
  1.  S DEL=0 F  S DEL=$O(^PSX(552.3,"AF",DEL)) Q:DEL'>0  S DA=DEL,DIK="^PSX(552.3," D ^DIK K DIK,DA
  1. D513AB S REC=$O(^PSX(554,"AR","")) L +^PSX(554,1,1,REC):600 G:'$T D513AB
  1.  S DA=REC,DA(1)=1,DIE="^PSX(554,"_DA(1)_",1,",DR="3////S" D ^DIE
  1.  L -^PSX(554,1,1,REC) K DIE,DA,DR
  1.  K DEL,ZTIO,ZTDESC,ZTRTN,ZTSK,ZTDTH,REC
  1.  Q
  1. RESCH S ZTSK=PSXTSK1,TIME="24H",ZTIO="",ZTDESC="CMOP Background Purge for CMOP Release File",ZTRTN="DEL513A^PSXBKD",ZTDTH=TIME D REQ^%ZTLOAD
  1.  D NOW^%DTC
  1.  S RE=$O(^PSX(554,"AR","")) S:$G(RE)>0 $P(^PSX(554,1,1,RE,0),"^",9)=%
  1.  K PSXTSK1,%,RE
  1.  Q
  1. UNSCH N ZTSK
  1.  S REC=$O(^PSX(554,"AR",""))
  1.  S ZTSK=$P(^PSX(554,1,1,REC,0),"^",3)
  1.  I $G(ZTSK)'>0 W !,"This job doesn't exist.",! Q
  1.  D STAT^%ZTLOAD
  1.  I ZTSK(1)=2 W !,"This task is currently running, wait until the task has finished before stopping the job.",! Q
  1.  I ZTSK(1)'=2 D KILL^%ZTLOAD
  1. UNSCH1 I ZTSK(0)=1 W !,"Job stopped.",! L +^PSX(554,1,1,REC):600 G:'$T UNSCH1 D
  1.  .D NOW^%DTC S DA=REC,DA(1)=1
  1.  .S DIE="^PSX(554,"_DA(1)_",1,",DR="2////@;3////S;5////"_%_";6////"_DUZ
  1.  .D ^DIE K DA,DIE,DR
  1.  L -^PSX(554,1,1,REC) K Y,ZTSK
  1.  Q
  1. STOPJOB N ZTSK
  1.  S REC=$O(^PSX(554,"AB",""))
  1.  S ZTSK=$P(^PSX(554,1,1,REC,0),"^",3)
  1.  I $G(ZTSK)'>0 W !,"This job doesn't exist.",! Q
  1.  D STAT^%ZTLOAD
  1.  I ZTSK(1)=2 W !,"This task is currently running, wait until the task has finished before stopping the job.",! Q
  1.  I ZTSK(1)'=2 D KILL^%ZTLOAD
  1. STOP1 I ZTSK(0)=1 W !,"Job stopped.",! L +^PSX(554,REC):600 G:'$T STOP1 D
  1.  .D NOW^%DTC S DA=REC,DA(1)=1,DIE="^PSX(554,"_DA(1)_",1,"
  1.  .S DR="2////@;3////S;5////"_%_";6////"_DUZ D ^DIE
  1.  .L -^PSX(554,REC) K DA,DIE,DR,REC
  1.  Q
  1. STATUS N PSXSTAT,PSXTXT
  1.  S PSXSTAT=$G(^PSX(553,1,"S"))
  1.  Q:PSXSTAT=""
  1.  S PSXTXT="CMOP Interface is "_$S(PSXSTAT="R":"RUNNING!!!",1:"Stopped.")
  1.  W !!,?((IOM\2)-($L(PSXTXT)\2)-3),PSXTXT
  1.  N PSX1,PSX2 S (CNT,BCNT,OCNT,TRX,QFLG,TTRX)=0
  1.  G:'$O(^PSX(553.1,0)) ST1
  1.  S QRY=$P(^PSX(553.1,0),"^",3) G:$G(QRY)'>0 ST1
  1.  S STAT=$P(^PSX(553.1,QRY,0),"^",5) D
  1.  .I $G(STAT)'=1&($G(STAT)'=5) S QRY=QRY-1 S TRX=$P(^PSX(553.1,QRY,0),"^",6),QTM=$$FMTE^XLFDT($P($G(^PSX(553.1,QRY,0)),"^",4),1) S:$G(TRX)="" TRX=0 Q
  1.  .I $G(STAT)=5 S QFLG=1,TTRX=$P(^PSX(553.1,QRY,0),"^",6) S:$G(TRX)="" TTRX=0 S TRX=$P(^PSX(553.1,QRY-1,0),"^",6) S:$G(TRX)="" TRX=0 S QTM=$$FMTE^XLFDT($P($G(^PSX(553.1,QRY-1,0)),"^",4),1) Q
  1.  .I $G(STAT)=1 S TRX=$P(^PSX(553.1,QRY,0),"^",6),QTM=$$FMTE^XLFDT($P($G(^PSX(553.1,QRY,0)),"^",4),1) S:$G(TRX)="" TRX=0
  1. ST1 I $P($G(^PSX(552.1,0)),"^",3)'>0 S NDATA=1 G EX
  1.  S PSX1=$G(^PSX(553,1,99)) Q:PSX1=""  S ST=$P(PSX1,"-",1),ST2=$O(^PSX(552.1,"B",$P(PSX1,"-",1,2),""))
  1.  ;S X=ST S:$D(^PSX(552,"D",X)) X=$E(X,2,99) S DIC="4",DIC(0)="MOZX" D ^DIC S ST1=+Y I $G(ST1)="" W !,"Remote site is not in the Institution file." Q  ;****DOD L1
  1.  S X=ST,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S ST1=$$IEN^XUMF(4,AGNCY,X) I $G(ST1)="" W !,"Remote site is not in the Institution file." Q  ;****DOD L1
  1.  S SITE=$P(Y,"^",2),IEN512=$O(^PSX(552.2,"B",PSX1,"")) K DIC,Y,X
  1.  S:$G(IEN512)'="" ACKTM=$$HTE^XLFDT($P($G(^PSX(552.2,$G(IEN512),0)),"^",4),1)
  1.  S:$G(IEN512)="" ACKTM=$$FMTE^XLFDT($P(^PSX(552.1,ST2,0),"^",6),1)
  1.  I '$D(^PSX(552.1,"AQ")) S CNT=0
  1.  I $D(^PSX(552.1,"AQ")) S XXX="" F  S XXX=$O(^PSX(552.1,"AQ",XXX)) Q:'XXX  S BCNT=BCNT+1,YYY="" F  S YYY=$O(^PSX(552.1,"AQ",XXX,YYY)) Q:'YYY  S ZZZ=0 F  S ZZZ=$O(^PSX(552.1,"AQ",XXX,YYY,ZZZ)) Q:ZZZ'>0  D
  1.  .S CNT=$P($G(^PSX(552.1,ZZZ,1)),"^",4)+CNT,OCNT=$P($G(^PSX(552.1,ZZZ,1)),"^",3)+OCNT
  1.  W !!,"Last Order Processed ",?22,":",?24,$G(SITE)," ",PSX1
  1.  W !,"Date and Time",?22,":",?24,$G(ACKTM)
  1.  W !!,"Total in the Queue",?22,":",?24,$G(BCNT)," Transmissions with ",$G(OCNT)_"/"_$G(CNT)," Orders/Rx's"
  1. EX I $G(NDATA)>0 W !!,"No data has been sent to the automated system."
  1.  I $G(QRY)>0 W !!,"Last Query Request",?22,":",?24,$S($G(QFLG)=0:$G(QRY),$G(QFLG)=1:$G(QRY)-1,1:""),!,"  Rx's received",?22,":",?24,$G(TRX),!,"  Date and Time",?22,":",?24,$G(QTM)
  1.  I $G(QFLG)=1 W !!,"Query# ",$G(QRY)," in progress ",$G(TTRX)," Rx's have been received."
  1.  W !
  1.  S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR,Y W @IOF
  1. EX1 K PSX1,ST,ST1,ST2,SITE,XXX,YYY,ZZZ,CNT,BCNT,OCNT,QRY,TRX,PSXSTAT,PSXTXT,ACKTM,IEN512,QFLG,QTM,STAT,TTRX,NDATA,DTOUT,DIROUT,DIRUT,DUOUT
  1.  Q