source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRM2.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1GMTSRM2 ; 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 ;
9HELP ; 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
14REDISP ; 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
20HTX1 ; 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
32ADEL(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
37DEL(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
41DUP(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)
49UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Note: See TracBrowser for help on using the repository browser.