Routine: GMTSPN1

GMTSPN1 ; SLC/KER - Progress Note Header/Sig/Text/Prob ; 5/17/06 2:03pm

 ;;2.7;Health Summary;**12,35,45,49,81**;Oct 20, 1995;Build 23

 ; External References

 ;    DBIA 10104 call $$UP^XLFSTR

 ; Write Headers

WH ;   Note Header

 Q:$D(GMTSQIT)  I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT)  W !

 W $G(PN("DATE")),?18,"Local Title: ",$$UP^XLFSTR($G(PN("DOCTYPE"))),!

 I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?15,"Standard Title: ",PN("VHATYPE"),!

 S (ADATE,PDATE)=$G(PN("DATE")),(ATYPE,PTYPE)=$G(PN("DOCTYPE")),(ASUB,PSUB)=$G(PN("SUBJ"))

 I $D(PN("AUTH")) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?20,PN("AUTH"),!

 I PN("SUBJ")'="" D CKP^GMTSUP Q:$D(GMTSQIT)  W ?19,"Subject:  ",PN("SUBJ"),!

WDH ;   Discharge Summary Header

 Q:$D(GMTSQIT)  I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT)  W !

 D CKP^GMTSUP Q:$D(GMTSQIT)  W ADMIT,?12,"-",?14,DISCHG,?56,"Status: ",STATUS,!

 I $D(PN("DOCTYPE")) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?9,"Local Title: ",PN("VHATYPE"),!

 I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?6,"Standard Title: ",PN("VHATYPE"),!

 D CKP^GMTSUP Q:$D(GMTSQIT)  W ?3,"Last Tr Specialty: ",TSPEC,?49,"Dict'd By: ",AUTHOR,!

 D CKP^GMTSUP Q:$D(GMTSQIT)  W ?47,"Approved By: ",ATTNDNG,!

WDBH ;   Brief Discharge Summary Header

 D CKP^GMTSUP Q:$D(GMTSQIT)  W "Admitted",?11,"Disch'd",?23,"Dictated By",?38,"Approved By",?53,"Cosigned",?64,"Status",!! Q

WAH ;   Addendum Header

 Q:$D(GMTSQIT)  I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT)  W !

 W PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE")),!

 I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?15,"Standard Title: ",PN("VHATYPE"),!

 I $L($G(ADATE)),$L($G(ATYPE)) D  Q:$D(GMTSQIT)

 . I $D(GMTSREF) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?23,"Ref:  ",$E(ATYPE,1,25),?55,"Dated:  ",ADATE,!

 I $D(PN("AUTH")) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?20,PN("AUTH"),!

 I PN("SUBJ")'="" D CKP^GMTSUP Q:$D(GMTSQIT)  W ?19,"Subject:  ",PN("SUBJ"),!

 I '$L($G(PN("SUBJ"))),$L($G(ASUB)) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?19,"Subject:  ",$G(ASUB),!

ST(X) ;   Sub-Titles

 N GMTS,GMTS1,GMTS2,GMTST,GMTSB S GMTST=$G(X) Q:'$L(GMTST)

 S GMTST="<< "_GMTST_" >>",GMTS="",$P(GMTS,"-",((((79-$L(GMTST))\2)\2)-6))="-"

 S $P(GMTS1," ",((((79-$L(GMTST))\2)\2)+6))=" "

 S GMTS2=GMTS_GMTS1,GMTS1=GMTS1_GMTS,GMTSB=GMTS1_GMTST_GMTS2

 D CKP^GMTSUP Q:$D(GMTSQIT)  W !,GMTSB D CKP^GMTSUP Q:$D(GMTSQIT)  W !

