PSXSYS ;BIR/WPB-Display CMOP System Status ;11 SEP 1998 8:38 AM
;;2.0;CMOP;**1,18,23,41**;11 Apr 97
;Reference to ^DIC(4.2 supported by DBIA #1966
;
S SYSFLAG=0
SYSTEM ;displays the system status - called from the CMOP MGR menu
S SY=$O(^PSX(550,"C",""))
S DIC(0)="AEQMZ",DIC("A")="Enter CMOP System: ",DIC("B")=$S(SYSFLAG=0:$G(SY),1:""),DIC=550 D ^DIC K DIC G:Y<0!($D(DUOUT))!($D(DTOUT)) EXIT S SS=+Y,SYSTEM=$P($G(Y),U,2) W !
S MMM=$P($G(^PSX(550,+SS,0)),U,4),XCMOP=$$GET1^DIQ(4.2,MMM,.01)
M I SYSFLAG=1 S DIC(0)="AEQMZ",DIC("A")="Enter mailman domain: ",DIC("B")=$G(XCMOP),DIC=4.2,DIC("S")="I $P($G(^DIC(4.2,+Y,0)),U,1)[""CMOP-"""
I D ^DIC K DIC G:(Y<1)!($D(DUOUT))!($D(DTOUT)) EXIT S PSXMDM=+Y
I SYSFLAG=1 L +^PSX(550,+SS):30 W:'$T !!,"The CMOP System file is in use try later." Q:'$T S DA=+SS,DIE="^PSX(550,",DR="3////"_PSXMDM D ^DIE K DIE,DA,DR,DIRUT,DTOUT,DUOUT L -^PSX(550,+SS)
SYS S CDOM=$P($G(^PSX(550,+SS,0)),U,4) S:(CDOM'="") CMOP=$$GET1^DIQ(4.2,CDOM,.01)
S SYSSTAT=$$GET1^DIQ(550,+SS,1)
I $D(^PSX(550,+SS,"P",0)) D
.S PP=0 F S PP=$O(^PSX(550,+SS,"P",PP)) Q:PP'>0 S PURG=PP,Y=$P($G(^PSX(550,+SS,"P",$G(PURG),0)),U,1) X ^DD("DD") S PDTTM=Y K Y
I '$D(^PSX(550,+SS,"P",0)) S PURG="Files have not been purged."
K TSK D OPTSTAT^XUTMOPT("PSXR SCHEDULED NON-CS TRANS",.TSK)
S AUTO=$S(+$G(TSK(1)):"YES",1:"NO")
K TSK D OPTSTAT^XUTMOPT("PSXR SCHEDULED CS TRANS",.TSK)
S AUTOCS=$S(+$G(TSK(1)):"YES",1:"NO")
S TSKS=+$$TSKRUN S TSKS=$S(+TSKS'>1:"NO",1:"YES")
S XMIT=$$GET1^DIQ(550,+SS,3)
W !!,?30,"CMOP SYSTEM STATUS"
W !!,SYSTEM," (",SYSSTAT,")",?27," :",?30,XMIT
S XX=$P($G(^PSX(550,+SS,3)),U,1) I XX S XX=$$GET1^DIQ(550.2,XX,.01)
W !,"Last Batch Transmitted",?28,":",?30,XX K XX
;I $G(PURG)'="" W !,"CMOP RX Queue purged",?28,":",?30,$G(PDTTM)
W !,"Auto Transmission setup",?28,":",?30,AUTO
W !,"Auto CS Transmission setup",?28,":",?30,AUTOCS
K AA,AUTO,CC,CMOP,ON,XMDUZ,XCMOP,J,AUTOCS
I SYSFLAG=0 G EXIT
I SYSFLAG=1 D AC^PSXSITE
Q
EXIT K SYSFLAG,SYSTEM,SS,SY,Y,CDOM,FDOM,SYSSTAT,PP,PURG,PDTTM,XX,XMIT,STAT,AA,MMM,DTOUT,DUOUT,DIC,DIR,DIRUT,DIROUT,ACT,XMDUZ,XCMOP,J,TSK,TSKS
Q
SET Q:'$D(^PSX(550,"C"))
S (S1,DA)=$$KSP^XUPARAM("INST"),DIC="4",DIQ(0)="IE",DR=".01;99",DIQ="PSXUTIL" D EN^DIQ1 S S3=$G(PSXUTIL(4,S1,99,"I")),S2=$G(PSXUTIL(4,S1,.01,"E")) K DA,DIC,DIQ(0),DR
S PSXSYS=+$O(^PSX(550,"C",""))_"^"_$G(S3)_"^"_$G(S2)
I $G(S3)="" S PSXER=$G(PSXER)_"^"_11 D ER1^PSXERR K PSXER Q
K S3,S2,S1,PSXUTIL
Q
DEACT W !!
D DEACT^PSXRHLP
S ACT=0 F S ACT=$O(^PSX(550,"C",ACT)) Q:ACT'>0 S (DA,SS)=ACT,SYSTEM=$P($G(^PSX(550,SS,0)),U,1)
Q:SYSTEM=""
S DIR(0)="Y",DIR("A")="Do you want to Inactivate the "_SYSTEM_" system",DIR("A",1)=SYSTEM_" is the current active CMOP system."
S DIR("A",2)=" ",DIR("B")="NO" D ^DIR K DIR G:(Y=0)!($D(DIRUT)) EXIT K DIR,DIRUT,DUOUT,DTOUT
W !!
S DIR(0)="Y",DIR("A")="Are you sure",DIR("A",1)=" ",DIR("B")="NO"
D ^DIR K DIR G:(Y=0)!($D(DIRUT)) EXIT K DIR,DIRUT,DUOUT,DTOUT
L +^PSX(550,SS):30 I '$T W !!,"The CMOP System file is in use, try later." Q
S STAT="I",DIE="^PSX(550,",DA=SS,DR="1////"_STAT D ^DIE K DIE,DA L -^PSX(550,SS) W !
;I $D(^PSX(550,"AT")) S ATREC=$O(^PSX(550,"AT","")),PTSK=$P($G(^PSX(550,1,"T",ATREC,0)),"^",7) S DIE="^PSX(550,1,""T"",",DR=".01////2;6////@",DA(1)=+$G(PSXSYS),DA=ATREC D ^DIE K DIE,DR,DA,ATREC S ZTSK=PTSK D KILL^%ZTLOAD K PTSK,ZTSK
D RESCH^XUTMOPT("PSXR SCHEDULED NON-CS TRANS","@") ;remove scheduling
D RESCH^XUTMOPT("PSXR SCHEDULED CS TRANS","@")
F XX=13,14 S ZTSK=$$GET1^DIQ(550,+PSXSYS,XX) I ZTSK D KILL^%ZTLOAD ;remove pending tasks
K DR,DIC,DA,DIE
S DIE=550,DA=+PSXSYS,DR="2////H;13///@;14///@" L +^PSX(550,DA) D ^DIE
L -^PSX(550,DA) K DR,DA,DIC,DIE
S SYSFLAG=0 D NOTE^PSXSITE
S DIR(0)="Y",DIR("A")="Activate another system",DIR("A",1)="The "_SYSTEM_" system has been inactivated.",DIR("B")="NO" D ^DIR K DIR G:(Y=0)!($D(DIRUT)) EXIT
K Y,DIRUT,DUOUT,DTOUT
S SYSFLAG=1
K ACT
D SYSTEM^PSXSYS
Q
TSKRUN() ;return list of tasks if tasks are running/pending or 1 if Transmitting only ;; 2:"TR",13:"AE",14:"AF",9:"AG" ;
I '$D(^PSX(550,"AE")),'$D(^PSX(550,"AF")),'$D(^PSX(550,"AG")),'$D(^PSX(550,"TR","T")),'$D(^PSX(550,"TR","R")) Q 0
N XX,YY,ZZ S ZZ=""
F XX="AE","AF","AG" F YY=0:0 S YY=$O(^PSX(550,XX,YY)) Q:YY'>0 S ZZ=ZZ_YY_"^"
S:'+ZZ ZZ=1 ; "TR","T" or "TR","R" found
Q ZZ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXSYS 4378 printed Sep 23, 2025@19:21:18 Page 2
PSXSYS ;BIR/WPB-Display CMOP System Status ;11 SEP 1998 8:38 AM
+1 ;;2.0;CMOP;**1,18,23,41**;11 Apr 97
+2 ;Reference to ^DIC(4.2 supported by DBIA #1966
+3 ;
+4 SET SYSFLAG=0
SYSTEM ;displays the system status - called from the CMOP MGR menu
+1 SET SY=$ORDER(^PSX(550,"C",""))
+2 SET DIC(0)="AEQMZ"
SET DIC("A")="Enter CMOP System: "
SET DIC("B")=$SELECT(SYSFLAG=0:$GET(SY),1:"")
SET DIC=550
DO ^DIC
KILL DIC
if Y<0!($DATA(DUOUT))!($DATA(DTOUT))
GOTO EXIT
SET SS=+Y
SET SYSTEM=$PIECE($GET(Y),U,2)
WRITE !
+3 SET MMM=$PIECE($GET(^PSX(550,+SS,0)),U,4)
SET XCMOP=$$GET1^DIQ(4.2,MMM,.01)
M IF SYSFLAG=1
SET DIC(0)="AEQMZ"
SET DIC("A")="Enter mailman domain: "
SET DIC("B")=$GET(XCMOP)
SET DIC=4.2
SET DIC("S")="I $P($G(^DIC(4.2,+Y,0)),U,1)[""CMOP-"""
+1 IF $TEST
DO ^DIC
KILL DIC
if (Y<1)!($DATA(DUOUT))!($DATA(DTOUT))
GOTO EXIT
SET PSXMDM=+Y
+2 IF SYSFLAG=1
LOCK +^PSX(550,+SS):30
if '$TEST
WRITE !!,"The CMOP System file is in use try later."
if '$TEST
QUIT
SET DA=+SS
SET DIE="^PSX(550,"
SET DR="3////"_PSXMDM
DO ^DIE
KILL DIE,DA,DR,DIRUT,DTOUT,DUOUT
LOCK -^PSX(550,+SS)
SYS SET CDOM=$PIECE($GET(^PSX(550,+SS,0)),U,4)
if (CDOM'="")
SET CMOP=$$GET1^DIQ(4.2,CDOM,.01)
+1 SET SYSSTAT=$$GET1^DIQ(550,+SS,1)
+2 IF $DATA(^PSX(550,+SS,"P",0))
Begin DoDot:1
+3 SET PP=0
FOR
SET PP=$ORDER(^PSX(550,+SS,"P",PP))
if PP'>0
QUIT
SET PURG=PP
SET Y=$PIECE($GET(^PSX(550,+SS,"P",$GET(PURG),0)),U,1)
XECUTE ^DD("DD")
SET PDTTM=Y
KILL Y
End DoDot:1
+4 IF '$DATA(^PSX(550,+SS,"P",0))
SET PURG="Files have not been purged."
+5 KILL TSK
DO OPTSTAT^XUTMOPT("PSXR SCHEDULED NON-CS TRANS",.TSK)
+6 SET AUTO=$SELECT(+$GET(TSK(1)):"YES",1:"NO")
+7 KILL TSK
DO OPTSTAT^XUTMOPT("PSXR SCHEDULED CS TRANS",.TSK)
+8 SET AUTOCS=$SELECT(+$GET(TSK(1)):"YES",1:"NO")
+9 SET TSKS=+$$TSKRUN
SET TSKS=$SELECT(+TSKS'>1:"NO",1:"YES")
+10 SET XMIT=$$GET1^DIQ(550,+SS,3)
+11 WRITE !!,?30,"CMOP SYSTEM STATUS"
+12 WRITE !!,SYSTEM," (",SYSSTAT,")",?27," :",?30,XMIT
+13 SET XX=$PIECE($GET(^PSX(550,+SS,3)),U,1)
IF XX
SET XX=$$GET1^DIQ(550.2,XX,.01)
+14 WRITE !,"Last Batch Transmitted",?28,":",?30,XX
KILL XX
+15 ;I $G(PURG)'="" W !,"CMOP RX Queue purged",?28,":",?30,$G(PDTTM)
+16 WRITE !,"Auto Transmission setup",?28,":",?30,AUTO
+17 WRITE !,"Auto CS Transmission setup",?28,":",?30,AUTOCS
+18 KILL AA,AUTO,CC,CMOP,ON,XMDUZ,XCMOP,J,AUTOCS
+19 IF SYSFLAG=0
GOTO EXIT
+20 IF SYSFLAG=1
DO AC^PSXSITE
+21 QUIT
EXIT KILL SYSFLAG,SYSTEM,SS,SY,Y,CDOM,FDOM,SYSSTAT,PP,PURG,PDTTM,XX,XMIT,STAT,AA,MMM,DTOUT,DUOUT,DIC,DIR,DIRUT,DIROUT,ACT,XMDUZ,XCMOP,J,TSK,TSKS
+1 QUIT
SET if '$DATA(^PSX(550,"C"))
QUIT
+1 SET (S1,DA)=$$KSP^XUPARAM("INST")
SET DIC="4"
SET DIQ(0)="IE"
SET DR=".01;99"
SET DIQ="PSXUTIL"
DO EN^DIQ1
SET S3=$GET(PSXUTIL(4,S1,99,"I"))
SET S2=$GET(PSXUTIL(4,S1,.01,"E"))
KILL DA,DIC,DIQ(0),DR
+2 SET PSXSYS=+$ORDER(^PSX(550,"C",""))_"^"_$GET(S3)_"^"_$GET(S2)
+3 IF $GET(S3)=""
SET PSXER=$GET(PSXER)_"^"_11
DO ER1^PSXERR
KILL PSXER
QUIT
+4 KILL S3,S2,S1,PSXUTIL
+5 QUIT
DEACT WRITE !!
+1 DO DEACT^PSXRHLP
+2 SET ACT=0
FOR
SET ACT=$ORDER(^PSX(550,"C",ACT))
if ACT'>0
QUIT
SET (DA,SS)=ACT
SET SYSTEM=$PIECE($GET(^PSX(550,SS,0)),U,1)
+3 if SYSTEM=""
QUIT
+4 SET DIR(0)="Y"
SET DIR("A")="Do you want to Inactivate the "_SYSTEM_" system"
SET DIR("A",1)=SYSTEM_" is the current active CMOP system."
+5 SET DIR("A",2)=" "
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if (Y=0)!($DATA(DIRUT))
GOTO EXIT
KILL DIR,DIRUT,DUOUT,DTOUT
+6 WRITE !!
+7 SET DIR(0)="Y"
SET DIR("A")="Are you sure"
SET DIR("A",1)=" "
SET DIR("B")="NO"
+8 DO ^DIR
KILL DIR
if (Y=0)!($DATA(DIRUT))
GOTO EXIT
KILL DIR,DIRUT,DUOUT,DTOUT
+9 LOCK +^PSX(550,SS):30
IF '$TEST
WRITE !!,"The CMOP System file is in use, try later."
QUIT
+10 SET STAT="I"
SET DIE="^PSX(550,"
SET DA=SS
SET DR="1////"_STAT
DO ^DIE
KILL DIE,DA
LOCK -^PSX(550,SS)
WRITE !
+11 ;I $D(^PSX(550,"AT")) S ATREC=$O(^PSX(550,"AT","")),PTSK=$P($G(^PSX(550,1,"T",ATREC,0)),"^",7) S DIE="^PSX(550,1,""T"",",DR=".01////2;6////@",DA(1)=+$G(PSXSYS),DA=ATREC D ^DIE K DIE,DR,DA,ATREC S ZTSK=PTSK D KILL^%ZTLOAD K PTSK,ZTSK
+12 ;remove scheduling
DO RESCH^XUTMOPT("PSXR SCHEDULED NON-CS TRANS","@")
+13 DO RESCH^XUTMOPT("PSXR SCHEDULED CS TRANS","@")
+14 ;remove pending tasks
FOR XX=13,14
SET ZTSK=$$GET1^DIQ(550,+PSXSYS,XX)
IF ZTSK
DO KILL^%ZTLOAD
+15 KILL DR,DIC,DA,DIE
+16 SET DIE=550
SET DA=+PSXSYS
SET DR="2////H;13///@;14///@"
LOCK +^PSX(550,DA)
DO ^DIE
+17 LOCK -^PSX(550,DA)
KILL DR,DA,DIC,DIE
+18 SET SYSFLAG=0
DO NOTE^PSXSITE
+19 SET DIR(0)="Y"
SET DIR("A")="Activate another system"
SET DIR("A",1)="The "_SYSTEM_" system has been inactivated."
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if (Y=0)!($DATA(DIRUT))
GOTO EXIT
+20 KILL Y,DIRUT,DUOUT,DTOUT
+21 SET SYSFLAG=1
+22 KILL ACT
+23 DO SYSTEM^PSXSYS
+24 QUIT
TSKRUN() ;return list of tasks if tasks are running/pending or 1 if Transmitting only ;; 2:"TR",13:"AE",14:"AF",9:"AG" ;
+1 IF '$DATA(^PSX(550,"AE"))
IF '$DATA(^PSX(550,"AF"))
IF '$DATA(^PSX(550,"AG"))
IF '$DATA(^PSX(550,"TR","T"))
IF '$DATA(^PSX(550,"TR","R"))
QUIT 0
+2 NEW XX,YY,ZZ
SET ZZ=""
+3 FOR XX="AE","AF","AG"
FOR YY=0:0
SET YY=$ORDER(^PSX(550,XX,YY))
if YY'>0
QUIT
SET ZZ=ZZ_YY_"^"
+4 ; "TR","T" or "TR","R" found
if '+ZZ
SET ZZ=1
+5 QUIT ZZ
