GMTSULT5.m

GMTSULT5 ; SLC/KER - HS Type Lookup (User Input)  ; 01/06/2003

 ;;2.7;Health Summary;**30,35,56,58**;Oct 20, 1995

 ;

 ; External References

 ;   DBIA 10026  ^DIR

 ;   DBIA 10006  ^DIC  (file #142)

 ;   DBIA 10060  ^VA(200,

 ;   DBIA  2056  $$GET1^DIQ  (file #200)

 ;                      

 Q

INPUT(X) ; Get User's Input

 N Y,GMTSDISV,GMTSB,GMTSD,DIR S GMTSDISV=0 D GDISV

 S DIR(0)="FAO^1:30^N GMTS S X=$$DEF^GMTSULT5(X),GMTS=$$INPT^GMTSULT5(X) K:'GMTS X"

 S DIR("?")="^D IN1^GMTSULT5",DIR("??")="^D IN2^GMTSULT5"

 S:'$L($G(GMTSDICA)) DIR("A")="Select HEALTH SUMMARY TYPE:  " S:$L($G(GMTSDICA)) DIR("A")=GMTSDICA

 S GMTSD=0 S:$L($G(GMTSDICB)) DIR("A")=DIR("A")_$G(GMTSDICB)_"//  "

 I $L($G(DIR("B"))) W !,DIR("A") S X=DIR("B") Q X

 D ^DIR K:X=""&($L($G(GMTSDICB)))&('$D(DTOUT)) DIRUT

 S:X=""&($L($G(GMTSDICB))) (X,Y)=GMTSDICB,GMTSDEF=1 Q:$D(DTOUT)!($D(DUOUT)) X

 S:X=" "&($L(Y))&($G(GMTSDIC0)'["F")&(+GMTSDISV>0)&($L($P($G(^GMT(142,+GMTSDISV,0)),"^",1))) X="`"_GMTSDISV

 Q X

 ;                        

 ; Help

IN1 ;   Single Question Mark Help ? for User Input

 N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M

 I X=" "&($G(GMTSDIC0)'["F") D  Q

 . D GDISV

 . S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV

 D GHT Q

IN2 ;   Double Question Mark Help ? with listing

 N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M

 W !!,"Choose from:"

 N GMTSHS,GMTSC,GMTSCT,GMTSIEN,GMTSOK,GMTSTR,GMTSTL,GMTST,GMTSPL,GMTSTT,GMTSRR

 S (GMTSC,GMTST)=0,GMTSCT=1,GMTSHS="",GMTSPL=+($G(IOSL))-8 S:GMTSPL'>0 GMTSPL=18

 S GMTSTT=0,GMTSHS="" F  S GMTSHS=$O(^GMT(142,"B",GMTSHS)) Q:GMTSHS=""  S GMTSIEN=0 F  S GMTSIEN=$O(^GMT(142,"B",GMTSHS,GMTSIEN)) Q:+GMTSIEN=0  S GMTSTT=GMTSTT+1

 S GMTSRR=GMTSTT F  S GMTSHS=$O(^GMT(142,"B",GMTSHS)) Q:GMTSHS=""!('GMTSCT)  Q:GMTST>0  D  Q:'GMTSCT  Q:GMTST>0

 . S GMTSIEN=0 F  S GMTSIEN=$O(^GMT(142,"B",GMTSHS,GMTSIEN)) Q:+GMTSIEN=0!('GMTSCT)  Q:GMTST>0  D  Q:'GMTSCT  Q:+GMTST>0

 . . S GMTSTL="",GMTSOK=1,GMTSTR=$P($G(^GMT(142,GMTSIEN,0)),U,1) Q:'$L(GMTSTR)

 . . S GMTSOK=1 I $L($G(GMTSDICS)) S GMTSOK=$$DICS^GMTSULT2(GMTSDICS,X,GMTSIEN) Q:'GMTSOK

 . . F  Q:$L(GMTSTR)>33  S GMTSTR=GMTSTR_" "

 . . S GMTSTL=$P($G(^GMT(142,GMTSIEN,"T")),U,1)

 . . S:$L(GMTSTL) GMTSTR=GMTSTR_GMTSTL

 . . S GMTSC=GMTSC+1,GMTSRR=GMTSRR-1 W !,?3,GMTSTR I +GMTSC>GMTSPL D IN2C S GMTSC=0

 W ! D:GMTST'>1 GHT Q

IN2C ;   Ask to Continue Listing

 N X W !,?3,"""^"" TO STOP:" R X:300

 S:'$T!(X["^") GMTSC=0 S:X["^" GMTST=1

 S:X["^^" GMTST=2 Q

GHT ;   General Help Text

 W !,?5,"Answer with Health Summary Type name, title, owner or hospital"

 W !,?5,"location using the summary.  Your response must be at least 2"

 W !,?5,"characters and no more than 30 characters and must not contain"

 W !,?5,"an embedded uparrow" Q

 ;                        

 ; Defaults values

DEF(X) ;   Default

 S X=$G(X)

 I +X>0,$D(^GMT(142,+X,0)),($G(GMTSDIC0)["N"!($G(GMTSDIC0)["N")) D  Q X

 . S (Y,GMTSD)=+X,X=$P($G(^GMT(142,+Y,0)),U,1)

 I $E(X,1)="`",+($E(X,2,$L(X)))>0,$D(^GMT(142,+($E(X,2,$L(X))),0)) D  Q X

 . S (Y,GMTSD)=+($E(X,2,$L(X))),X=$P($G(^GMT(142,+Y,0)),U,1)

 I X=" "&($G(GMTSDIC0)'["F") D

 . D GDISV S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV

 Q X

GDISV ;   Get Default Value (Spacebar-Return)

 S GMTSDISV=0 N DIC,Y,X,DLAYGO,DINUM,DTOUT,DUOUT,GMTSOK,%,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M

 Q:+($G(DUZ))=0  Q:'$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01))  S DIC=142,DIC(0)="Z",X=" ",GMTSOK=1 D ^DIC

 S:$L($G(GMTSDICS)) GMTSOK=$$DICS^GMTSULT2($G(GMTSDICS),$G(X),+($G(Y))) S:+GMTSOK'>0 Y=-1

 S GMTSDISV=$S(+Y>0:+Y,1:"")

 Q

 ;                        

 ; Miscellaneous

INPT(X) ;   Input Transform

 N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M

 N GMTSINPT,GMTSI,GMTST S (GMTST,X)=$G(X) I $L(X)=1,X'=" " Q 0

 I X=" "&($G(GMTSDIC0)'["F") D

 . D GDISV S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV

 K ^TMP("GMTSULT",$J),^TMP("GMTSULT2",$J) S GMTSINPT="" D LIST^GMTSULT2(X) S X=$S($D(^TMP("GMTSULT",$J,0)):1,1:0)

 I +X=0,$L($G(GMTST))>2,$L($G(GMTST))<31,+($G(GMTSLGO))=142,$G(GMTSDIC0)["L" S X=1 Q X

 K ^TMP("GMTSULT",$J),^TMP("GMTSULT2",$J) Q X

GMTSULT5  ; SLC/KER - HS Type Lookup (User Input)  ; 01/06/2003

 +1       ;;2.7;Health Summary;**30,35,56,58**;Oct 20, 1995

 +2       ;

 +3       ; External References

 +4       ;   DBIA 10026  ^DIR

 +5       ;   DBIA 10006  ^DIC  (file #142)

 +6       ;   DBIA 10060  ^VA(200,

 +7       ;   DBIA  2056  $$GET1^DIQ  (file #200)

 +8       ;                      

 +9        QUIT 

INPUT(X)  ; Get User's Input

 +1        NEW Y,GMTSDISV,GMTSB,GMTSD,DIR

           SET GMTSDISV=0

           DO GDISV

 +2        SET DIR(0)="FAO^1:30^N GMTS S X=$$DEF^GMTSULT5(X),GMTS=$$INPT^GMTSULT5(X) K:'GMTS X"

 +3        SET DIR("?")="^D IN1^GMTSULT5"

           SET DIR("??")="^D IN2^GMTSULT5"

 +4        IF '$LENGTH($GET(GMTSDICA))

               SET DIR("A")="Select HEALTH SUMMARY TYPE:  "

           IF $LENGTH($GET(GMTSDICA))

               SET DIR("A")=GMTSDICA

 +5        SET GMTSD=0

           IF $LENGTH($GET(GMTSDICB))

               SET DIR("A")=DIR("A")_$GET(GMTSDICB)_"//  "

 +6        IF $LENGTH($GET(DIR("B")))

               WRITE !,DIR("A")

               SET X=DIR("B")

               QUIT X

 +7        DO ^DIR

           IF X=""&($LENGTH($GET(GMTSDICB)))&('$DATA(DTOUT))

               KILL DIRUT

 +8        IF X=""&($LENGTH($GET(GMTSDICB)))

               SET (X,Y)=GMTSDICB

               SET GMTSDEF=1

           IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT X

 +9        IF X=" "&($LENGTH(Y))&($GET(GMTSDIC0)'["F")&(+GMTSDISV>0)&($LENGTH($PIECE($GET(^GMT(142,+GMTSDISV,0)),"^",1)))

               SET X="`"_GMTSDISV

 +10       QUIT X

 +11      ;                        

 +12      ; Help

IN1       ;   Single Question Mark Help ? for User Input

 +1        NEW %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M

 +2        IF X=" "&($GET(GMTSDIC0)'["F")

               Begin DoDot:1

 +3                DO GDISV

 +4                IF +($GET(GMTSDISV))>0

                       SET X=$PIECE($GET(^GMT(142,+($GET(GMTSDISV)),0)),U,1)

                       SET (Y,GMTSD)=+GMTSDISV

               End DoDot:1

               QUIT 

 +5        DO GHT

           QUIT 

IN2       ;   Double Question Mark Help ? with listing

 +1        NEW %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M

 +2        WRITE !!,"Choose from:"

 +3        NEW GMTSHS,GMTSC,GMTSCT,GMTSIEN,GMTSOK,GMTSTR,GMTSTL,GMTST,GMTSPL,GMTSTT,GMTSRR

 +4        SET (GMTSC,GMTST)=0

           SET GMTSCT=1

           SET GMTSHS=""

           SET GMTSPL=+($GET(IOSL))-8

           IF GMTSPL'>0

               SET GMTSPL=18

 +5        SET GMTSTT=0

           SET GMTSHS=""

           FOR 

               SET GMTSHS=$ORDER(^GMT(142,"B",GMTSHS))

               IF GMTSHS=""

                   QUIT 

               SET GMTSIEN=0

               FOR 

                   SET GMTSIEN=$ORDER(^GMT(142,"B",GMTSHS,GMTSIEN))

                   IF +GMTSIEN=0

                       QUIT 

                   SET GMTSTT=GMTSTT+1

 +6        SET GMTSRR=GMTSTT

           FOR 

               SET GMTSHS=$ORDER(^GMT(142,"B",GMTSHS))

               IF GMTSHS=""!('GMTSCT)

                   QUIT 

               IF GMTST>0

                   QUIT 

               Begin DoDot:1

 +7                SET GMTSIEN=0

                   FOR 

                       SET GMTSIEN=$ORDER(^GMT(142,"B",GMTSHS,GMTSIEN))

                       IF +GMTSIEN=0!('GMTSCT)

                           QUIT 

                       IF GMTST>0

                           QUIT 

                       Begin DoDot:2

 +8                        SET GMTSTL=""

                           SET GMTSOK=1

                           SET GMTSTR=$PIECE($GET(^GMT(142,GMTSIEN,0)),U,1)

                           IF '$LENGTH(GMTSTR)

                               QUIT 

 +9                        SET GMTSOK=1

                           IF $LENGTH($GET(GMTSDICS))

                               SET GMTSOK=$$DICS^GMTSULT2(GMTSDICS,X,GMTSIEN)

                               IF 'GMTSOK

                                   QUIT 

 +10                       FOR 

                               IF $LENGTH(GMTSTR)>33

                                   QUIT 

                               SET GMTSTR=GMTSTR_" "

 +11                       SET GMTSTL=$PIECE($GET(^GMT(142,GMTSIEN,"T")),U,1)

 +12                       IF $LENGTH(GMTSTL)

                               SET GMTSTR=GMTSTR_GMTSTL

 +13                       SET GMTSC=GMTSC+1

                           SET GMTSRR=GMTSRR-1

                           WRITE !,?3,GMTSTR

                           IF +GMTSC>GMTSPL

                               DO IN2C

                               SET GMTSC=0

                       End DoDot:2

                       IF 'GMTSCT

                           QUIT 

                       IF +GMTST>0

                           QUIT 

               End DoDot:1

               IF 'GMTSCT

                   QUIT 

               IF GMTST>0

                   QUIT 

 +14       WRITE !

           IF GMTST'>1

               DO GHT

           QUIT 

IN2C      ;   Ask to Continue Listing

 +1        NEW X

           WRITE !,?3,"""^"" TO STOP:"

           READ X:300

 +2        IF '$TEST!(X["^")

               SET GMTSC=0

           IF X["^"

               SET GMTST=1

 +3        IF X["^^"

               SET GMTST=2

           QUIT 

GHT       ;   General Help Text

 +1        WRITE !,?5,"Answer with Health Summary Type name, title, owner or hospital"

 +2        WRITE !,?5,"location using the summary.  Your response must be at least 2"

 +3        WRITE !,?5,"characters and no more than 30 characters and must not contain"

 +4        WRITE !,?5,"an embedded uparrow"

           QUIT 

 +5       ;                        

 +6       ; Defaults values

DEF(X)    ;   Default

 +1        SET X=$GET(X)

 +2        IF +X>0

               IF $DATA(^GMT(142,+X,0))

                   IF ($GET(GMTSDIC0)["N"!($GET(GMTSDIC0)["N"))

                       Begin DoDot:1

 +3                        SET (Y,GMTSD)=+X

                           SET X=$PIECE($GET(^GMT(142,+Y,0)),U,1)

                       End DoDot:1

                       QUIT X

 +4        IF $EXTRACT(X,1)="`"

               IF +($EXTRACT(X,2,$LENGTH(X)))>0

                   IF $DATA(^GMT(142,+($EXTRACT(X,2,$LENGTH(X))),0))

                       Begin DoDot:1

 +5                        SET (Y,GMTSD)=+($EXTRACT(X,2,$LENGTH(X)))

                           SET X=$PIECE($GET(^GMT(142,+Y,0)),U,1)

                       End DoDot:1

                       QUIT X

 +6        IF X=" "&($GET(GMTSDIC0)'["F")

               Begin DoDot:1

 +7                DO GDISV

                   IF +($GET(GMTSDISV))>0

                       SET X=$PIECE($GET(^GMT(142,+($GET(GMTSDISV)),0)),U,1)

                       SET (Y,GMTSD)=+GMTSDISV

               End DoDot:1

 +8        QUIT X

GDISV     ;   Get Default Value (Spacebar-Return)

 +1        SET GMTSDISV=0

           NEW DIC,Y,X,DLAYGO,DINUM,DTOUT,DUOUT,GMTSOK,%,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M

 +2        IF +($GET(DUZ))=0

               QUIT 

           IF '$LENGTH($$GET1^DIQ(200,(+($GET(DUZ))_","),.01))

               QUIT 

           SET DIC=142

           SET DIC(0)="Z"

           SET X=" "

           SET GMTSOK=1

           DO ^DIC

 +3        IF $LENGTH($GET(GMTSDICS))

               SET GMTSOK=$$DICS^GMTSULT2($GET(GMTSDICS),$GET(X),+($GET(Y)))

           IF +GMTSOK'>0

               SET Y=-1

 +4        SET GMTSDISV=$SELECT(+Y>0:+Y,1:"")

 +5        QUIT 

 +6       ;                        

 +7       ; Miscellaneous

INPT(X)   ;   Input Transform

 +1        NEW %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M

 +2        NEW GMTSINPT,GMTSI,GMTST

           SET (GMTST,X)=$GET(X)

           IF $LENGTH(X)=1

               IF X'=" "

                   QUIT 0

 +3        IF X=" "&($GET(GMTSDIC0)'["F")

               Begin DoDot:1

 +4                DO GDISV

                   IF +($GET(GMTSDISV))>0

                       SET X=$PIECE($GET(^GMT(142,+($GET(GMTSDISV)),0)),U,1)

                       SET (Y,GMTSD)=+GMTSDISV

               End DoDot:1

 +5        KILL ^TMP("GMTSULT",$JOB),^TMP("GMTSULT2",$JOB)

           SET GMTSINPT=""

           DO LIST^GMTSULT2(X)

           SET X=$SELECT($DATA(^TMP("GMTSULT",$JOB,0)):1,1:0)

 +6        IF +X=0

               IF $LENGTH($GET(GMTST))>2

                   IF $LENGTH($GET(GMTST))<31

                       IF +($GET(GMTSLGO))=142

                           IF $GET(GMTSDIC0)["L"

                               SET X=1

                               QUIT X

 +7        KILL ^TMP("GMTSULT",$JOB),^TMP("GMTSULT2",$JOB)

           QUIT X