WIH ;   Interdisciplinary Note Header

 Q:$D(GMTSQIT)  I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT)  W !

 W PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE"))

 I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT)  W !?15,"Standard Title: ",PN("VHATYPE"),!

 S ADATE=$G(PN("DATE")),ATYPE=$G(PN("DOCTYPE")),ASUB=$G(PN("SUBJ"))

 I $L($G(PDATE)),$L($G(PTYPE)) D  Q:$D(GMTSQIT)

 . I $D(GMTSREF) D CKP^GMTSUP Q:$D(GMTSQIT)  W !,?23,"Ref:  ",$E(PTYPE,1,25),?55,"Dated:  ",PDATE

 I $D(PN("AUTH")) D CKP^GMTSUP Q:$D(GMTSQIT)  W !?20,PN("AUTH")

 I PN("SUBJ")'="" D CKP^GMTSUP Q:$D(GMTSQIT)  W !?19,"Subject:  ",PN("SUBJ")

 I '$L($G(PN("SUBJ"))),$L($G(PSUB)) D CKP^GMTSUP Q:$D(GMTSQIT)  W !?19,"Subject:  ",$G(PSUB)

WAIH ;   Addendum to Interdisciplinary Note Header

 Q:$D(GMTSQIT)  I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT)  W !

 W PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE"))

 I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT)  W !?15,"Standard Title: ",PN("VHATYPE"),!

 I $L($G(ADATE)),$L($G(ATYPE)) D  Q:$D(GMTSQIT)

 . I $D(GMTSREF) D CKP^GMTSUP Q:$D(GMTSQIT)  W !,?23,"Ref:  ",$E(ATYPE,1,25),?55,"Dated:  ",ADATE

 I $L($G(PDATE)),$L($G(PTYPE)) D  Q:$D(GMTSQIT)

 . I $D(GMTSREF) D CKP^GMTSUP Q:$D(GMTSQIT)  W !,?23,"Ref:  ",$E(PTYPE,1,29),?55,"Dated:  ",PDATE

 I $D(PN("AUTH")) D CKP^GMTSUP Q:$D(GMTSQIT)  W !?20,PN("AUTH")

 I PN("SUBJ")'="" D CKP^GMTSUP Q:$D(GMTSQIT)  W !?19,"Subject:  ",PN("SUBJ")

 I '$L($G(PN("SUBJ"))),$L($G(ASUB)) D CKP^GMTSUP Q:$D(GMTSQIT)  W !?19,"Subject:  ",$G(ASUB)

 I '$L($G(PN("SUBJ"))),'$L($G(ASUB)),$L(PSUB) D CKP^GMTSUP Q:$D(GMTSQIT)  W !?19,"Subject:  ",$G(PSUB)

 ; Write Note

WT(X,I) ;   Write Progress Note Text

 N GMTSD,GMTSIEN S GMTSD=$G(X),GMTSIEN=$G(I) Q:'$L(GMTSIEN)  Q:$E($P(GMTSD,$J,1),1,11)'="^TMP(""TIU"","

 Q:'$D(@($P(GMTSD,",",1,($L(GMTSD,",")-1))_")"))  Q:'$D(@(GMTSD_GMTSIEN_")"))  S GMTSD=GMTSD_GMTSIEN_",""TEXT"","

 N GMTSK S GMTSK=0 F  S GMTSK=$O(@(GMTSD_GMTSK_")")) Q:+GMTSK'>0  D  Q:$D(GMTSQIT)

 . D CKP^GMTSUP Q:$D(GMTSQIT)  W !,$G(@(GMTSD_GMTSK_",0)"))

 Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)  W !

WP(X,I) ;   Writes Problems associated with Note

 Q:$G(TIUNAM)["DISCHARGE"

 N GMTSD,GMTSIEN S GMTSD=$G(X),GMTSIEN=$G(I) Q:'$L(GMTSIEN)  Q:$E($P(GMTSD,$J,1),1,11)'="^TMP(""TIU"","

 Q:'$D(@($P(GMTSD,",",1,($L(GMTSD,",")-1))_")"))  Q:'$D(@(GMTSD_GMTSIEN_")"))  S GMTSD=GMTSD_GMTSIEN_",""PROBLEM"","

 D CKP^GMTSUP Q:$D(GMTSQIT)  W !,"PROBLEM(S):  "

 N GMTSPR S GMTSPR=0 F  S GMTSPR=$O(@(GMTSD_GMTSPR_")")) Q:+GMTSPR'>0  D  Q:$D(GMTSQIT)

 . D:GMTSPR>1 CKP^GMTSUP Q:$D(GMTSQIT)  W !?15,$G(@(GMTSD_GMTSPR_",0)"))

 Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)  W !

