source: FOIAVistA/tag/r/CMOP-PSX/PSXSYS.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
RevLine 
[628]1PSXSYS ;BIR/WPB-Display CMOP System Status ;11 SEP 1998 8:38 AM
2 ;;2.0;CMOP;**1,18,23,41**;11 Apr 97
3 ;Reference to ^DIC(4.2 supported by DBIA #1966
4 ;
5 S SYSFLAG=0
6SYSTEM ;displays the system status - called from the CMOP MGR menu
7 S SY=$O(^PSX(550,"C",""))
8 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 !
9 S MMM=$P($G(^PSX(550,+SS,0)),U,4),XCMOP=$$GET1^DIQ(4.2,MMM,.01)
10M 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-"""
11 I D ^DIC K DIC G:(Y<1)!($D(DUOUT))!($D(DTOUT)) EXIT S PSXMDM=+Y
12 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)
13SYS S CDOM=$P($G(^PSX(550,+SS,0)),U,4) S:(CDOM'="") CMOP=$$GET1^DIQ(4.2,CDOM,.01)
14 S SYSSTAT=$$GET1^DIQ(550,+SS,1)
15 I $D(^PSX(550,+SS,"P",0)) D
16 .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
17 I '$D(^PSX(550,+SS,"P",0)) S PURG="Files have not been purged."
18 K TSK D OPTSTAT^XUTMOPT("PSXR SCHEDULED NON-CS TRANS",.TSK)
19 S AUTO=$S(+$G(TSK(1)):"YES",1:"NO")
20 K TSK D OPTSTAT^XUTMOPT("PSXR SCHEDULED CS TRANS",.TSK)
21 S AUTOCS=$S(+$G(TSK(1)):"YES",1:"NO")
22 S TSKS=+$$TSKRUN S TSKS=$S(+TSKS'>1:"NO",1:"YES")
23 S XMIT=$$GET1^DIQ(550,+SS,3)
24 W !!,?30,"CMOP SYSTEM STATUS"
25 W !!,SYSTEM," (",SYSSTAT,")",?27," :",?30,XMIT
26 S XX=$P($G(^PSX(550,+SS,3)),U,1) I XX S XX=$$GET1^DIQ(550.2,XX,.01)
27 W !,"Last Batch Transmitted",?28,":",?30,XX K XX
28 ;I $G(PURG)'="" W !,"CMOP RX Queue purged",?28,":",?30,$G(PDTTM)
29 W !,"Auto Transmission setup",?28,":",?30,AUTO
30 W !,"Auto CS Transmission setup",?28,":",?30,AUTOCS
31 K AA,AUTO,CC,CMOP,ON,XMDUZ,XCMOP,J,AUTOCS
32 I SYSFLAG=0 G EXIT
33 I SYSFLAG=1 D AC^PSXSITE
34 Q
35EXIT 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
36 Q
37SET Q:'$D(^PSX(550,"C"))
38 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
39 S PSXSYS=+$O(^PSX(550,"C",""))_"^"_$G(S3)_"^"_$G(S2)
40 I $G(S3)="" S PSXER=$G(PSXER)_"^"_11 D ER1^PSXERR K PSXER Q
41 K S3,S2,S1,PSXUTIL
42 Q
43DEACT W !!
44 D DEACT^PSXRHLP
45 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)
46 Q:SYSTEM=""
47 S DIR(0)="Y",DIR("A")="Do you want to Inactivate the "_SYSTEM_" system",DIR("A",1)=SYSTEM_" is the current active CMOP system."
48 S DIR("A",2)=" ",DIR("B")="NO" D ^DIR K DIR G:(Y=0)!($D(DIRUT)) EXIT K DIR,DIRUT,DUOUT,DTOUT
49 W !!
50 S DIR(0)="Y",DIR("A")="Are you sure",DIR("A",1)=" ",DIR("B")="NO"
51 D ^DIR K DIR G:(Y=0)!($D(DIRUT)) EXIT K DIR,DIRUT,DUOUT,DTOUT
52 L +^PSX(550,SS):30 I '$T W !!,"The CMOP System file is in use, try later." Q
53 S STAT="I",DIE="^PSX(550,",DA=SS,DR="1////"_STAT D ^DIE K DIE,DA L -^PSX(550,SS) W !
54 ;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
55 D RESCH^XUTMOPT("PSXR SCHEDULED NON-CS TRANS","@") ;remove scheduling
56 D RESCH^XUTMOPT("PSXR SCHEDULED CS TRANS","@")
57 F XX=13,14 S ZTSK=$$GET1^DIQ(550,+PSXSYS,XX) I ZTSK D KILL^%ZTLOAD ;remove pending tasks
58 K DR,DIC,DA,DIE
59 S DIE=550,DA=+PSXSYS,DR="2////H;13///@;14///@" L +^PSX(550,DA) D ^DIE
60 L -^PSX(550,DA) K DR,DA,DIC,DIE
61 S SYSFLAG=0 D NOTE^PSXSITE
62 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
63 K Y,DIRUT,DUOUT,DTOUT
64 S SYSFLAG=1
65 K ACT
66 D SYSTEM^PSXSYS
67 Q
68TSKRUN() ;return list of tasks if tasks are running/pending or 1 if Transmitting only ;; 2:"TR",13:"AE",14:"AF",9:"AG" ;
69 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
70 N XX,YY,ZZ S ZZ=""
71 F XX="AE","AF","AG" F YY=0:0 S YY=$O(^PSX(550,XX,YY)) Q:YY'>0 S ZZ=ZZ_YY_"^"
72 S:'+ZZ ZZ=1 ; "TR","T" or "TR","R" found
73 Q ZZ
Note: See TracBrowser for help on using the repository browser.