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