AM(X,I) ;   Write Amendment

 Q:$D(GMTSQIT)  N GMTSD,GMTSIEN,GMTSA,GMTSI S GMTSD=$G(X),GMTSIEN=$G(I) Q:'$L(GMTSIEN)  Q:$E($P(GMTSD,$J,1),1,11)'="^TMP(""TIU"","

 Q:'$D(@($P(GMTSD,",",1,($L(GMTSD,",")-1))_")"))  Q:'$D(@(GMTSD_GMTSIEN_")"))

 S GMTSD=GMTSD_GMTSIEN_"," D CKP^GMTSUP Q:$D(GMTSQIT)  W !

 D CKP^GMTSUP Q:$D(GMTSQIT)  W !,$G(@(GMTSD_"1601,""E"")")),"  AMENDMENT FILED:"

 I $G(@(GMTSD_"1603,""E"")"))'="" D  Q:$D(GMTSQIT)

 . D CKP^GMTSUP Q:$D(GMTSQIT)  W !

 . D CKP^GMTSUP Q:$D(GMTSQIT)  W !?10 F GMTSI=1:1:$L($G(@(GMTSD_"1602,""E"")"))) W "_"

 I $G(@(GMTSD_"1604,""E"")"))'="" D  Q:$D(GMTSQIT)

 . D CKP^GMTSUP Q:$D(GMTSQIT)  W !?28,"  /es/ ",$G(@(GMTSD_"1604,""E"")"))

 I $G(@(GMTSD_"1605,""E"")"))'="" D  Q:$D(GMTSQIT)

 . D CKP^GMTSUP Q:$D(GMTSQIT)  W !?34,$G(@(GMTSD_"1605,""E"")"))

 D CKP^GMTSUP Q:$D(GMTSQIT)  W !

WDB(X,I) ;   Writes Brief Discharge Summary

 Q:$D(GMTSQIT)  N GMTSD,GMTSIEN,GMTSA,GMTSI S GMTSD=$G(X),GMTSIEN=$G(I) Q:'$L(GMTSIEN)  Q:$E($P(GMTSD,$J,1),1,11)'="^TMP(""TIU"","

 Q:'$D(@($P(GMTSD,",",1,($L(GMTSD,",")-1))_")"))  Q:'$D(@(GMTSD_GMTSIEN_")"))

 D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG WDBH

 W $E($G(ADMIT),1,12),?11,$E($G(DISCHG),1,12),?23,$E($G(AUTHOR),1,14),?38,$E($G(ATTNDNG),1,14),?53,$E($G(COSIG),1,10),?64,$G(STATUS),!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPN1   6356     printed  Mar 13, 2025@21:04:08                                                                                                                                                                                                     Page 2

GMTSPN1   ; SLC/KER - Progress Note Header/Sig/Text/Prob ; 5/17/06 2:03pm

 +1       ;;2.7;Health Summary;**12,35,45,49,81**;Oct 20, 1995;Build 23

 +2        QUIT

 +3       ;

 +4       ; External References

 +5       ;    DBIA 10104 call $$UP^XLFSTR

 +6       ;

 +7       ; Write Headers

