Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KMPDU5

KMPDU5.m

Go to the documentation of this file. 
  1. KMPDU5 ;OAK/RAK - CM Tools Utilities ;8/25/04  08:56
  1.  ;;3.0;KMPD;;Jan 22, 2009;Build 42
  1.  ;
  1. FILEINQ(KMPDY,KMPDFN,KMPDIEN,KMPDGBL) ;-- file inquiry.
  1.  ;-----------------------------------------------------------------------
  1.  ; KMPDFN.... File number.
  1.  ; KMPDIEN... Ien for above file.
  1.  ; KMPDGBL... Global where data is stored.
  1.  ;-----------------------------------------------------------------------
  1.  ;
  1.  K KMPDY
  1.  ;
  1.  I '$G(KMPDFN) S KMPDY="[File Number not defined]" Q
  1.  I '$D(^DD(KMPDFN)) S KMPDY="[File #"_KMPDFN_" is not defined]" Q
  1.  ;
  1.  I '$G(KMPDIEN) S KMPDY="[IEN not defined]" Q
  1.  ;
  1.  I KMPDGBL="" S KMPDY="[Global for storage is not defined]" Q
  1.  ;
  1.  N ARRAY,CNT,DATA,ERROR,FIELD,FILE,I,IEN,LN,TITLE
  1.  ;
  1.  ; kill global with check for ^tmp or ^utility.
  1.  D KILL^KMPDU(.DATA,KMPDGBL)
  1.  ; if error.
  1.  I $E(DATA)="[" S KMPDY=DATA Q
  1.  ;
  1.  S ARRAY=$NA(^TMP("KMPD FILE INQ",$J))
  1.  K @ARRAY
  1.  ;
  1.  S FIELD="**"
  1.  I KMPDFN=9.4 S FIELD="" D 
  1.  .F I=0:0 S I=$O(^DD(KMPDFN,I)) Q:'I  D 
  1.  ..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_";"
  1.  .S FIELD=FIELD_"3;" ;4;5;"
  1.  ;
  1.  D GETS^DIQ(KMPDFN,KMPDIEN,FIELD,"R",ARRAY,"ERROR")
  1.  ;
  1.  I $D(ERROR) S KMPDY="[Error occurred while getting info.]" Q
  1.  ;
  1.  I '$D(@ARRAY) S KMPDY="<No Data to Report>" Q
  1.  ;
  1.  S FILE="",LN=0
  1.  F  S FILE=$O(@ARRAY@(FILE)) Q:FILE=""  D 
  1.  .S IEN=""
  1.  .F  S IEN=$O(@ARRAY@(FILE,IEN)) Q:IEN=""  D 
  1.  ..S FIELD=""
  1.  ..F  S FIELD=$O(@ARRAY@(FILE,IEN,FIELD)) Q:FIELD=""  D 
  1.  ...; if not a multiple.
  1.  ...I '$O(@ARRAY@(FILE,IEN,FIELD,0)) D  Q
  1.  ....S @KMPDGBL@(LN)=FIELD,@KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(".",30-$L(@KMPDGBL@(LN)))
  1.  ....S @KMPDGBL@(LN)=@KMPDGBL@(LN)_": "_@ARRAY@(FILE,IEN,FIELD)
  1.  ....S LN=LN+1
  1.  ...;
  1.  ...; if multiple
  1.  ...S @KMPDGBL@(LN)=FIELD
  1.  ...S @KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(".",30-$L(@KMPDGBL@(LN)))
  1.  ...S @KMPDGBL@(LN)=@KMPDGBL@(LN)_": "
  1.  ...;S LN=LN+1
  1.  ...S CNT=1
  1.  ...F I=0:0 S I=$O(@ARRAY@(FILE,IEN,FIELD,I)) Q:'I  D 
  1.  ....;S @KMPDGBL@(LN)=FIELD,@KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(" ",30-$L(@KMPDGBL@(LN)))
  1.  ....I CNT=1 S @KMPDGBL@(LN)=$G(@KMPDGBL@(LN))_@ARRAY@(FILE,IEN,FIELD,I)
  1.  ....E  D 
  1.  .....S @KMPDGBL@(LN)=$G(@KMPDGBL@(LN))_$$REPEAT^XLFSTR(" ",30-$L($G(@KMPDGBL@(LN))))
  1.  .....S @KMPDGBL@(LN)=@KMPDGBL@(LN)_"  "_@ARRAY@(FILE,IEN,FIELD,I)
  1.  ....S LN=LN+1,CNT=CNT+1
  1.  ;
  1.  S KMPDY=$NA(@KMPDGBL)
  1.  S:'$D(@KMPDGBL) KMPDY="<No Data To Report>"
  1.  ;
  1.  Q
  1.  ;
  1. FILESRC(KMPDY,KMPDFN,KMPDFLD,KMPDSRC,KMPDGBL) ;-- file search.
  1.  ;-----------------------------------------------------------------------
  1.  ; KMPDFN... File Number.
  1.  ; KMPDFLD.. Fields to be returned, seperated by commas.
  1.  ;           Example: ".01,.04,1" would return fields .01, .04 and 1.
  1.  ; KMPDSRC.. (optional). Search text.  This will search the .01 field for
  1.  ;           a match.  If KMPDSRC="*" or is null then all entries will be
  1.  ;           returned.
  1.  ; KMPDGBL... Global where data is stored.
  1.  ;-----------------------------------------------------------------------
  1.  ;
  1.  K KMPDY
  1.  ;
  1.  S KMPDFN=+$G(KMPDFN),KMPDFLD=$G(KMPDFLD)
  1.  S KMPDSRC=$$UP^XLFSTR($G(KMPDSRC)),KMPDGBL=$G(KMPDGBL)
  1.  ;
  1.  I 'KMPDFN S KMPDY="[File Number not defined]" Q
  1.  ;
  1.  I KMPDFLD="" S KMPDY="[No fields have been requested]" Q
  1.  ;
  1.  I KMPDGBL="" S KMPDY="[Global for storage is not defined]" Q
  1.  ;
  1.  N DATA,GLOBAL,I,IEN,LN,NAME,NODE,PIECE
  1.  ;
  1.  ; kill global with check for ^tmp or ^utility.
  1.  D KILL^KMPDU(.DATA,KMPDGBL)
  1.  ; if error.
  1.  I $E(DATA)="[" S KMPDY=DATA Q
  1.  ;
  1.  S GLOBAL=$G(^DIC(KMPDFN,0,"GL"))
  1.  I GLOBAL="" S KMPDY="[File #"_KMPDFN_" is not defined]" Q
  1.  ; make sure global name is closed () for use with subscript indirection.
  1.  S:$E(GLOBAL,$L(GLOBAL))="," $E(GLOBAL,$L(GLOBAL))=")"
  1.  ;
  1.  ; set zero node to field titles.
  1.  S $P(@KMPDGBL@(0),U)="IEN"
  1.  F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA=""  D 
  1.  .; try title first.
  1.  .S TITLE=$G(^DD(KMPDFN,DATA,.1))
  1.  .; if no title use name.
  1.  .S:TITLE="" TITLE=$P($G(^DD(KMPDFN,DATA,0)),U)
  1.  .S $P(@KMPDGBL@(0),U,(I+1))=TITLE
  1.  ;
  1.  S:KMPDSRC="*" KMPDSRC=""
  1.  ; remove '*' if last character
  1.  S:$E($RE(KMPDSRC))="*" $E(KMPDSRC,$L(KMPDSRC))=""
  1.  S LN=1,NAME=KMPDSRC
  1.  ; if exact match.
  1.  I NAME]"" S IEN=$O(@GLOBAL@("B",NAME,0)) I IEN D 
  1.  .Q:'$D(@GLOBAL@(IEN,0))  S DATA=^(0)
  1.  .; ien.
  1.  .S $P(@KMPDGBL@(LN),U)=IEN
  1.  .; user defined data.
  1.  .F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA=""  D 
  1.  ..S $P(@KMPDGBL@(LN),U,(I+1))=$$GET1^DIQ(KMPDFN,IEN,DATA)
  1.  .S LN=LN+1
  1.  ;
  1.  F  S NAME=$O(@GLOBAL@("B",NAME)) Q:NAME=""!($E(NAME,1,$L(KMPDSRC))'=KMPDSRC)  D 
  1.  .F IEN=0:0 S IEN=$O(@GLOBAL@("B",NAME,IEN)) Q:'IEN  D 
  1.  ..Q:'$D(@GLOBAL@(IEN,0))  S DATA=^(0)
  1.  ..; ien.
  1.  ..S $P(@KMPDGBL@(LN),U)=IEN
  1.  ..; user defined data.
  1.  ..F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA=""  D 
  1.  ...S $P(@KMPDGBL@(LN),U,(I+1))=$$GET1^DIQ(KMPDFN,IEN,DATA)
  1.  ..S LN=LN+1
  1.  ;
  1.  S KMPDY=$NA(@KMPDGBL)
  1.  S:'$O(@KMPDGBL@(0)) @KMPDGBL@(1)="<No Data To Report>"
  1.  ;
  1.  Q
  1.  ;
  1. ENV(KMPDRES) ;-- get uci/volume set
  1.  ;-----------------------------------------------------------------------
  1.  ; KMPDRES(0)="uci,volumeset"
  1.  ; KMPDRES(1)="facilityinfo" as returned by $$SITE^VASITE
  1.  ;-----------------------------------------------------------------------
  1.  ;
  1.  K KMPDRES
  1.  N Y X ^%ZOSF("UCI")
  1.  S KMPDRES(0)=Y
  1.  S KMPDRES(1)=$$SITE^VASITE
  1.  ;
  1.  Q
  1.  ;
  1. VERSION(KMPDY) ;-- version^patch info
  1.  ; cm tools version^patch
  1.  S KMPDY(0)=$P($G(^KMPD(8973,1,0)),U,2)
  1.  ; operating system version
  1.  S KMPDY(1)=$P($G(^%ZOSF("OS")),U)  ;$ZV
  1.  ;
  1.  Q