KMPDSSD1 ;OAK/RAK - CM Tools Status ;5/1/07 15:07
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
CPU ;-- cpu/node data
;
N COUNT,DATA,I,LEN,TEXT
;
D CPUGET^KMPDUTL6(.DATA)
Q:'$D(DATA)
S LN=LN+1
D SET^VALM10(LN,"")
S TEXT=" Node/CPU Data............... "
S (COUNT,I,LEN)=0
F S I=$O(DATA(I)) Q:'I D
.S COUNT=COUNT+1,DATA=$G(DATA(I,0)) Q:DATA=""
.; length of node name
.S:'LEN LEN=$L($P(DATA,U))+2
.S TEXT=$S(COUNT=1:TEXT,1:$J(" ",32))_$P(DATA,U)
.S TEXT=TEXT_$J(" ",32-$L(TEXT)+LEN)_$P(DATA,U,2)_" ("_$P(DATA,U,3)_")"
.S LN=LN+1
.D SET^VALM10(LN,TEXT)
;
Q
;
MGRP ;-- mail group members
;
N MEMBER,MEMBER1,NAME,NMARRY
;
S IEN=$O(^XMB(3.8,"B","KMP-CAPMAN",0)) Q:'IEN
;
S LN=LN+1
D SET^VALM10(LN,"")
;
S TEXT=" KMP-CAPMAN Mail Group......."
; check MEMBER field #2
S MEMBER=0
F S MEMBER=$O(^XMB(3.8,IEN,1,"B",MEMBER)) Q:'MEMBER D
.S NAME=$P($G(^VA(200,MEMBER,0)),U)
.I NAME'="" S NMARRY(NAME)=MEMBER
; remote members
S MEMBER="",MEMBER1=0
F S MEMBER=$O(^XMB(3.8,IEN,6,"B",MEMBER)) Q:MEMBER="" D
.S MEMBER1=0
.F S MEMBER1=$O(^XMB(3.8,IEN,6,"B",MEMBER,MEMBER1)) Q:'MEMBER1 D
..S NAME=$P($G(^XMB(3.8,IEN,6,MEMBER1,0)),U)
..I NAME'="" S NMARRY(NAME)=MEMBER
;
I '$D(NMARRY) S LN=LN+1 D SET^VALM10(LN,TEXT_" No Users") Q
;
S NAME=""
F S NAME=$O(NMARRY(NAME)) Q:NAME="" D
.S MEMBER=NMARRY(NAME)
.S TEXT=TEXT_$J(" ",32-$L(TEXT))_NAME
.; if not a remote user
.I NAME'["@" D
..S MEMBER=$$ACTIVE^XUSER(MEMBER) I '+MEMBER S TEXT=TEXT_" ("_$P(MEMBER,U,2)_")"
.S LN=LN+1
.D SET^VALM10(LN,TEXT)
.S TEXT=""
;
Q
;
ROUCHK(KMPDPKG) ;--display routine version info
;-----------------------------------------------------------------------
; KMPDPKG... CM Package:
; "D" - CM Tools
; "R" - RUM
; "S" - SAGG
;-----------------------------------------------------------------------
;
Q:$G(KMPDPKG)=""
Q:KMPDPKG'="D"&(KMPDPKG'="R")&(KMPDPKG'="S")
;
N I,TEXT,X
;
; routine check
D VERPTCH^KMPDUTL1(KMPDPKG,.X)
S LN=LN+1
D SET^VALM10(LN,"")
S LN=LN+1
D SET^VALM10(LN,"")
S TEXT=" "_$S(KMPDPKG="D":"CM TOOLS",KMPDPKG="R":"RUM",1:"SAGG")_" routines"
S TEXT=TEXT_$$REPEAT^XLFSTR(".",31-$L(TEXT))
I '$P($G(X(0)),U,3) S LN=LN+1 D SET^VALM10(LN,TEXT_" "_+X(0)_" Routines - No Problems") Q
S LN=LN+1
D SET^VALM10(LN,TEXT)
S LN=LN+1
D SET^VALM10(LN,$J(" ",20)_"Current Version"_$J(" ",20)_"Should be")
S I=0 F S I=$O(X(I)) Q:I="" I $P(X(I),U) D
.S TEXT=" "_I
.S TEXT=TEXT_$J(" ",20-$L(TEXT))_$P(X(I),U,4)
.S:$P(X(I),U,5)]"" TEXT=TEXT_" - "_$P(X(I),U,5)
.S TEXT=TEXT_$J(" ",55-$L(TEXT))_$P(X(I),U,2)
.S:$P(X(I),U,3)]"" TEXT=TEXT_" - "_$P(X(I),U,3)
.S LN=LN+1
.D SET^VALM10(LN,TEXT)
;
Q
;
PKG(KMPDNMSP) ;-- extrinsic function - return package name
;-----------------------------------------------------------------------------
; KMPDNMSP... H - HL7
; R - RUM
; S - SAGG
; T - Timing
;
; Return: Package name
; "" if not found
;-----------------------------------------------------------------------------
;
Q:$G(KMPDNMSP)="" ""
;
N IEN,NMSP
S NMSP="KMP"_$S(KMPDNMSP="H"!(KMPDNMSP="T"):"D",1:KMPDNMSP)
S IEN=$O(^DIC(9.4,"C",NMSP,0))
Q $S(IEN:$P($G(^DIC(9.4,+IEN,0)),U),1:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDSSD1 3351 printed Oct 16, 2024@17:41:33 Page 2
KMPDSSD1 ;OAK/RAK - CM Tools Status ;5/1/07 15:07
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
CPU ;-- cpu/node data
+1 ;
+2 NEW COUNT,DATA,I,LEN,TEXT
+3 ;
+4 DO CPUGET^KMPDUTL6(.DATA)
+5 if '$DATA(DATA)
QUIT
+6 SET LN=LN+1
+7 DO SET^VALM10(LN,"")
+8 SET TEXT=" Node/CPU Data............... "
+9 SET (COUNT,I,LEN)=0
+10 FOR
SET I=$ORDER(DATA(I))
if 'I
QUIT
Begin DoDot:1
+11 SET COUNT=COUNT+1
SET DATA=$GET(DATA(I,0))
if DATA=""
QUIT
+12 ; length of node name
+13 if 'LEN
SET LEN=$LENGTH($PIECE(DATA,U))+2
+14 SET TEXT=$SELECT(COUNT=1:TEXT,1:$JUSTIFY(" ",32))_$PIECE(DATA,U)
+15 SET TEXT=TEXT_$JUSTIFY(" ",32-$LENGTH(TEXT)+LEN)_$PIECE(DATA,U,2)_" ("_$PIECE(DATA,U,3)_")"
+16 SET LN=LN+1
+17 DO SET^VALM10(LN,TEXT)
End DoDot:1
+18 ;
+19 QUIT
+20 ;
MGRP ;-- mail group members
+1 ;
+2 NEW MEMBER,MEMBER1,NAME,NMARRY
+3 ;
+4 SET IEN=$ORDER(^XMB(3.8,"B","KMP-CAPMAN",0))
if 'IEN
QUIT
+5 ;
+6 SET LN=LN+1
+7 DO SET^VALM10(LN,"")
+8 ;
+9 SET TEXT=" KMP-CAPMAN Mail Group......."
+10 ; check MEMBER field #2
+11 SET MEMBER=0
+12 FOR
SET MEMBER=$ORDER(^XMB(3.8,IEN,1,"B",MEMBER))
if 'MEMBER
QUIT
Begin DoDot:1
+13 SET NAME=$PIECE($GET(^VA(200,MEMBER,0)),U)
+14 IF NAME'=""
SET NMARRY(NAME)=MEMBER
End DoDot:1
+15 ; remote members
+16 SET MEMBER=""
SET MEMBER1=0
+17 FOR
SET MEMBER=$ORDER(^XMB(3.8,IEN,6,"B",MEMBER))
if MEMBER=""
QUIT
Begin DoDot:1
+18 SET MEMBER1=0
+19 FOR
SET MEMBER1=$ORDER(^XMB(3.8,IEN,6,"B",MEMBER,MEMBER1))
if 'MEMBER1
QUIT
Begin DoDot:2
+20 SET NAME=$PIECE($GET(^XMB(3.8,IEN,6,MEMBER1,0)),U)
+21 IF NAME'=""
SET NMARRY(NAME)=MEMBER
End DoDot:2
End DoDot:1
+22 ;
+23 IF '$DATA(NMARRY)
SET LN=LN+1
DO SET^VALM10(LN,TEXT_" No Users")
QUIT
+24 ;
+25 SET NAME=""
+26 FOR
SET NAME=$ORDER(NMARRY(NAME))
if NAME=""
QUIT
Begin DoDot:1
+27 SET MEMBER=NMARRY(NAME)
+28 SET TEXT=TEXT_$JUSTIFY(" ",32-$LENGTH(TEXT))_NAME
+29 ; if not a remote user
+30 IF NAME'["@"
Begin DoDot:2
+31 SET MEMBER=$$ACTIVE^XUSER(MEMBER)
IF '+MEMBER
SET TEXT=TEXT_" ("_$PIECE(MEMBER,U,2)_")"
End DoDot:2
+32 SET LN=LN+1
+33 DO SET^VALM10(LN,TEXT)
+34 SET TEXT=""
End DoDot:1
+35 ;
+36 QUIT
+37 ;
ROUCHK(KMPDPKG) ;--display routine version info
+1 ;-----------------------------------------------------------------------
+2 ; KMPDPKG... CM Package:
+3 ; "D" - CM Tools
+4 ; "R" - RUM
+5 ; "S" - SAGG
+6 ;-----------------------------------------------------------------------
+7 ;
+8 if $GET(KMPDPKG)=""
QUIT
+9 if KMPDPKG'="D"&(KMPDPKG'="R")&(KMPDPKG'="S")
QUIT
+10 ;
+11 NEW I,TEXT,X
+12 ;
+13 ; routine check
+14 DO VERPTCH^KMPDUTL1(KMPDPKG,.X)
+15 SET LN=LN+1
+16 DO SET^VALM10(LN,"")
+17 SET LN=LN+1
+18 DO SET^VALM10(LN,"")
+19 SET TEXT=" "_$SELECT(KMPDPKG="D":"CM TOOLS",KMPDPKG="R":"RUM",1:"SAGG")_" routines"
+20 SET TEXT=TEXT_$$REPEAT^XLFSTR(".",31-$LENGTH(TEXT))
+21 IF '$PIECE($GET(X(0)),U,3)
SET LN=LN+1
DO SET^VALM10(LN,TEXT_" "_+X(0)_" Routines - No Problems")
QUIT
+22 SET LN=LN+1
+23 DO SET^VALM10(LN,TEXT)
+24 SET LN=LN+1
+25 DO SET^VALM10(LN,$JUSTIFY(" ",20)_"Current Version"_$JUSTIFY(" ",20)_"Should be")
+26 SET I=0
FOR
SET I=$ORDER(X(I))
if I=""
QUIT
IF $PIECE(X(I),U)
Begin DoDot:1
+27 SET TEXT=" "_I
+28 SET TEXT=TEXT_$JUSTIFY(" ",20-$LENGTH(TEXT))_$PIECE(X(I),U,4)
+29 if $PIECE(X(I),U,5)]""
SET TEXT=TEXT_" - "_$PIECE(X(I),U,5)
+30 SET TEXT=TEXT_$JUSTIFY(" ",55-$LENGTH(TEXT))_$PIECE(X(I),U,2)
+31 if $PIECE(X(I),U,3)]""
SET TEXT=TEXT_" - "_$PIECE(X(I),U,3)
+32 SET LN=LN+1
+33 DO SET^VALM10(LN,TEXT)
End DoDot:1
+34 ;
+35 QUIT
+36 ;
PKG(KMPDNMSP) ;-- extrinsic function - return package name
+1 ;-----------------------------------------------------------------------------
+2 ; KMPDNMSP... H - HL7
+3 ; R - RUM
+4 ; S - SAGG
+5 ; T - Timing
+6 ;
+7 ; Return: Package name
+8 ; "" if not found
+9 ;-----------------------------------------------------------------------------
+10 ;
+11 if $GET(KMPDNMSP)=""
QUIT ""
+12 ;
+13 NEW IEN,NMSP
+14 SET NMSP="KMP"_$SELECT(KMPDNMSP="H"!(KMPDNMSP="T"):"D",1:KMPDNMSP)
+15 SET IEN=$ORDER(^DIC(9.4,"C",NMSP,0))
+16 QUIT $SELECT(IEN:$PIECE($GET(^DIC(9.4,+IEN,0)),U),1:"")
