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

XPAREDT1.m

Go to the documentation of this file.
  1. XPAREDT1 ; SLC/KCM - Supporting Calls - Entities; [3/31/03 7:19am] ;9/12/07 16:19
  1. ;;7.3;TOOLKIT;**26,109**;Apr 25, 1995;Build 5
  1. ;
  1. BLDLST ; ...continued from BLDLST^XPAREDIT(LST,PAR)
  1. ; Build list of entities allowed for this parameter
  1. ; # is precedence, 'fixed' is VP to implied instance (i.e., SYS, PKG)
  1. ; .LST(#)=file number^message^order^prefix^fixed^lookup info
  1. ; ("M", message) = #
  1. ; ("P", prefix) = #
  1. ; PAR=ien^name
  1. N IEN,SEQ,FN,X K LST ; make sure LST is empty initially
  1. S SEQ=0,LST=0
  1. F S SEQ=$O(^XTV(8989.51,+PAR,30,"B",SEQ)) Q:'SEQ S IEN=$O(^(SEQ,0)) D
  1. . S FN=$P(^XTV(8989.51,+PAR,30,IEN,0),"^",2) I FN=9.4,(DUZ(0)'["@") Q
  1. . S X=^XTV(8989.518,FN,0),X=FN_U_$P(X,U,3)_U_U_$P(X,U,2)
  1. . S LST=LST+1,LST(SEQ)=X
  1. . S LST("M",$$UPPER($P(X,U,2)))=SEQ
  1. . S LST("P",$P(X,U,4))=SEQ
  1. . ; find IEN's where only one entity instance is possible
  1. . I FN=9.4 D ; find package to which this parameter belongs
  1. . . N PRN,PRE
  1. . . S PRN=$P($G(^XTV(8989.51,+PAR,0)),"^",1) Q:'$L(PRN)
  1. . . S PRE=PRN F S PRE=$O(^DIC(9.4,"C",PRE),-1) Q:'$L(PRE) Q:(PRE=$E(PRN,1,$L(PRE))) I '($E(PRE,1)=$E(PRN,1)) S PRE="" Q
  1. . . Q:'$L(PRE)
  1. . . S X=$O(^DIC(9.4,"C",PRE,0))
  1. . . S $P(LST(SEQ),U,5)=X_";DIC(9.4,"
  1. . . S $P(LST(SEQ),U,6)=$P(^DIC(9.4,X,0),"^",1)
  1. . I FN=4.2 D ; find domain for this system
  1. . . S X=$$KSP^XUPARAM("WHERE")
  1. . . S $P(LST(SEQ),U,5)=$$FIND1^DIC(4.2,"","QX",X)_";DIC(4.2,"
  1. . . S $P(LST(SEQ),U,6)=X
  1. . I FN=4 D ; find division if this site not multi-divisional
  1. . . S X=$$KSP^XUPARAM("INST")
  1. . . I $P($G(^DIC(4,X,"DIV")),U,1)'="Y" D
  1. . . . S $P(LST(SEQ),U,5)=X_";DIC(4,"
  1. . . . S $P(LST(SEQ),U,6)=$P(^DIC(4,X,0),"^",1)
  1. . I '$L($P(LST(SEQ),U,5)) D ; otherwise...
  1. . . S $P(LST(SEQ),U,6)=$P($G(^DIC(FN,0)),"^",1)
  1. Q
  1. GETCLS ; ...continued from GETCLS^XPAREDIT(X,PAR,LST)
  1. ; Choose the class of entity
  1. ; optionally, lookup entity using variable pointer syntax (PRE.NAME)
  1. ; .X=returns seq # or entity in VP format
  1. ; PAR=ien^name for parameter
  1. ; .LST=list from which the entity is selected
  1. N TMP,DONE
  1. D SHWCLS
  1. S DONE=0 F D Q:DONE
  1. . W !,"Enter selection: " R X:DTIME S:'$T X="^" S X=$$UPPER(X)
  1. . I '$L(X)!(X="^")!(X="^^") S ENT="",DONE=1 Q
  1. . I $E(X)="?" D HLPCLS I $E(X,1,2)="??" D SHWCLS ; help requested
  1. . I X=" " S X=$G(^DISV(DUZ,"XPAR01",+PAR)) Q:'X ; spacebar recall
  1. . I +X,$D(LST(X)) S DONE=1 Q ; # -> seq #
  1. . I $D(LST("P",X)) S X=LST("P",X),DONE=1 Q ; PRE -> seq #
  1. . I $D(LST("M",X)) S X=LST("M",X),DONE=1 Q ; NAME -> seq #
  1. . S TMP=$O(LST("M",X))
  1. . I $E(TMP,1,$L(X))=X S X=LST("M",TMP),DONE=1 Q ; PARTIAL -> seq #
  1. . I $L(X,".")>1,$D(LST("P",$P(X,".",1))) D Q:DONE ; if VP syntax
  1. . . S TMP=$P(X,".",2)
  1. . . D LOOKUP^XPAREDIT(.TMP,+LST(LST("P",$P(X,".",1)))) ; silent lookup
  1. . . I $L(TMP) S X=TMP,DONE=1 ; PRE.NAME -> VP
  1. . W " ??" D HLPCLS ; invalid entry
  1. I +X,X'[";" D ;Don't show for resoved pointer p109
  1. . W " ",$P(LST(X),U,2)," ",$P(LST(X),U,6) ; echo selection
  1. . I +LST(X)=9.4 D
  1. . . W !!,"Parameters set for 'Package' may be replaced if "
  1. . . W $P(LST(X),U,6),!,"is installed in this account."
  1. . S ^DISV(DUZ,"XPAR01",+PAR)=X
  1. Q
  1. SHWCLS ; procedure used only by GETCLS
  1. ; show entity classes appropriate for this parameter
  1. N I,X
  1. W !!,$P(PAR,"^",2)," may be set for the following:",!!
  1. S I=0 F S I=$O(LST(I)) Q:'I S X=LST(I) D
  1. . W ?5,I,?9,$P(X,"^",2),?23,$P(X,U,4),?30
  1. . I $L($P(X,U,5)) W "["_$P(X,U,6)_"]",!
  1. . I '$L($P(X,U,5)) W "[choose from "_$P(X,U,6)_"]",!
  1. Q
  1. HLPCLS ; procedure used only by GETCLS
  1. ; display help for entity class selection
  1. W !,"Enter the number, name, or abbreviation of the selection."
  1. W !,"You may also use variable pointer syntax (Example: LOC.WEST2)."
  1. Q
  1. UPPER(X) ; function - convert lower to upper case
  1. Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")