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

GMTSRM2.m

Go to the documentation of this file.
  1. GMTSRM2 ; SLC/DLT - Edit HS Type - Help/Dupe/Delete ; 09/21/2001
  1. ;;2.7;Health Summary;**47**;Oct 20, 1995
  1. ;
  1. ; External Calls
  1. ; DBIA 10013 ^DIK
  1. ; DBIA 10026 ^DIR
  1. ; DBIA 10102 DISP^XQORM1
  1. ;
  1. HELP ; Display Help Text
  1. N GMI,GMTSTXT,HLP
  1. 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)
  1. D REDISP
  1. Q
  1. REDISP ; Ask Whether or not to redisplay menu
  1. N I,DIR,X,Y
  1. S DIR(0)="Y",DIR("A")="Redisplay items",DIR("B")="YES" D ^DIR Q:'Y
  1. W @IOF
  1. D DISP^XQORM1 W !
  1. Q
  1. HTX1 ; Help Text for "?" and "??"
  1. ;;
  1. ;; Select ONE or MORE items from the menu, separated by commas.
  1. ;;
  1. ;; ALL items may be selected by typing "ALL".
  1. ;;
  1. ;; EXCEPTIONS may be entered by preceding them with a minus.
  1. ;; For example, "ALL,-THIS,-THAT" selects all but "THIS" and "THAT".
  1. ;;
  1. ;;ZZZZ
  1. ;;
  1. Q
  1. ADEL(X) ; Ask to Delete
  1. 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"))
  1. 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'."
  1. W ! D ^DIR D:Y>0 DEL(+($G(GMTSIEN)))
  1. Q
  1. DEL(X) ; Delete
  1. N DIK,DA,GMTSN S DA=+($G(X))
  1. 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 >"
  1. Q
  1. DUP(X) ; Look for a Duplicate 1 = duplicate found, 0 = unique
  1. Q:'$L($G(X)) 1 S X=$G(X) N TYPE,UTYPE S TYPE=X,UTYPE=$$UP(TYPE)
  1. 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)_"~"
  1. F S TYPEO=$O(^GMT(142,"AB",TYPEO)) Q:TYPEO=0!(TYPEO'[$E(UTYPE,1,30)) D
  1. . S TYPEI=0 F S TYPEI=$O(^GMT(142,"AB",TYPEO,TYPEI)) Q:+TYPEI=0 D
  1. . . S TYPEN=$$UP($P($G(^GMT(142,TYPEI,0)),"^",1)) Q:TYPEN'=UTYPE Q:TYPEI=+($G(DA))
  1. . . S TYPES(TYPEI)=TYPEN_"^"_TYPE
  1. Q $S($O(TYPES(0))>0:1,1:0)
  1. UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")