| 1 | GMTSULT2 ; SLC/KER - HS Type Lookup (Search/List) ; 08/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**30,32,35,29,56**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External Reference
|
|---|
| 5 | ; DBIA 10016 ^DIM
|
|---|
| 6 | ;
|
|---|
| 7 | Q
|
|---|
| 8 | LIST(X) ; Get global array of Health Summary Types
|
|---|
| 9 | ;
|
|---|
| 10 | ; LIST^GMTSULT2(<search string>)
|
|---|
| 11 | ;
|
|---|
| 12 | ; ^TMP("GMTSULT",$J,#)
|
|---|
| 13 | ;
|
|---|
| 14 | ; Piece 1 = Internal Entry Number (IEN) in file 142
|
|---|
| 15 | ; Piece 2 = Health Summary Type Name
|
|---|
| 16 | ; Piece 3 = Health Summary Type Title
|
|---|
| 17 | ; Piece 4 = Health Summary Type Owner
|
|---|
| 18 | ; Piece 5 = Location Using Health Summary Type
|
|---|
| 19 | ; Piece 6 = Number of Components in Summary Type
|
|---|
| 20 | ; Piece 7 = Recommended Display Text (for
|
|---|
| 21 | ; selection or list box)
|
|---|
| 22 | ;
|
|---|
| 23 | ; List Builder can use variable DIC("S") and DIC(0)
|
|---|
| 24 | ;
|
|---|
| 25 | ; DIC("S") Screen out entries for selection/list
|
|---|
| 26 | ;
|
|---|
| 27 | ; Processes DIC(0) N, OE (combination),X or B
|
|---|
| 28 | ;
|
|---|
| 29 | ; Does not process DIC(0) components C or M. Cross
|
|---|
| 30 | ; reference suppression (C) is automatic in a multi-
|
|---|
| 31 | ; term lookup, and the use of multiple indexes is
|
|---|
| 32 | ; implied in the lookup and DD file structure.
|
|---|
| 33 | ;
|
|---|
| 34 | D CLR^GMTSULT N GMTSEO,GMTSEQ,GMTSIF,GMTSBI,GMTSIEN,GMTSWRDS,GMTSDS,GMTSD0
|
|---|
| 35 | S GMTSEO=+($$EMO),GMTSEQ=+($$EMQ),GMTSIF=+($$IF($G(X))),GMTSBI=+($$BI)
|
|---|
| 36 | S:$L($G(DIC("S")))&('$L($G(GMTSDICS))) GMTSDICS=$G(DIC("S")),GMTSDS=1
|
|---|
| 37 | S:$L($G(DIC(0)))&('$L($G(GMTSDIC0))) GMTSDIC0=$G(DIC(0)),GMTSD0=1
|
|---|
| 38 | I GMTSIF S GMTSIEN=$$IENF(X) I +GMTSIEN>0 D IENS(GMTSIEN) G:$D(^TMP("GMTSULT",$J,1)) LQ
|
|---|
| 39 | I GMTSBI D B^GMTSULT7 G LQ
|
|---|
| 40 | D PAR,FND,REO^GMTSULT3
|
|---|
| 41 | Q
|
|---|
| 42 | LQ ; Quit List
|
|---|
| 43 | K:+($G(GMTSDS))>0 GMTSDICS K:+($G(GMTSD0))>0 GMTSDIC0
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | FND ; Find Health Summary Types (word search)
|
|---|
| 47 | 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
|
|---|
| 48 | ; Echo E or broker
|
|---|
| 49 | S GMTSTMP=+($G(GMTSE)),GMTSIF=0 S:'$D(GMTSE) GMTSTMP=$$ECHO^GMTSULT N GMTSE S GMTSE=GMTSTMP,U="^"
|
|---|
| 50 | ; Exact Match X
|
|---|
| 51 | S GMTSLEX=$$EM(X) D:$G(GMTSDIC0)["X"&(GMTSLEX'>0) CLR^GMTSULT G:$G(GMTSDIC0)["X"&(GMTSLEX'>0) FNDQ
|
|---|
| 52 | S:+GMTSLEX>0 ^TMP("GMTSULT2",$J,"EM")=+GMTSLEX,^TMP("GMTSULT2",$J,"IEN",+GMTSLEX)=""
|
|---|
| 53 | ; One Exact Match OE
|
|---|
| 54 | S GMTSLEXM=0 S:$G(GMTSDIC0)["O"&($G(GMTSDIC0)["E") GMTSLEXM=1
|
|---|
| 55 | ; Word Search
|
|---|
| 56 | S GMTSWDS=$O(GMTSWRDS(" "),-1) S GMTSWRD=$G(GMTSWRDS(1))
|
|---|
| 57 | G:'$L(GMTSWRD) FNDQ S GMTSCTL=GMTSWRD,GMTSWRD=$E(GMTSWRD,1,($L(GMTSWRD)-1))_$C($A($E(GMTSWRD,$L(GMTSWRD)))-1)_"~"
|
|---|
| 58 | S:+GMTSCTL=GMTSCTL GMTSWRD=GMTSCTL-1
|
|---|
| 59 | F S GMTSWRD=$O(^GMT(142,"AW",GMTSWRD)) Q:GMTSWRD=""!($E(GMTSWRD,1,$L(GMTSCTL))'=GMTSCTL) D
|
|---|
| 60 | . S (GMTSC,GMTSI1)=0
|
|---|
| 61 | . F S GMTSI1=$O(^GMT(142,"AW",GMTSWRD,GMTSI1)) Q:+GMTSI1=0 D
|
|---|
| 62 | . . N GMTSIEN,GMTSKWRD S GMTSIEN=GMTSI1,GMTSKWRD=GMTSWRD
|
|---|
| 63 | . . D SM^GMTSULT3
|
|---|
| 64 | ; Check for exact match in results
|
|---|
| 65 | S GMTSI=+($G(^TMP("GMTSULT2",$J,"EMI")))
|
|---|
| 66 | S GMTSB=$G(^TMP("GMTSULT2",$J,"EMB")) I GMTSI>0,$L(GMTSB)>0 D
|
|---|
| 67 | . S ^TMP("GMTSULT2",$J,"E")=$G(^TMP("GMTSULT2",$J,GMTSI))
|
|---|
| 68 | . K ^TMP("GMTSULT2",$J,GMTSI),^TMP("GMTSULT2",$J,"B",GMTSB),^TMP("GMTSULT2",$J,"EMB"),^TMP("GMTSULT2",$J,"EMI"),^TMP("GMTSULT2",$J,"EM")
|
|---|
| 69 | FNDQ ; Find Quit
|
|---|
| 70 | K:+($G(GMTSDS))>0 GMTSDICS K:+($G(GMTSD0))>0 GMTSDIC0
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | PAR ; Parse User Input
|
|---|
| 74 | K GMTSWRDS N GMTSC,GMTSCT,GMTSPSN,GMTSTR,GMTSWRD
|
|---|
| 75 | S U="^",GMTSTR=$G(X) Q:'$L(GMTSTR) S GMTSC=1,GMTSCT=0 F GMTSPSN=1:1:$L(GMTSTR)+1 D
|
|---|
| 76 | . S GMTSWRD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWRD D
|
|---|
| 77 | . . S GMTSWRD=$TR($E($E(GMTSTR,GMTSC,GMTSPSN-1),1,30),"""",""),GMTSC=GMTSPSN+1
|
|---|
| 78 | . . I $L(GMTSWRD)>0 S GMTSCT=GMTSCT+1,GMTSWRDS(GMTSCT)=$$UP(GMTSWRD)
|
|---|
| 79 | Q
|
|---|
| 80 | IENF(X) ; Internal Entry Number Find
|
|---|
| 81 | 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
|
|---|
| 82 | I GMTS0["N",+GMTSI>0,$D(^GMT(142,+GMTSI,0)) S X=+GMTSI Q X
|
|---|
| 83 | I $E(X,1)="`",+GMTSI>0,$D(^GMT(142,+GMTSI,0)) S X=+GMTSI Q X
|
|---|
| 84 | Q -1
|
|---|
| 85 | IENS(X) ; Internal Entry Number Save
|
|---|
| 86 | N GMTSI1,GMTSI2,GMTSI3,GMTSIEN S (GMTSIEN,GMTSI1)=+X Q:+GMTSI1=0 Q:'$D(^GMT(142,+GMTSI1,0))
|
|---|
| 87 | D SM^GMTSULT3,REO^GMTSULT3
|
|---|
| 88 | Q
|
|---|
| 89 | CM(X) ; Get Number of Components
|
|---|
| 90 | S X=+($G(X)) Q:X=0 "No components" Q:'$D(^GMT(142,+X,1)) "No components"
|
|---|
| 91 | N GMTSI,GMTSC S (GMTSC,GMTSI)=0 F S GMTSI=$O(^GMT(142,+X,1,GMTSI)) Q:+GMTSI=0 S GMTSC=GMTSC+1
|
|---|
| 92 | S X=$S(+GMTSC>1:(+GMTSC_" components"),+GMTSC=1:(+GMTSC_" component"),1:"No components")
|
|---|
| 93 | Q X
|
|---|
| 94 | EM(X) ; Exact Match when DIC(0) contains X
|
|---|
| 95 | S X=$G(X) Q:'$L(X) -1 N GMTSC,GMTSI,GMTSM,GMTSN,GMTSO,GMTSU S U="^"
|
|---|
| 96 | 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
|
|---|
| 97 | F S GMTSO=$O(^GMT(142,"AB",GMTSO)) Q:GMTSO=""!(GMTSO'[GMTSC) D Q:+GMTSM>0
|
|---|
| 98 | . S GMTSI=0 F S GMTSI=$O(^GMT(142,"AB",GMTSO,GMTSI)) Q:+GMTSI=0 D Q:+GMTSM>0
|
|---|
| 99 | . . S GMTSN=$P($G(^GMT(142,+GMTSI,0)),U,1) S:$$UP(GMTSN)=GMTSU GMTSM=GMTSI_U_GMTSN
|
|---|
| 100 | S:+GMTSM=0 GMTSM=-1 S X=GMTSM D Y^GMTSULT6(+GMTSM)
|
|---|
| 101 | Q X
|
|---|
| 102 | ;
|
|---|
| 103 | DICS(S,X,DA) ; Check DIC("S") Screen
|
|---|
| 104 | 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
|
|---|
| 105 | 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
|
|---|
| 106 | X GMTSDICS S X=$T Q X
|
|---|
| 107 | ;
|
|---|
| 108 | ; Processing flags
|
|---|
| 109 | EMQ(X) ; Exact match flag
|
|---|
| 110 | N GMTS0 S X=0,GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
|
|---|
| 111 | S:$G(GMTS0)["X" X=1 Q X
|
|---|
| 112 | EMO(X) ; Exact match flag, only one
|
|---|
| 113 | N GMTS0 S X=0 S GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
|
|---|
| 114 | S:$G(GMTS0)["O"&($G(GMTS0)["E") X=1 Q X
|
|---|
| 115 | BI(X) ; Use the B Index flag
|
|---|
| 116 | N GMTS0 S X=0 S GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
|
|---|
| 117 | S:$G(GMTS0)["B" X=1 Q X
|
|---|
| 118 | IF(X) ; Internal Entry Number Flag
|
|---|
| 119 | N GMTS0,GMTSI S GMTSI=0,GMTS0=$G(DIC(0)) Q:'$L($G(X)) 0
|
|---|
| 120 | I $E(X,1)="`",$L($G(^GMT(142,+($E(X,2,$L(X))),0))) S GMTSI=1
|
|---|
| 121 | I +X>0,$L($G(^GMT(142,+X,0))),GMTS0["N" S GMTSI=1
|
|---|
| 122 | S X=GMTSI Q X
|
|---|
| 123 | ;
|
|---|
| 124 | ; TMP Global
|
|---|
| 125 | TMP ; Show first ^TMP Global
|
|---|
| 126 | N GMTSND,GMTSNC,GMTSNQ,GMTSC,GMTSTMP
|
|---|
| 127 | S GMTSC=0,GMTSTMP="",GMTSNQ="^TMP(""GMTSULT2"","_$J_")",GMTSNC="^TMP(""GMTSULT2"","_$J_","
|
|---|
| 128 | F S GMTSNQ=$Q(@GMTSNQ) Q:GMTSNQ=""!(GMTSNQ'[GMTSNC) D
|
|---|
| 129 | . S GMTSC=GMTSC+1 W:GMTSC=1 ! S GMTSND=@GMTSNQ W !,GMTSNQ,"=",GMTSND
|
|---|
| 130 | W:GMTSC>0 !
|
|---|
| 131 | TMP2 ; Show second ^TMP Global
|
|---|
| 132 | S GMTSC=0,GMTSNQ="^TMP(""GMTSULT"","_$J_")",GMTSNC="^TMP(""GMTSULT"","_$J_","
|
|---|
| 133 | F S GMTSNQ=$Q(@GMTSNQ) Q:GMTSNQ=""!(GMTSNQ'[GMTSNC) D
|
|---|
| 134 | . S GMTSC=GMTSC+1 W:'$D(GMTSTMP)&(GMTSC=1) ! S GMTSND=@GMTSNQ W !,GMTSNQ,"=",GMTSND
|
|---|
| 135 | W:GMTSC>0 !
|
|---|
| 136 | Q
|
|---|
| 137 | ; Miscellaneous
|
|---|
| 138 | UP(X) ; Uppercase
|
|---|
| 139 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 140 | OW(X) ; Mix Case (owner name)
|
|---|
| 141 | Q:$G(X)'["," $$EN^GMTSUMX($G(X))
|
|---|
| 142 | Q $$EN^GMTSUMX(($P($G(X),",",1)_", "_$P($G(X),",",2)))
|
|---|
| 143 | MX(X) ; Mix Case
|
|---|
| 144 | Q $$EN^GMTSUMX(X)
|
|---|