WH        ;   Note Header

 +1        if $DATA(GMTSQIT)

               QUIT

           IF GMTSCNT>1

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !

 +2        WRITE $GET(PN("DATE")),?18,"Local Title: ",$$UP^XLFSTR($GET(PN("DOCTYPE"))),!

 +3        IF $DATA(PN("VHATYPE"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE ?15,"Standard Title: ",PN("VHATYPE"),!

 +4        SET (ADATE,PDATE)=$GET(PN("DATE"))

           SET (ATYPE,PTYPE)=$GET(PN("DOCTYPE"))

           SET (ASUB,PSUB)=$GET(PN("SUBJ"))

 +5        IF $DATA(PN("AUTH"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE ?20,PN("AUTH"),!

 +6        IF PN("SUBJ")'=""

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE ?19,"Subject:  ",PN("SUBJ"),!

 +7        QUIT

WDH       ;   Discharge Summary Header

 +1        if $DATA(GMTSQIT)

               QUIT

           IF GMTSCNT>1

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !

 +2        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE ADMIT,?12,"-",?14,DISCHG,?56,"Status: ",STATUS,!

 +3        IF $DATA(PN("DOCTYPE"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE ?9,"Local Title: ",PN("VHATYPE"),!

 +4        IF $DATA(PN("VHATYPE"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE ?6,"Standard Title: ",PN("VHATYPE"),!

 +5        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE ?3,"Last Tr Specialty: ",TSPEC,?49,"Dict'd By: ",AUTHOR,!

 +6        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE ?47,"Approved By: ",ATTNDNG,!

 +7        QUIT

WDBH      ;   Brief Discharge Summary Header

 +1        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE "Admitted",?11,"Disch'd",?23,"Dictated By",?38,"Approved By",?53,"Cosigned",?64,"Status",!!

           QUIT

WAH       ;   Addendum Header

 +1        if $DATA(GMTSQIT)

               QUIT

           IF GMTSCNT>1

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !

 +2        WRITE PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE")),!

 +3        IF $DATA(PN("VHATYPE"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE ?15,"Standard Title: ",PN("VHATYPE"),!

 +4        IF $LENGTH($GET(ADATE))

               IF $LENGTH($GET(ATYPE))

                   Begin DoDot:1

 +5                    IF $DATA(GMTSREF)

                           DO CKP^GMTSUP

                           if $DATA(GMTSQIT)

                               QUIT

                           WRITE ?23,"Ref:  ",$EXTRACT(ATYPE,1,25),?55,"Dated:  ",ADATE,!

                   End DoDot:1

                   if $DATA(GMTSQIT)

                       QUIT

 +6        IF $DATA(PN("AUTH"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE ?20,PN("AUTH"),!

 +7        IF PN("SUBJ")'=""

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE ?19,"Subject:  ",PN("SUBJ"),!

 +8        IF '$LENGTH($GET(PN("SUBJ")))

               IF $LENGTH($GET(ASUB))

                   DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE ?19,"Subject:  ",$GET(ASUB),!

 +9        QUIT

ST(X)     ;   Sub-Titles

 +1        NEW GMTS,GMTS1,GMTS2,GMTST,GMTSB

           SET GMTST=$GET(X)

           if '$LENGTH(GMTST)

               QUIT

 +2        SET GMTST="<< "_GMTST_" >>"

           SET GMTS=""

           SET $PIECE(GMTS,"-",((((79-$LENGTH(GMTST))\2)\2)-6))="-"

 +3        SET $PIECE(GMTS1," ",((((79-$LENGTH(GMTST))\2)\2)+6))=" "

 +4        SET GMTS2=GMTS_GMTS1

           SET GMTS1=GMTS1_GMTS

           SET GMTSB=GMTS1_GMTST_GMTS2

 +5        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !,GMTSB

           DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !

 +6        QUIT

WIH       ;   Interdisciplinary Note Header

 +1        if $DATA(GMTSQIT)

               QUIT

           IF GMTSCNT>1

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !

 +2        WRITE PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE"))

 +3        IF $DATA(PN("VHATYPE"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !?15,"Standard Title: ",PN("VHATYPE"),!

 +4        SET ADATE=$GET(PN("DATE"))

           SET ATYPE=$GET(PN("DOCTYPE"))

           SET ASUB=$GET(PN("SUBJ"))

 +5        IF $LENGTH($GET(PDATE))

               IF $LENGTH($GET(PTYPE))

                   Begin DoDot:1

 +6                    IF $DATA(GMTSREF)

                           DO CKP^GMTSUP

                           if $DATA(GMTSQIT)

                               QUIT

                           WRITE !,?23,"Ref:  ",$EXTRACT(PTYPE,1,25),?55,"Dated:  ",PDATE

                   End DoDot:1

                   if $DATA(GMTSQIT)

                       QUIT

 +7        IF $DATA(PN("AUTH"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !?20,PN("AUTH")

 +8        IF PN("SUBJ")'=""

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !?19,"Subject:  ",PN("SUBJ")

 +9        IF '$LENGTH($GET(PN("SUBJ")))

               IF $LENGTH($GET(PSUB))

                   DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE !?19,"Subject:  ",$GET(PSUB)

 +10       QUIT

WAIH      ;   Addendum to Interdisciplinary Note Header

 +1        if $DATA(GMTSQIT)

               QUIT

           IF GMTSCNT>1

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !

 +2        WRITE PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE"))

 +3        IF $DATA(PN("VHATYPE"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !?15,"Standard Title: ",PN("VHATYPE"),!

 +4        IF $LENGTH($GET(ADATE))

               IF $LENGTH($GET(ATYPE))

                   Begin DoDot:1

 +5                    IF $DATA(GMTSREF)

                           DO CKP^GMTSUP

                           if $DATA(GMTSQIT)

                               QUIT

                           WRITE !,?23,"Ref:  ",$EXTRACT(ATYPE,1,25),?55,"Dated:  ",ADATE

                   End DoDot:1

                   if $DATA(GMTSQIT)

                       QUIT

 +6        IF $LENGTH($GET(PDATE))

               IF $LENGTH($GET(PTYPE))

                   Begin DoDot:1

 +7                    IF $DATA(GMTSREF)

                           DO CKP^GMTSUP

                           if $DATA(GMTSQIT)

                               QUIT

                           WRITE !,?23,"Ref:  ",$EXTRACT(PTYPE,1,29),?55,"Dated:  ",PDATE

                   End DoDot:1

                   if $DATA(GMTSQIT)

                       QUIT

 +8        IF $DATA(PN("AUTH"))

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !?20,PN("AUTH")

 +9        IF PN("SUBJ")'=""

               DO CKP^GMTSUP

               if $DATA(GMTSQIT)

                   QUIT

               WRITE !?19,"Subject:  ",PN("SUBJ")

 +10       IF '$LENGTH($GET(PN("SUBJ")))

               IF $LENGTH($GET(ASUB))

                   DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE !?19,"Subject:  ",$GET(ASUB)

 +11       IF '$LENGTH($GET(PN("SUBJ")))

               IF '$LENGTH($GET(ASUB))

                   IF $LENGTH(PSUB)

                       DO CKP^GMTSUP

                       if $DATA(GMTSQIT)

                           QUIT

                       WRITE !?19,"Subject:  ",$GET(PSUB)

 +12       QUIT

 +13      ; Write Note

WT(X,I)   ;   Write Progress Note Text

 +1        NEW GMTSD,GMTSIEN

           SET GMTSD=$GET(X)

           SET GMTSIEN=$GET(I)

           if '$LENGTH(GMTSIEN)

               QUIT

           if $EXTRACT($PIECE(GMTSD,$JOB,1),1,11)'="^TMP(""TIU"","

               QUIT

 +2        if '$DATA(@($PIECE(GMTSD,",",1,($LENGTH(GMTSD,",")-1))_")"))

               QUIT

           if '$DATA(@(GMTSD_GMTSIEN_")"))

               QUIT

           SET GMTSD=GMTSD_GMTSIEN_",""TEXT"","

 +3        NEW GMTSK

           SET GMTSK=0

FOR

               SET GMTSK=$ORDER(@(GMTSD_GMTSK_")"))

               if +GMTSK'>0

                   QUIT

               Begin DoDot:1

 +4                DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE !,$GET(@(GMTSD_GMTSK_",0)"))

               End DoDot:1

               if $DATA(GMTSQIT)

                   QUIT

 +5        if $DATA(GMTSQIT)

               QUIT

           DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !

 +6        QUIT

WP(X,I)   ;   Writes Problems associated with Note

 +1        if $GET(TIUNAM)["DISCHARGE"

               QUIT

 +2        NEW GMTSD,GMTSIEN

           SET GMTSD=$GET(X)

           SET GMTSIEN=$GET(I)

           if '$LENGTH(GMTSIEN)

               QUIT

           if $EXTRACT($PIECE(GMTSD,$JOB,1),1,11)'="^TMP(""TIU"","

               QUIT

 +3        if '$DATA(@($PIECE(GMTSD,",",1,($LENGTH(GMTSD,",")-1))_")"))

               QUIT

           if '$DATA(@(GMTSD_GMTSIEN_")"))

               QUIT

           SET GMTSD=GMTSD_GMTSIEN_",""PROBLEM"","

 +4        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !,"PROBLEM(S):  "

 +5        NEW GMTSPR

           SET GMTSPR=0

FOR

               SET GMTSPR=$ORDER(@(GMTSD_GMTSPR_")"))

               if +GMTSPR'>0

                   QUIT

               Begin DoDot:1

 +6                if GMTSPR>1

                       DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE !?15,$GET(@(GMTSD_GMTSPR_",0)"))

               End DoDot:1

               if $DATA(GMTSQIT)

                   QUIT

 +7        if $DATA(GMTSQIT)

               QUIT

           DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !

 +8        QUIT

AM(X,I)   ;   Write Amendment

 +1        if $DATA(GMTSQIT)

               QUIT

           NEW GMTSD,GMTSIEN,GMTSA,GMTSI

           SET GMTSD=$GET(X)

           SET GMTSIEN=$GET(I)

           if '$LENGTH(GMTSIEN)

               QUIT

           if $EXTRACT($PIECE(GMTSD,$JOB,1),1,11)'="^TMP(""TIU"","

               QUIT

 +2        if '$DATA(@($PIECE(GMTSD,",",1,($LENGTH(GMTSD,",")-1))_")"))

               QUIT

           if '$DATA(@(GMTSD_GMTSIEN_")"))

               QUIT

 +3        SET GMTSD=GMTSD_GMTSIEN_","

           DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !

 +4        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !,$GET(@(GMTSD_"1601,""E"")")),"  AMENDMENT FILED:"

 +5        IF $GET(@(GMTSD_"1603,""E"")"))'=""

               Begin DoDot:1

 +6                DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE !

 +7                DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE !?10

                   FOR GMTSI=1:1:$LENGTH($GET(@(GMTSD_"1602,""E"")")))

                       WRITE "_"

               End DoDot:1

               if $DATA(GMTSQIT)

                   QUIT

 +8        IF $GET(@(GMTSD_"1604,""E"")"))'=""

               Begin DoDot:1

 +9                DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE !?28,"  /es/ ",$GET(@(GMTSD_"1604,""E"")"))

               End DoDot:1

               if $DATA(GMTSQIT)

                   QUIT

 +10       IF $GET(@(GMTSD_"1605,""E"")"))'=""

               Begin DoDot:1

 +11               DO CKP^GMTSUP

                   if $DATA(GMTSQIT)

                       QUIT

                   WRITE !?34,$GET(@(GMTSD_"1605,""E"")"))

               End DoDot:1

               if $DATA(GMTSQIT)

                   QUIT

 +12       DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !

 +13       QUIT

WDB(X,I)  ;   Writes Brief Discharge Summary

 +1        if $DATA(GMTSQIT)

               QUIT

           NEW GMTSD,GMTSIEN,GMTSA,GMTSI

           SET GMTSD=$GET(X)

           SET GMTSIEN=$GET(I)

           if '$LENGTH(GMTSIEN)

               QUIT

           if $EXTRACT($PIECE(GMTSD,$JOB,1),1,11)'="^TMP(""TIU"","

               QUIT

 +2        if '$DATA(@($PIECE(GMTSD,",",1,($LENGTH(GMTSD,",")-1))_")"))

               QUIT

           if '$DATA(@(GMTSD_GMTSIEN_")"))

               QUIT

 +3        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           if GMTSNPG

               DO WDBH

 +4        WRITE $EXTRACT($GET(ADMIT),1,12),?11,$EXTRACT($GET(DISCHG),1,12),?23,$EXTRACT($GET(AUTHOR),1,14),?38,$EXTRACT($GET(ATTNDNG),1,14),?53,$EXTRACT($GET(COSIG),1,10),?64,$GET(STATUS),!

 +5        QUIT

GMTSPN1.m