| [613] | 1 | GMTSRM2 ; SLC/DLT - Edit HS Type - Help/Dupe/Delete ; 09/21/2001
|
|---|
| 2 | ;;2.7;Health Summary;**47**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External Calls
|
|---|
| 5 | ; DBIA 10013 ^DIK
|
|---|
| 6 | ; DBIA 10026 ^DIR
|
|---|
| 7 | ; DBIA 10102 DISP^XQORM1
|
|---|
| 8 | ;
|
|---|
| 9 | HELP ; Display Help Text
|
|---|
| 10 | N GMI,GMTSTXT,HLP
|
|---|
| 11 | S HLP=$S(X="??":"HTX1",1:"HTX1") W ! F GMI=1:1 S GMTSTXT=$T(@HLP+GMI) Q:GMTSTXT["ZZZZ" W !,$P(GMTSTXT,";",3,99)
|
|---|
| 12 | D REDISP
|
|---|
| 13 | Q
|
|---|
| 14 | REDISP ; Ask Whether or not to redisplay menu
|
|---|
| 15 | N I,DIR,X,Y
|
|---|
| 16 | S DIR(0)="Y",DIR("A")="Redisplay items",DIR("B")="YES" D ^DIR Q:'Y
|
|---|
| 17 | W @IOF
|
|---|
| 18 | D DISP^XQORM1 W !
|
|---|
| 19 | Q
|
|---|
| 20 | HTX1 ; Help Text for "?" and "??"
|
|---|
| 21 | ;;
|
|---|
| 22 | ;; Select ONE or MORE items from the menu, separated by commas.
|
|---|
| 23 | ;;
|
|---|
| 24 | ;; ALL items may be selected by typing "ALL".
|
|---|
| 25 | ;;
|
|---|
| 26 | ;; EXCEPTIONS may be entered by preceding them with a minus.
|
|---|
| 27 | ;; For example, "ALL,-THIS,-THAT" selects all but "THIS" and "THAT".
|
|---|
| 28 | ;;
|
|---|
| 29 | ;;ZZZZ
|
|---|
| 30 | ;;
|
|---|
| 31 | Q
|
|---|
| 32 | ADEL(X) ; Ask to Delete
|
|---|
| 33 | N GMTSIEN,GMTSN,ADEL,DIR S GMTSIEN=+($G(X)),ADEL="" Q:GMTSIEN=0 Q:'$D(^GMT(142,GMTSIEN,0)) Q:$D(^GMT(142,GMTSIEN,1,"B"))
|
|---|
| 34 | S GMTSN=$P($G(^GMT(142,GMTSIEN,0)),"^",1) Q:'$L(GMTSN) S DIR("A",1)=" Health Summary Type '"_GMTSN_"' has no Components",DIR("A")=" Do you want to delete this type? (Y/N) ",DIR("B")="Yes",DIR(0)="YAO",DIR("?")=" Enter either 'Y' or 'N'."
|
|---|
| 35 | W ! D ^DIR D:Y>0 DEL(+($G(GMTSIEN)))
|
|---|
| 36 | Q
|
|---|
| 37 | DEL(X) ; Delete
|
|---|
| 38 | N DIK,DA,GMTSN S DA=+($G(X))
|
|---|
| 39 | Q:DA=0 Q:'$D(^GMT(142,DA,0)) S DIK="^GMT(142,",GMTSN=$P($G(^GMT(142,DA,0)),"^",1) Q:'$L(GMTSN) D ^DIK I '$D(^GMT(142,DA,0)) W:$D(ADEL) " < deleted >" W:'$D(ADEL) !,?2,GMTSN," < deleted >"
|
|---|
| 40 | Q
|
|---|
| 41 | DUP(X) ; Look for a Duplicate 1 = duplicate found, 0 = unique
|
|---|
| 42 | Q:'$L($G(X)) 1 S X=$G(X) N TYPE,UTYPE S TYPE=X,UTYPE=$$UP(TYPE)
|
|---|
| 43 | N TYPES,TYPEO,TYPEI,TYPEN S TYPEO=$E(UTYPE,1,30),TYPEO=$E(TYPEO,1,($L(TYPEO)-1))_$C($A($E(TYPEO,$L(TYPEO)))-1)_"~"
|
|---|
| 44 | F S TYPEO=$O(^GMT(142,"AB",TYPEO)) Q:TYPEO=0!(TYPEO'[$E(UTYPE,1,30)) D
|
|---|
| 45 | . S TYPEI=0 F S TYPEI=$O(^GMT(142,"AB",TYPEO,TYPEI)) Q:+TYPEI=0 D
|
|---|
| 46 | . . S TYPEN=$$UP($P($G(^GMT(142,TYPEI,0)),"^",1)) Q:TYPEN'=UTYPE Q:TYPEI=+($G(DA))
|
|---|
| 47 | . . S TYPES(TYPEI)=TYPEN_"^"_TYPE
|
|---|
| 48 | Q $S($O(TYPES(0))>0:1,1:0)
|
|---|
| 49 | UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
