KMPDU5 ;OAK/RAK - CM Tools Utilities ;8/25/04 08:56
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
FILEINQ(KMPDY,KMPDFN,KMPDIEN,KMPDGBL) ;-- file inquiry.
;-----------------------------------------------------------------------
; KMPDFN.... File number.
; KMPDIEN... Ien for above file.
; KMPDGBL... Global where data is stored.
;-----------------------------------------------------------------------
;
K KMPDY
;
I '$G(KMPDFN) S KMPDY="[File Number not defined]" Q
I '$D(^DD(KMPDFN)) S KMPDY="[File #"_KMPDFN_" is not defined]" Q
;
I '$G(KMPDIEN) S KMPDY="[IEN not defined]" Q
;
I KMPDGBL="" S KMPDY="[Global for storage is not defined]" Q
;
N ARRAY,CNT,DATA,ERROR,FIELD,FILE,I,IEN,LN,TITLE
;
; kill global with check for ^tmp or ^utility.
D KILL^KMPDU(.DATA,KMPDGBL)
; if error.
I $E(DATA)="[" S KMPDY=DATA Q
;
S ARRAY=$NA(^TMP("KMPD FILE INQ",$J))
K @ARRAY
;
S FIELD="**"
I KMPDFN=9.4 S FIELD="" D
.F I=0:0 S I=$O(^DD(KMPDFN,I)) Q:'I D
..I $P($G(^DD(KMPDFN,I,0)),U,2)'["C"&($P($G(^(0)),U,2)'["M")&($E($G(^(0)))'="*")&($P($G(^(0)),U,3)'="") S FIELD=FIELD_I_";"
.S FIELD=FIELD_"3;" ;4;5;"
;
D GETS^DIQ(KMPDFN,KMPDIEN,FIELD,"R",ARRAY,"ERROR")
;
I $D(ERROR) S KMPDY="[Error occurred while getting info.]" Q
;
I '$D(@ARRAY) S KMPDY="<No Data to Report>" Q
;
S FILE="",LN=0
F S FILE=$O(@ARRAY@(FILE)) Q:FILE="" D
.S IEN=""
.F S IEN=$O(@ARRAY@(FILE,IEN)) Q:IEN="" D
..S FIELD=""
..F S FIELD=$O(@ARRAY@(FILE,IEN,FIELD)) Q:FIELD="" D
...; if not a multiple.
...I '$O(@ARRAY@(FILE,IEN,FIELD,0)) D Q
....S @KMPDGBL@(LN)=FIELD,@KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(".",30-$L(@KMPDGBL@(LN)))
....S @KMPDGBL@(LN)=@KMPDGBL@(LN)_": "_@ARRAY@(FILE,IEN,FIELD)
....S LN=LN+1
...;
...; if multiple
...S @KMPDGBL@(LN)=FIELD
...S @KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(".",30-$L(@KMPDGBL@(LN)))
...S @KMPDGBL@(LN)=@KMPDGBL@(LN)_": "
...;S LN=LN+1
...S CNT=1
...F I=0:0 S I=$O(@ARRAY@(FILE,IEN,FIELD,I)) Q:'I D
....;S @KMPDGBL@(LN)=FIELD,@KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(" ",30-$L(@KMPDGBL@(LN)))
....I CNT=1 S @KMPDGBL@(LN)=$G(@KMPDGBL@(LN))_@ARRAY@(FILE,IEN,FIELD,I)
....E D
.....S @KMPDGBL@(LN)=$G(@KMPDGBL@(LN))_$$REPEAT^XLFSTR(" ",30-$L($G(@KMPDGBL@(LN))))
.....S @KMPDGBL@(LN)=@KMPDGBL@(LN)_" "_@ARRAY@(FILE,IEN,FIELD,I)
....S LN=LN+1,CNT=CNT+1
;
S KMPDY=$NA(@KMPDGBL)
S:'$D(@KMPDGBL) KMPDY="<No Data To Report>"
;
Q
;
FILESRC(KMPDY,KMPDFN,KMPDFLD,KMPDSRC,KMPDGBL) ;-- file search.
;-----------------------------------------------------------------------
; KMPDFN... File Number.
; KMPDFLD.. Fields to be returned, seperated by commas.
; Example: ".01,.04,1" would return fields .01, .04 and 1.
; KMPDSRC.. (optional). Search text. This will search the .01 field for
; a match. If KMPDSRC="*" or is null then all entries will be
; returned.
; KMPDGBL... Global where data is stored.
;-----------------------------------------------------------------------
;
K KMPDY
;
S KMPDFN=+$G(KMPDFN),KMPDFLD=$G(KMPDFLD)
S KMPDSRC=$$UP^XLFSTR($G(KMPDSRC)),KMPDGBL=$G(KMPDGBL)
;
I 'KMPDFN S KMPDY="[File Number not defined]" Q
;
I KMPDFLD="" S KMPDY="[No fields have been requested]" Q
;
I KMPDGBL="" S KMPDY="[Global for storage is not defined]" Q
;
N DATA,GLOBAL,I,IEN,LN,NAME,NODE,PIECE
;
; kill global with check for ^tmp or ^utility.
D KILL^KMPDU(.DATA,KMPDGBL)
; if error.
I $E(DATA)="[" S KMPDY=DATA Q
;
S GLOBAL=$G(^DIC(KMPDFN,0,"GL"))
I GLOBAL="" S KMPDY="[File #"_KMPDFN_" is not defined]" Q
; make sure global name is closed () for use with subscript indirection.
S:$E(GLOBAL,$L(GLOBAL))="," $E(GLOBAL,$L(GLOBAL))=")"
;
; set zero node to field titles.
S $P(@KMPDGBL@(0),U)="IEN"
F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA="" D
.; try title first.
.S TITLE=$G(^DD(KMPDFN,DATA,.1))
.; if no title use name.
.S:TITLE="" TITLE=$P($G(^DD(KMPDFN,DATA,0)),U)
.S $P(@KMPDGBL@(0),U,(I+1))=TITLE
;
S:KMPDSRC="*" KMPDSRC=""
; remove '*' if last character
S:$E($RE(KMPDSRC))="*" $E(KMPDSRC,$L(KMPDSRC))=""
S LN=1,NAME=KMPDSRC
; if exact match.
I NAME]"" S IEN=$O(@GLOBAL@("B",NAME,0)) I IEN D
.Q:'$D(@GLOBAL@(IEN,0)) S DATA=^(0)
.; ien.
.S $P(@KMPDGBL@(LN),U)=IEN
.; user defined data.
.F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA="" D
..S $P(@KMPDGBL@(LN),U,(I+1))=$$GET1^DIQ(KMPDFN,IEN,DATA)
.S LN=LN+1
;
F S NAME=$O(@GLOBAL@("B",NAME)) Q:NAME=""!($E(NAME,1,$L(KMPDSRC))'=KMPDSRC) D
.F IEN=0:0 S IEN=$O(@GLOBAL@("B",NAME,IEN)) Q:'IEN D
..Q:'$D(@GLOBAL@(IEN,0)) S DATA=^(0)
..; ien.
..S $P(@KMPDGBL@(LN),U)=IEN
..; user defined data.
..F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA="" D
...S $P(@KMPDGBL@(LN),U,(I+1))=$$GET1^DIQ(KMPDFN,IEN,DATA)
..S LN=LN+1
;
S KMPDY=$NA(@KMPDGBL)
S:'$O(@KMPDGBL@(0)) @KMPDGBL@(1)="<No Data To Report>"
;
Q
;
ENV(KMPDRES) ;-- get uci/volume set
;-----------------------------------------------------------------------
; KMPDRES(0)="uci,volumeset"
; KMPDRES(1)="facilityinfo" as returned by $$SITE^VASITE
;-----------------------------------------------------------------------
;
K KMPDRES
N Y X ^%ZOSF("UCI")
S KMPDRES(0)=Y
S KMPDRES(1)=$$SITE^VASITE
;
Q
;
VERSION(KMPDY) ;-- version^patch info
; cm tools version^patch
S KMPDY(0)=$P($G(^KMPD(8973,1,0)),U,2)
; operating system version
S KMPDY(1)=$P($G(^%ZOSF("OS")),U) ;$ZV
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDU5 5524 printed Jun 11, 2024@21:26:13 Page 2
KMPDU5 ;OAK/RAK - CM Tools Utilities ;8/25/04 08:56
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
FILEINQ(KMPDY,KMPDFN,KMPDIEN,KMPDGBL) ;-- file inquiry.
+1 ;-----------------------------------------------------------------------
+2 ; KMPDFN.... File number.
+3 ; KMPDIEN... Ien for above file.
+4 ; KMPDGBL... Global where data is stored.
+5 ;-----------------------------------------------------------------------
+6 ;
+7 KILL KMPDY
+8 ;
+9 IF '$GET(KMPDFN)
SET KMPDY="[File Number not defined]"
QUIT
+10 IF '$DATA(^DD(KMPDFN))
SET KMPDY="[File #"_KMPDFN_" is not defined]"
QUIT
+11 ;
+12 IF '$GET(KMPDIEN)
SET KMPDY="[IEN not defined]"
QUIT
+13 ;
+14 IF KMPDGBL=""
SET KMPDY="[Global for storage is not defined]"
QUIT
+15 ;
+16 NEW ARRAY,CNT,DATA,ERROR,FIELD,FILE,I,IEN,LN,TITLE
+17 ;
+18 ; kill global with check for ^tmp or ^utility.
+19 DO KILL^KMPDU(.DATA,KMPDGBL)
+20 ; if error.
+21 IF $EXTRACT(DATA)="["
SET KMPDY=DATA
QUIT
+22 ;
+23 SET ARRAY=$NAME(^TMP("KMPD FILE INQ",$JOB))
+24 KILL @ARRAY
+25 ;
+26 SET FIELD="**"
+27 IF KMPDFN=9.4
SET FIELD=""
Begin DoDot:1
+28 FOR I=0:0
SET I=$ORDER(^DD(KMPDFN,I))
if 'I
QUIT
Begin DoDot:2
+29 IF $PIECE($GET(^DD(KMPDFN,I,0)),U,2)'["C"&($PIECE($GET(^(0)),U,2)'["M")&($EXTRACT($GET(^(0)))'="*")&($PIECE($GET(^(0)),U,3)'="")
SET FIELD=FIELD_I_";"
End DoDot:2
+30 ;4;5;"
SET FIELD=FIELD_"3;"
End DoDot:1
+31 ;
+32 DO GETS^DIQ(KMPDFN,KMPDIEN,FIELD,"R",ARRAY,"ERROR")
+33 ;
+34 IF $DATA(ERROR)
SET KMPDY="[Error occurred while getting info.]"
QUIT
+35 ;
+36 IF '$DATA(@ARRAY)
SET KMPDY="<No Data to Report>"
QUIT
+37 ;
+38 SET FILE=""
SET LN=0
+39 FOR
SET FILE=$ORDER(@ARRAY@(FILE))
if FILE=""
QUIT
Begin DoDot:1
+40 SET IEN=""
+41 FOR
SET IEN=$ORDER(@ARRAY@(FILE,IEN))
if IEN=""
QUIT
Begin DoDot:2
+42 SET FIELD=""
+43 FOR
SET FIELD=$ORDER(@ARRAY@(FILE,IEN,FIELD))
if FIELD=""
QUIT
Begin DoDot:3
+44 ; if not a multiple.
+45 IF '$ORDER(@ARRAY@(FILE,IEN,FIELD,0))
Begin DoDot:4
+46 SET @KMPDGBL@(LN)=FIELD
SET @KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(".",30-$LENGTH(@KMPDGBL@(LN)))
+47 SET @KMPDGBL@(LN)=@KMPDGBL@(LN)_": "_@ARRAY@(FILE,IEN,FIELD)
+48 SET LN=LN+1
End DoDot:4
QUIT
+49 ;
+50 ; if multiple
+51 SET @KMPDGBL@(LN)=FIELD
+52 SET @KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(".",30-$LENGTH(@KMPDGBL@(LN)))
+53 SET @KMPDGBL@(LN)=@KMPDGBL@(LN)_": "
+54 ;S LN=LN+1
+55 SET CNT=1
+56 FOR I=0:0
SET I=$ORDER(@ARRAY@(FILE,IEN,FIELD,I))
if 'I
QUIT
Begin DoDot:4
+57 ;S @KMPDGBL@(LN)=FIELD,@KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(" ",30-$L(@KMPDGBL@(LN)))
+58 IF CNT=1
SET @KMPDGBL@(LN)=$GET(@KMPDGBL@(LN))_@ARRAY@(FILE,IEN,FIELD,I)
+59 IF '$TEST
Begin DoDot:5
+60 SET @KMPDGBL@(LN)=$GET(@KMPDGBL@(LN))_$$REPEAT^XLFSTR(" ",30-$LENGTH($GET(@KMPDGBL@(LN))))
+61 SET @KMPDGBL@(LN)=@KMPDGBL@(LN)_" "_@ARRAY@(FILE,IEN,FIELD,I)
End DoDot:5
+62 SET LN=LN+1
SET CNT=CNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+63 ;
+64 SET KMPDY=$NAME(@KMPDGBL)
+65 if '$DATA(@KMPDGBL)
SET KMPDY="<No Data To Report>"
+66 ;
+67 QUIT
+68 ;
FILESRC(KMPDY,KMPDFN,KMPDFLD,KMPDSRC,KMPDGBL) ;-- file search.
+1 ;-----------------------------------------------------------------------
+2 ; KMPDFN... File Number.
+3 ; KMPDFLD.. Fields to be returned, seperated by commas.
+4 ; Example: ".01,.04,1" would return fields .01, .04 and 1.
+5 ; KMPDSRC.. (optional). Search text. This will search the .01 field for
+6 ; a match. If KMPDSRC="*" or is null then all entries will be
+7 ; returned.
+8 ; KMPDGBL... Global where data is stored.
+9 ;-----------------------------------------------------------------------
+10 ;
+11 KILL KMPDY
+12 ;
+13 SET KMPDFN=+$GET(KMPDFN)
SET KMPDFLD=$GET(KMPDFLD)
+14 SET KMPDSRC=$$UP^XLFSTR($GET(KMPDSRC))
SET KMPDGBL=$GET(KMPDGBL)
+15 ;
+16 IF 'KMPDFN
SET KMPDY="[File Number not defined]"
QUIT
+17 ;
+18 IF KMPDFLD=""
SET KMPDY="[No fields have been requested]"
QUIT
+19 ;
+20 IF KMPDGBL=""
SET KMPDY="[Global for storage is not defined]"
QUIT
+21 ;
+22 NEW DATA,GLOBAL,I,IEN,LN,NAME,NODE,PIECE
+23 ;
+24 ; kill global with check for ^tmp or ^utility.
+25 DO KILL^KMPDU(.DATA,KMPDGBL)
+26 ; if error.
+27 IF $EXTRACT(DATA)="["
SET KMPDY=DATA
QUIT
+28 ;
+29 SET GLOBAL=$GET(^DIC(KMPDFN,0,"GL"))
+30 IF GLOBAL=""
SET KMPDY="[File #"_KMPDFN_" is not defined]"
QUIT
+31 ; make sure global name is closed () for use with subscript indirection.
+32 if $EXTRACT(GLOBAL,$LENGTH(GLOBAL))=","
SET $EXTRACT(GLOBAL,$LENGTH(GLOBAL))=")"
+33 ;
+34 ; set zero node to field titles.
+35 SET $PIECE(@KMPDGBL@(0),U)="IEN"
+36 FOR I=1:1
SET DATA=$PIECE(KMPDFLD,",",I)
if DATA=""
QUIT
Begin DoDot:1
+37 ; try title first.
+38 SET TITLE=$GET(^DD(KMPDFN,DATA,.1))
+39 ; if no title use name.
+40 if TITLE=""
SET TITLE=$PIECE($GET(^DD(KMPDFN,DATA,0)),U)
+41 SET $PIECE(@KMPDGBL@(0),U,(I+1))=TITLE
End DoDot:1
+42 ;
+43 if KMPDSRC="*"
SET KMPDSRC=""
+44 ; remove '*' if last character
+45 if $EXTRACT($REVERSE(KMPDSRC))="*"
SET $EXTRACT(KMPDSRC,$LENGTH(KMPDSRC))=""
+46 SET LN=1
SET NAME=KMPDSRC
+47 ; if exact match.
+48 IF NAME]""
SET IEN=$ORDER(@GLOBAL@("B",NAME,0))
IF IEN
Begin DoDot:1
+49 if '$DATA(@GLOBAL@(IEN,0))
QUIT
SET DATA=^(0)
+50 ; ien.
+51 SET $PIECE(@KMPDGBL@(LN),U)=IEN
+52 ; user defined data.
+53 FOR I=1:1
SET DATA=$PIECE(KMPDFLD,",",I)
if DATA=""
QUIT
Begin DoDot:2
+54 SET $PIECE(@KMPDGBL@(LN),U,(I+1))=$$GET1^DIQ(KMPDFN,IEN,DATA)
End DoDot:2
+55 SET LN=LN+1
End DoDot:1
+56 ;
+57 FOR
SET NAME=$ORDER(@GLOBAL@("B",NAME))
if NAME=""!($EXTRACT(NAME,1,$LENGTH(KMPDSRC))'=KMPDSRC)
QUIT
Begin DoDot:1
+58 FOR IEN=0:0
SET IEN=$ORDER(@GLOBAL@("B",NAME,IEN))
if 'IEN
QUIT
Begin DoDot:2
+59 if '$DATA(@GLOBAL@(IEN,0))
QUIT
SET DATA=^(0)
+60 ; ien.
+61 SET $PIECE(@KMPDGBL@(LN),U)=IEN
+62 ; user defined data.
+63 FOR I=1:1
SET DATA=$PIECE(KMPDFLD,",",I)
if DATA=""
QUIT
Begin DoDot:3
+64 SET $PIECE(@KMPDGBL@(LN),U,(I+1))=$$GET1^DIQ(KMPDFN,IEN,DATA)
End DoDot:3
+65 SET LN=LN+1
End DoDot:2
End DoDot:1
+66 ;
+67 SET KMPDY=$NAME(@KMPDGBL)
+68 if '$ORDER(@KMPDGBL@(0))
SET @KMPDGBL@(1)="<No Data To Report>"
+69 ;
+70 QUIT
+71 ;
ENV(KMPDRES) ;-- get uci/volume set
+1 ;-----------------------------------------------------------------------
+2 ; KMPDRES(0)="uci,volumeset"
+3 ; KMPDRES(1)="facilityinfo" as returned by $$SITE^VASITE
+4 ;-----------------------------------------------------------------------
+5 ;
+6 KILL KMPDRES
+7 NEW Y
XECUTE ^%ZOSF("UCI")
+8 SET KMPDRES(0)=Y
+9 SET KMPDRES(1)=$$SITE^VASITE
+10 ;
+11 QUIT
+12 ;
VERSION(KMPDY) ;-- version^patch info
+1 ; cm tools version^patch
+2 SET KMPDY(0)=$PIECE($GET(^KMPD(8973,1,0)),U,2)
+3 ; operating system version
+4 ;$ZV
SET KMPDY(1)=$PIECE($GET(^%ZOSF("OS")),U)
+5 ;
+6 QUIT
