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

GMTSULT2.m

Go to the documentation of this file. 
  1. GMTSULT2 ; SLC/KER - HS Type Lookup (Search/List)   ; 08/27/2002
  1.  ;;2.7;Health Summary;**30,32,35,29,56**;Oct 20, 1995
  1.  ;
  1.  ; External Reference
  1.  ;   DBIA 10016  ^DIM
  1.  ;                   
  1.  Q
  1. LIST(X) ; Get global array of Health Summary Types
  1.  ;                      
  1.  ;  LIST^GMTSULT2(<search string>)
  1.  ;                      
  1.  ;  ^TMP("GMTSULT",$J,#)
  1.  ;                    
  1.  ;     Piece 1 =  Internal Entry Number (IEN) in file 142
  1.  ;     Piece 2 =  Health Summary Type Name
  1.  ;     Piece 3 =  Health Summary Type Title
  1.  ;     Piece 4 =  Health Summary Type Owner
  1.  ;     Piece 5 =  Location Using Health Summary Type
  1.  ;     Piece 6 =  Number of Components in Summary Type
  1.  ;     Piece 7 =  Recommended Display Text (for 
  1.  ;                selection or list box)
  1.  ;                      
  1.  ;  List Builder can use variable DIC("S") and DIC(0)
  1.  ;                      
  1.  ;     DIC("S") Screen out entries for selection/list
  1.  ;                      
  1.  ;     Processes DIC(0) N, OE (combination),X or B
  1.  ;                      
  1.  ;     Does not process DIC(0) components C or M.  Cross
  1.  ;     reference suppression (C) is automatic in a multi-
  1.  ;     term lookup, and the use of multiple indexes is
  1.  ;     implied in the lookup and DD file structure.
  1.  ;                      
  1.  D CLR^GMTSULT N GMTSEO,GMTSEQ,GMTSIF,GMTSBI,GMTSIEN,GMTSWRDS,GMTSDS,GMTSD0
  1.  S GMTSEO=+($$EMO),GMTSEQ=+($$EMQ),GMTSIF=+($$IF($G(X))),GMTSBI=+($$BI)
  1.  S:$L($G(DIC("S")))&('$L($G(GMTSDICS))) GMTSDICS=$G(DIC("S")),GMTSDS=1
  1.  S:$L($G(DIC(0)))&('$L($G(GMTSDIC0))) GMTSDIC0=$G(DIC(0)),GMTSD0=1
  1.  I GMTSIF S GMTSIEN=$$IENF(X) I +GMTSIEN>0 D IENS(GMTSIEN) G:$D(^TMP("GMTSULT",$J,1)) LQ
  1.  I GMTSBI D B^GMTSULT7 G LQ
  1.  D PAR,FND,REO^GMTSULT3
  1.  Q
  1. LQ ; Quit List
  1.  K:+($G(GMTSDS))>0 GMTSDICS K:+($G(GMTSD0))>0 GMTSDIC0
  1.  Q
  1.  ;                      
  1. FND ; Find Health Summary Types (word search)
  1.  N GMTSB,GMTSC,GMTSCTL,GMTSFND,GMTSI,GMTSI1,GMTSI2,GMTSI3,GMTSDS,GMTSD0,GMTSLEX,GMTSLEXM,GMTSASM,GMTSCMP,GMTSLOC,GMTSNAM,GMTSOK,GMTSRC,GMTSOW,GMTSTMP,GMTSTTL,GMTSWDS,GMTSRD,GMTSWRD,Y
  1.  ;   Echo             E or broker
  1.  S GMTSTMP=+($G(GMTSE)),GMTSIF=0 S:'$D(GMTSE) GMTSTMP=$$ECHO^GMTSULT N GMTSE S GMTSE=GMTSTMP,U="^"
  1.  ;   Exact Match      X
  1.  S GMTSLEX=$$EM(X) D:$G(GMTSDIC0)["X"&(GMTSLEX'>0) CLR^GMTSULT G:$G(GMTSDIC0)["X"&(GMTSLEX'>0) FNDQ
  1.  S:+GMTSLEX>0 ^TMP("GMTSULT2",$J,"EM")=+GMTSLEX,^TMP("GMTSULT2",$J,"IEN",+GMTSLEX)=""
  1.  ;   One Exact Match  OE
  1.  S GMTSLEXM=0 S:$G(GMTSDIC0)["O"&($G(GMTSDIC0)["E") GMTSLEXM=1
  1.  ;   Word Search
  1.  S GMTSWDS=$O(GMTSWRDS(" "),-1) S GMTSWRD=$G(GMTSWRDS(1))
  1.  G:'$L(GMTSWRD) FNDQ S GMTSCTL=GMTSWRD,GMTSWRD=$E(GMTSWRD,1,($L(GMTSWRD)-1))_$C($A($E(GMTSWRD,$L(GMTSWRD)))-1)_"~"
  1.  S:+GMTSCTL=GMTSCTL GMTSWRD=GMTSCTL-1
  1.  F  S GMTSWRD=$O(^GMT(142,"AW",GMTSWRD)) Q:GMTSWRD=""!($E(GMTSWRD,1,$L(GMTSCTL))'=GMTSCTL)  D
  1.  . S (GMTSC,GMTSI1)=0
  1.  . F  S GMTSI1=$O(^GMT(142,"AW",GMTSWRD,GMTSI1)) Q:+GMTSI1=0  D
  1.  . . N GMTSIEN,GMTSKWRD S GMTSIEN=GMTSI1,GMTSKWRD=GMTSWRD
  1.  . . D SM^GMTSULT3
  1.  ;   Check for exact match in results
  1.  S GMTSI=+($G(^TMP("GMTSULT2",$J,"EMI")))
  1.  S GMTSB=$G(^TMP("GMTSULT2",$J,"EMB")) I GMTSI>0,$L(GMTSB)>0 D
  1.  . S ^TMP("GMTSULT2",$J,"E")=$G(^TMP("GMTSULT2",$J,GMTSI))
  1.  . K ^TMP("GMTSULT2",$J,GMTSI),^TMP("GMTSULT2",$J,"B",GMTSB),^TMP("GMTSULT2",$J,"EMB"),^TMP("GMTSULT2",$J,"EMI"),^TMP("GMTSULT2",$J,"EM")
  1. FNDQ ; Find Quit
  1.  K:+($G(GMTSDS))>0 GMTSDICS K:+($G(GMTSD0))>0 GMTSDIC0
  1.  Q
  1.  ;                      
  1. PAR ; Parse User Input
  1.  K GMTSWRDS N GMTSC,GMTSCT,GMTSPSN,GMTSTR,GMTSWRD
  1.  S U="^",GMTSTR=$G(X) Q:'$L(GMTSTR)  S GMTSC=1,GMTSCT=0 F GMTSPSN=1:1:$L(GMTSTR)+1 D
  1.  . S GMTSWRD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWRD D
  1.  . . S GMTSWRD=$TR($E($E(GMTSTR,GMTSC,GMTSPSN-1),1,30),"""",""),GMTSC=GMTSPSN+1
  1.  . . I $L(GMTSWRD)>0 S GMTSCT=GMTSCT+1,GMTSWRDS(GMTSCT)=$$UP(GMTSWRD)
  1.  Q
  1. IENF(X) ; Internal Entry Number Find
  1.  N GMTS0,GMTSI S GMTSI=$G(X),X=$G(X),GMTS0=$G(DIC(0)) S:$E(X,1)="`" GMTSI=$E(GMTSI,2,$L(GMTSI)) S GMTSI=+GMTSI
  1.  I GMTS0["N",+GMTSI>0,$D(^GMT(142,+GMTSI,0)) S X=+GMTSI Q X
  1.  I $E(X,1)="`",+GMTSI>0,$D(^GMT(142,+GMTSI,0)) S X=+GMTSI Q X
  1.  Q -1
  1. IENS(X) ; Internal Entry Number Save
  1.  N GMTSI1,GMTSI2,GMTSI3,GMTSIEN S (GMTSIEN,GMTSI1)=+X Q:+GMTSI1=0  Q:'$D(^GMT(142,+GMTSI1,0))
  1.  D SM^GMTSULT3,REO^GMTSULT3
  1.  Q
  1. CM(X) ; Get Number of Components
  1.  S X=+($G(X)) Q:X=0 "No components" Q:'$D(^GMT(142,+X,1)) "No components"
  1.  N GMTSI,GMTSC S (GMTSC,GMTSI)=0 F  S GMTSI=$O(^GMT(142,+X,1,GMTSI)) Q:+GMTSI=0  S GMTSC=GMTSC+1
  1.  S X=$S(+GMTSC>1:(+GMTSC_" components"),+GMTSC=1:(+GMTSC_" component"),1:"No components")
  1.  Q X
  1. EM(X) ; Exact Match when DIC(0) contains X
  1.  S X=$G(X) Q:'$L(X) -1 N GMTSC,GMTSI,GMTSM,GMTSN,GMTSO,GMTSU S U="^"
  1.  S GMTSU=$$UP(X),(GMTSC,GMTSO)=$$UP($E(X,1,30)),GMTSM=0,GMTSO=$E(GMTSO,1,($L(GMTSO)-1))_$C($A($E(GMTSO,$L(GMTSO)))-1)_"~",GMTSM=0
  1.  F  S GMTSO=$O(^GMT(142,"AB",GMTSO)) Q:GMTSO=""!(GMTSO'[GMTSC)  D  Q:+GMTSM>0
  1.  . S GMTSI=0 F  S GMTSI=$O(^GMT(142,"AB",GMTSO,GMTSI)) Q:+GMTSI=0  D  Q:+GMTSM>0
  1.  . . S GMTSN=$P($G(^GMT(142,+GMTSI,0)),U,1) S:$$UP(GMTSN)=GMTSU GMTSM=GMTSI_U_GMTSN
  1.  S:+GMTSM=0 GMTSM=-1 S X=GMTSM D Y^GMTSULT6(+GMTSM)
  1.  Q X
  1.  ;                      
  1. DICS(S,X,DA) ; Check DIC("S") Screen
  1.  N Y,GMTST,GMTSOX,GMTSDICS,GMTSIEN S (GMTSIEN,Y,DA)=+($G(DA)),GMTSDICS=$G(S),GMTSOX=$G(X) S X=GMTSDICS Q:'$L(GMTSDICS) 1
  1.  D ^DIM Q:'$L($G(X)) 1 S GMTST=$G(^GMT(142,+GMTSIEN,0)) Q:'$D(^GMT(142,+GMTSIEN,0)) 0 S X=GMTSOX,(Y,DA)=GMTSIEN Q:GMTSIEN'>0 0
  1.  X GMTSDICS S X=$T Q X
  1.  ;                      
  1.  ; Processing flags
  1. EMQ(X) ;   Exact match flag
  1.  N GMTS0 S X=0,GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
  1.  S:$G(GMTS0)["X" X=1 Q X
  1. EMO(X) ;   Exact match flag, only one
  1.  N GMTS0 S X=0 S GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
  1.  S:$G(GMTS0)["O"&($G(GMTS0)["E") X=1 Q X
  1. BI(X) ;   Use the B Index flag
  1.  N GMTS0 S X=0 S GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
  1.  S:$G(GMTS0)["B" X=1 Q X
  1. IF(X) ;   Internal Entry Number Flag
  1.  N GMTS0,GMTSI S GMTSI=0,GMTS0=$G(DIC(0)) Q:'$L($G(X)) 0
  1.  I $E(X,1)="`",$L($G(^GMT(142,+($E(X,2,$L(X))),0))) S GMTSI=1
  1.  I +X>0,$L($G(^GMT(142,+X,0))),GMTS0["N" S GMTSI=1
  1.  S X=GMTSI Q X
  1.  ;                      
  1.  ; TMP Global
  1. TMP ;   Show first ^TMP Global
  1.  N GMTSND,GMTSNC,GMTSNQ,GMTSC,GMTSTMP
  1.  S GMTSC=0,GMTSTMP="",GMTSNQ="^TMP(""GMTSULT2"","_$J_")",GMTSNC="^TMP(""GMTSULT2"","_$J_","
  1.  F  S GMTSNQ=$Q(@GMTSNQ) Q:GMTSNQ=""!(GMTSNQ'[GMTSNC)  D
  1.  . S GMTSC=GMTSC+1 W:GMTSC=1 ! S GMTSND=@GMTSNQ W !,GMTSNQ,"=",GMTSND
  1.  W:GMTSC>0 !
  1. TMP2 ;   Show second ^TMP Global
  1.  S GMTSC=0,GMTSNQ="^TMP(""GMTSULT"","_$J_")",GMTSNC="^TMP(""GMTSULT"","_$J_","
  1.  F  S GMTSNQ=$Q(@GMTSNQ) Q:GMTSNQ=""!(GMTSNQ'[GMTSNC)  D
  1.  . S GMTSC=GMTSC+1 W:'$D(GMTSTMP)&(GMTSC=1) ! S GMTSND=@GMTSNQ W !,GMTSNQ,"=",GMTSND
  1.  W:GMTSC>0 !
  1.  Q
  1.  ; Miscellaneous
  1. UP(X) ;   Uppercase
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. OW(X) ;   Mix Case (owner name)
  1.  Q:$G(X)'["," $$EN^GMTSUMX($G(X))
  1.  Q $$EN^GMTSUMX(($P($G(X),",",1)_", "_$P($G(X),",",2)))
  1. MX(X) ;   Mix Case
  1.  Q $$EN^GMTSUMX(X)