Routine: GMTSPN

GMTSPN ; SLC/KER - Progress Note                     ; 5/17/06 2:06pm

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

 ; External References

 ;    DBIA  2902  VISIT^TIULAPIC

 ;    DBIA  2902  MAIN^TIULAPIC

 ;    DBIA 10006  ^DIC

PN ; Progress Note Health Summary Component

 N TIUSTAT,TIUTYPE,TIUNAM,DIC,TIUFPRIV,TIUXREF,GMTSTIUC,X,Y,GMTSREF

 S TIUFPRIV=1,TIUSTAT="ALL",TIUXREF="""APT""",GMTSTIUC="P",(TIUNAM,X)="PROGRESS NOTES"

 S DIC="^TIU(8925.1,",DIC(0)="X",DIC("S")="I $P($G(^(0)),U,4)=""CL"""

 D ^DIC K DIC("S") S:Y>0 TIUTYPE=+Y S GMTSREF="" D MAIN K GMTSREF

MAIN ; Control branching

 N ADATE,ADMIT,ASUB,ATDATE,ATTNDNG,ATTYPE,ATYPE,AUTHOR,CHILD,CONEED

 N COSAME,COSGEDBY,COSIG,CURIEN,DISCHG,GMTSA,GMTSAI,GMTSAII,GMTSCNT

 N GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSID,GMTSIDC,GMTSII,GMTSIQ

 N GMTSJ,GMTSK,GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX

 N GMTSXTRA,I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,STATUS,TSPEC

 N TYPE,X,Y

 K ^TMP("TIU",$J) S GMTSX=1 D EXTIU Q:'$D(^TMP("TIU",$J))  D PNOTE

 K ^TMP("TIU",$J),PN Q

 ; Progress Notes

 ; ^TMP("TIU",$J,IDT,0)

 ; ^TMP("TIU",$J,IDT,IEN,FLD,"E")

 ; ^TMP("TIU",$J,IDT,IEN,FLD,"I")

 ; ^TMP("TIU",$J,IDT,IEN,"TEXT",0)

 ; ^TMP("TIU",$J,IDT,IEN,"TEXT",#,0)

 ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,FLD,"E")

 ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,FLD,"I")

 ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,"TEXT",0)

 ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,"TEXT",#,0)

 ; ^TMP("TIU",$J,IDT,IEN,"ZZAD",0)

 ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,FLD,"E")

 ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,FLD,"I")

 ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"TEXT",0)

 ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"TEXT",#,0)

 ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"E")

 ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"I")

 ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",0)

 ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",#,0)

 ; Selected Progress Notes

 ; ^TMP("TIU",$J,IDT,#,0)

 ; ^TMP("TIU",$J,IDT,#,IEN,FLD,"E")

 ; ^TMP("TIU",$J,IDT,#,IEN,FLD,"I")

 ; ^TMP("TIU",$J,IDT,#,IEN,"TEXT",0)

 ; ^TMP("TIU",$J,IDT,#,IEN,"TEXT",#,0)

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,FLD,"E")

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,FLD,"I")

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,"TEXT",0)

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,"TEXT",#,0)

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",0)

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,FLD,"E")

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,FLD,"I")

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"TEXT",0)

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"TEXT",#,0)

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"E")

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"I")

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",0)

 ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",#,0)

PNOTE ; Progress Notes

 D CKP^GMTSUP Q:$D(GMTSQIT)  S GMTSD=0 F  S GMTSD=$O(^TMP("TIU",$J,GMTSD)) Q:+GMTSD=0  D

 . S GMTSODIC="^TMP(""TIU"","_$J_","_GMTSD_"," D NOTE

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

SNOTE ; Selected Progress Notes

 D CKP^GMTSUP Q:$D(GMTSQIT)  S GMTSD=0 F  S GMTSD=$O(^TMP("TIU",$J,GMTSD)) Q:+GMTSD=0  D

 . N GMTSS S GMTSS=0 F  S GMTSS=$O(^TMP("TIU",$J,GMTSD,GMTSS)) Q:+GMTSS=0  D

 . . S GMTSODIC="^TMP(""TIU"","_$J_","_GMTSD_","_GMTSS_"," D NOTE

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

NOTE ;   Primary Note

 N GMTSTDIC,GMTSI,GMTSXTRA S GMTSI=0

 F  S GMTSI=$O(@(GMTSODIC_GMTSI_")")) Q:+GMTSI=0  D

 . S (GMTSTDIC,GMTSPDIC,GMTSDIC)=GMTSODIC,(PARIEN,CURIEN)=GMTSI

 . S CHILD=+($G(@(GMTSDIC_CURIEN_",""ZZID"",0)"))),TYPE="",GMTSID=0

 . S:$D(@(GMTSDIC_CURIEN_",""ZZID"")")) TYPE="Parent Interdisciplinary Note",GMTSID=1

 . K PN S PN("#")=CURIEN,PN("#",0)="NOTE"

 . D FLDS(GMTSDIC,CURIEN) D:$D(@(GMTSDIC_CURIEN_",""ZZID"")")) ST^GMTSPN1("Begin Interdisciplinary Note")

 . D WARN1^GMTSPN2 D:$E($G(GMTSTIUC),1)'["D" WH^GMTSPN1

 . D:$G(GMTSTIUC)="DCS" WDH^GMTSPN1

 . D:GMTSCNT=1&($G(GMTSTIUC)="DSB") WDBH^GMTSPN1

 . I $G(GMTSTIUC)="DSB" D WDB^GMTSPN1(GMTSDIC,CURIEN) Q

 . D:$D(@(GMTSDIC_CURIEN_",""PROBLEM"")")) WP^GMTSPN1(GMTSDIC,CURIEN)

 . D WT^GMTSPN1(GMTSDIC,CURIEN),WS^GMTSPN2(GMTSDIC,CURIEN),WARN2^GMTSPN2

 . D:+($G(PN("AMENDMNT")))>0 AM^GMTSPN1(GMTSDIC,CURIEN)

 . D BL^GMTSPN2 N GMTSODIC S GMTSODIC=GMTSTDIC_CURIEN_"," D ANOTE,INOTE

 . I GMTSID D ST^GMTSPN1("End Interdisciplinary Note") S GMTSID=0

ANOTE ;   Addendum to a Progress Note

 N GMTSAI,GMTSXTRA S GMTSAI=0

 F  S GMTSAI=$O(@(GMTSODIC_"""ZADD"","_GMTSAI_")")) Q:+GMTSAI=0  D

 . S (GMTSTDIC,GMTSDIC)=GMTSODIC_"""ZADD"",",CURIEN=GMTSAI

 . K PN S PN("#")=GMTSI_"^"_CURIEN,PN("#",0)="ADDENDUM TO A NOTE",TYPE=""

 . S:$D(@(GMTSPDIC_PARIEN_",""ZZID"")")) TYPE="Addendum to a Parent Interdisciplinary Note"

 . D FLDS(GMTSDIC,CURIEN),WARN1^GMTSPN2,WAH^GMTSPN1

 . D WT^GMTSPN1(GMTSDIC,CURIEN),WS^GMTSPN2(GMTSDIC,CURIEN),WARN2^GMTSPN2,BL^GMTSPN2

INOTE ;   Interdisciplinary Progress Note

 Q:+($G(@(GMTSODIC_"""ZZID"",0)")))'>0

 N GMTSIQ,GMTSII,GMTSXTRA S GMTSIQ=0

 F  S GMTSIQ=$O(@(GMTSODIC_"""ZZID"","_GMTSIQ_")")) Q:+GMTSIQ=0  D

 . S GMTSTDIC=GMTSODIC N GMTSODIC S GMTSODIC=GMTSTDIC_"""ZZID"","_GMTSIQ_","

 . S GMTSII=0 F  S GMTSII=$O(@(GMTSODIC_GMTSII_")")) Q:+GMTSII=0  D

 . . S GMTSDIC=GMTSODIC,CURIEN=GMTSII

 . . K PN S PN("#")=GMTSI_"^"_CURIEN,PN("#",0)="INTERDISCIPLINARY NOTE"

 . . S TYPE="Child Interdisciplinary Note"

 . . D FLDS(GMTSDIC,CURIEN),ST^GMTSPN1("Interdisciplinary Note Cont.")

 . . D WARN1^GMTSPN2,WIH^GMTSPN1 D:$D(@(GMTSDIC_CURIEN_",""PROBLEM"")")) WP^GMTSPN1(GMTSDIC,CURIEN)

 . . D WT^GMTSPN1(GMTSDIC,CURIEN),WS^GMTSPN2(GMTSDIC,CURIEN)

 . . D WARN2^GMTSPN2 D:+($G(PN("AMENDMNT")))>0 AM^GMTSPN1(GMTSDIC,CURIEN) D BL^GMTSPN2

 . . S GMTSTDIC=GMTSODIC N GMTSODIC S GMTSODIC=GMTSTDIC_GMTSII_",""ZADD"","

 . . D AINOTE

AINOTE ;   Addendum to an Interdisciplinary Progress Note

 N GMTSAII,GMTSXTRA S GMTSAII=0

 F  S GMTSAII=$O(@(GMTSODIC_GMTSAII_")")) Q:+GMTSAII=0  D

 . S GMTSDIC=GMTSODIC,CURIEN=GMTSAII

 . K PN S PN("#")=GMTSI_"^"_GMTSII_"^"_CURIEN

 . S PN("#",0)="ADDENDUM TO AN INTERDISCIPLINARY NOTE"

 . S TYPE="Addendum to a Child Interdisciplinary Note"

 . D FLDS(GMTSDIC,CURIEN),WARN1^GMTSPN2,WAIH^GMTSPN1,WT^GMTSPN1(GMTSDIC,CURIEN)

 . D WS^GMTSPN2(GMTSDIC,CURIEN),WARN2^GMTSPN2,BL^GMTSPN2

 ; Get Data

EXTIU ;   Extract Patient/Visit VIA TIU

 N MAX S DFN=+($G(DFN)) Q:DFN=0  S TIUTYPE=+($G(TIUTYPE)) Q:TIUTYPE=0

 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)

 S GMTS1=+($G(GMTS1)) Q:GMTS1=0  S GMTS2=+($G(GMTS2)) Q:GMTS2=0  S GMTSX=+($G(GMTSX))

 I +($G(GMTSPXGO))>0,$L($T(VISIT^TIULAPIC)) D VISIT^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,MAX,+($G(GMTSX))) Q

 D MAIN^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,MAX,+($G(GMTSX)))

FLDS(X,I) ; Get Fields

 N GMTSDIC,GMTSIEN

 S GMTSDIC=$G(X),GMTSIEN=$G(I) Q:'$L(GMTSIEN)

 Q:$E($P(GMTSDIC,$J,1),1,11)'="^TMP(""TIU"","

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

 Q:'$D(@(GMTSDIC_GMTSIEN_")"))

 S GMTSDIC=GMTSDIC_GMTSIEN_","

 N GMTSXTRA S GMTSCNT=+$G(GMTSCNT)+1

 S X=$G(@(GMTSDIC_".07,""I"")")) D REGDT4^GMTSU S ADMIT=X

 S X=$G(@(GMTSDIC_".08,""I"")")) D REGDT4^GMTSU S DISCHG=X

 S:+DISCHG'>0 DISCHG="Present"

 S:+ADMIT'>0 ADMIT="Unknown"

 S AUTHOR=$G(@(GMTSDIC_"1202,""E"")"))

 S ATTNDNG=$G(@(GMTSDIC_"1209,""E"")"))

 S TSPEC=$G(@(GMTSDIC_"1402,""E"")"))

 S STATUS=$G(@(GMTSDIC_".05,""E"")"))

 S PN("DATE")=$G(@(GMTSDIC_"1301,""I"")"))

 I PN("DATE")]"" S PN("DATE")=$$EDT^GMTSU(PN("DATE"))

 S REASON="",PN("DOCTYPE")=$G(@(GMTSDIC_".01,""E"")"))

 S PN("VHATYPE")=$G(@(GMTSDIC_"89261,""E"")"))

 S PN("STATUS")=$G(@(GMTSDIC_".05,""E"")"))

 S PN("AUTHOR")=$G(@(GMTSDIC_"1202,""E"")"))

 S PN("EXPSIGNR")=$G(@(GMTSDIC_"1204,""E"")"))

 S PN("LOC")=$G(@(GMTSDIC_"1205,""E"")"))

 S PN("EXPCOSNR")=$G(@(GMTSDIC_"1208,""E"")"))

 S:$G(@(GMTSDIC_"1307,""I"")"))'="" PN("DDATE")=$$ED^GMTSU($G(@(GMTSDIC_"1307,""I"")")))

 S:$G(@(GMTSDIC_"1501,""I"")"))'="" PN("SIGNDATE")=$$ED^GMTSU($G(@(GMTSDIC_"1501,""I"")")))

 S PN("SIGDT")=$G(@(GMTSDIC_"1501,""I"")"))

 I PN("SIGDT")]"" S PN("SIGDT")=$$EDT^GMTSU(PN("SIGDT"))

 S SIGNEDBY=$G(@(GMTSDIC_"1502,""I"")"))

 S PN("SIGBLK")=$G(@(GMTSDIC_"1503,""E"")"))

 S PN("STITLE")=$G(@(GMTSDIC_"1504,""E"")"))

 S PN("COSDT")=$G(@(GMTSDIC_"1507,""I"")"))

 I PN("COSDT")]"" S (COSIG,PN("COSDT"))=$$EDT^GMTSU(PN("COSDT"))

 S COSGEDBY=$G(@(GMTSDIC_"1508,""I"")"))

 S CONEED=0 S:+($G(COSGEDBY))>0 CONEED=1

 S PN("COBLK")=$G(@(GMTSDIC_"1509,""E"")"))

 S PN("COTITLE")=$G(@(GMTSDIC_"1510,""E"")"))

 S COSAME=$S(+($G(SIGNEDBY))>0&(+($G(SIGNEDBY))=+($G(COSGEDBY))):1,1:0)

 S:CONEED>0 CONEED=$S(COSAME=1:0,1:CONEED)

 S PN("SUBJ")=$G(@(GMTSDIC_"1701,""E"")"))

 I $G(@(GMTSDIC_"1505,""I"")"))="C" D

 . S PN("SCHART")="Signed on Chart by:",PN("SCHARTBY")="."

 . S:$G(@(GMTSDIC_"1512,""E"")"))'="" PN("SCHARTBY")=$G(@(GMTSDIC_"1512,""E"")"))

 I $E($G(GMTSTIUC),1)'["D",$G(@(GMTSDIC_"1511,""I"")"))="C" D

 . S PN("COCHART")="Cosigned on Chart by:",PN("COCHARTBY")="."

 . S:$G(@(GMTSDIC_"1513,""E"")"))'="" PN("COCHARTBY")=$G(@(GMTSDIC_"1513,""E"")"))

 I $E($G(GMTSTIUC),1)["D",CONEED,$G(@(GMTSDIC_"1511,""I"")"))="C" D

 . S PN("COCHART")="Cosigned on Chart by:",PN("COCHARTBY")="."

 . S:$G(@(GMTSDIC_"1513,""E"")"))'="" PN("COCHARTBY")=$G(@(GMTSDIC_"1513,""E"")"))

 S:$G(@(GMTSDIC_"1202,""I"")"))'=$G(@(GMTSDIC_"1502,""I"")")) PN("AUTH")="AUTHOR:  "_PN("AUTHOR")

 S PN("AMENDMNT")=+($G(@(GMTSDIC_"1601,""I"")")))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPN   9622     printed  Mar 13, 2025@21:04:07                                                                                                                                                                                                      Page 2

GMTSPN    ; SLC/KER - Progress Note                     ; 5/17/06 2:06pm

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

 +2       ;

 +3       ; External References

 +4       ;    DBIA  2902  VISIT^TIULAPIC

 +5       ;    DBIA  2902  MAIN^TIULAPIC

 +6       ;    DBIA 10006  ^DIC

 +7       ;

PN        ; Progress Note Health Summary Component

 +1        NEW TIUSTAT,TIUTYPE,TIUNAM,DIC,TIUFPRIV,TIUXREF,GMTSTIUC,X,Y,GMTSREF

 +2        SET TIUFPRIV=1

           SET TIUSTAT="ALL"

           SET TIUXREF="""APT"""

           SET GMTSTIUC="P"

           SET (TIUNAM,X)="PROGRESS NOTES"

 +3        SET DIC="^TIU(8925.1,"

           SET DIC(0)="X"

           SET DIC("S")="I $P($G(^(0)),U,4)=""CL"""

 +4        DO ^DIC

           KILL DIC("S")

           if Y>0

               SET TIUTYPE=+Y

           SET GMTSREF=""

           DO MAIN

           KILL GMTSREF

 +5        QUIT

MAIN      ; Control branching

 +1        NEW ADATE,ADMIT,ASUB,ATDATE,ATTNDNG,ATTYPE,ATYPE,AUTHOR,CHILD,CONEED

 +2        NEW COSAME,COSGEDBY,COSIG,CURIEN,DISCHG,GMTSA,GMTSAI,GMTSAII,GMTSCNT

 +3        NEW GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSID,GMTSIDC,GMTSII,GMTSIQ

 +4        NEW GMTSJ,GMTSK,GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX

 +5        NEW GMTSXTRA,I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,STATUS,TSPEC

 +6        NEW TYPE,X,Y

 +7        KILL ^TMP("TIU",$JOB)

           SET GMTSX=1

           DO EXTIU

           if '$DATA(^TMP("TIU",$JOB))

               QUIT

           DO PNOTE

 +8        KILL ^TMP("TIU",$JOB),PN

           QUIT

 +9       ;

 +10      ; Progress Notes

 +11      ;

 +12      ; ^TMP("TIU",$J,IDT,0)

 +13      ; ^TMP("TIU",$J,IDT,IEN,FLD,"E")

 +14      ; ^TMP("TIU",$J,IDT,IEN,FLD,"I")

 +15      ; ^TMP("TIU",$J,IDT,IEN,"TEXT",0)

 +16      ; ^TMP("TIU",$J,IDT,IEN,"TEXT",#,0)

 +17      ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,FLD,"E")

 +18      ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,FLD,"I")

 +19      ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,"TEXT",0)

 +20      ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,"TEXT",#,0)

 +21      ; ^TMP("TIU",$J,IDT,IEN,"ZZAD",0)

 +22      ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,FLD,"E")

 +23      ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,FLD,"I")

 +24      ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"TEXT",0)

 +25      ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"TEXT",#,0)

 +26      ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"E")

 +27      ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"I")

 +28      ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",0)

 +29      ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",#,0)

 +30      ;

 +31      ; Selected Progress Notes

 +32      ;

 +33      ; ^TMP("TIU",$J,IDT,#,0)

 +34      ; ^TMP("TIU",$J,IDT,#,IEN,FLD,"E")

 +35      ; ^TMP("TIU",$J,IDT,#,IEN,FLD,"I")

 +36      ; ^TMP("TIU",$J,IDT,#,IEN,"TEXT",0)

 +37      ; ^TMP("TIU",$J,IDT,#,IEN,"TEXT",#,0)

 +38      ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,FLD,"E")

 +39      ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,FLD,"I")

 +40      ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,"TEXT",0)

 +41      ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,"TEXT",#,0)

 +42      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",0)

 +43      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,FLD,"E")

 +44      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,FLD,"I")

 +45      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"TEXT",0)

 +46      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"TEXT",#,0)

 +47      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"E")

 +48      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"I")

 +49      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",0)

 +50      ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",#,0)

 +51      ;

PNOTE     ; Progress Notes

 +1        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           SET GMTSD=0

FOR

               SET GMTSD=$ORDER(^TMP("TIU",$JOB,GMTSD))

               if +GMTSD=0

                   QUIT

               Begin DoDot:1

 +2                SET GMTSODIC="^TMP(""TIU"","_$JOB_","_GMTSD_","

                   DO NOTE

               End DoDot:1

 +3        if $DATA(GMTSQIT)

               QUIT

           DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !

           QUIT

SNOTE     ; Selected Progress Notes

 +1        DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           SET GMTSD=0

FOR

               SET GMTSD=$ORDER(^TMP("TIU",$JOB,GMTSD))

               if +GMTSD=0

                   QUIT

               Begin DoDot:1

 +2                NEW GMTSS

                   SET GMTSS=0

FOR

                       SET GMTSS=$ORDER(^TMP("TIU",$JOB,GMTSD,GMTSS))

                       if +GMTSS=0

                           QUIT

                       Begin DoDot:2

 +3                        SET GMTSODIC="^TMP(""TIU"","_$JOB_","_GMTSD_","_GMTSS_","

                           DO NOTE

                       End DoDot:2

               End DoDot:1

 +4        if $DATA(GMTSQIT)

               QUIT

           DO CKP^GMTSUP

           if $DATA(GMTSQIT)

               QUIT

           WRITE !

           QUIT

 +5       ;

NOTE      ;   Primary Note

 +1        NEW GMTSTDIC,GMTSI,GMTSXTRA

           SET GMTSI=0

 +2        FOR

               SET GMTSI=$ORDER(@(GMTSODIC_GMTSI_")"))

               if +GMTSI=0

                   QUIT

               Begin DoDot:1

 +3                SET (GMTSTDIC,GMTSPDIC,GMTSDIC)=GMTSODIC

                   SET (PARIEN,CURIEN)=GMTSI

 +4                SET CHILD=+($GET(@(GMTSDIC_CURIEN_",""ZZID"",0)")))

                   SET TYPE=""

                   SET GMTSID=0

 +5                if $DATA(@(GMTSDIC_CURIEN_",""ZZID"")"))

                       SET TYPE="Parent Interdisciplinary Note"

                       SET GMTSID=1

 +6                KILL PN

                   SET PN("#")=CURIEN

                   SET PN("#",0)="NOTE"

 +7                DO FLDS(GMTSDIC,CURIEN)

                   if $DATA(@(GMTSDIC_CURIEN_",""ZZID"")"))

                       DO ST^GMTSPN1("Begin Interdisciplinary Note")

 +8                DO WARN1^GMTSPN2

                   if $EXTRACT($GET(GMTSTIUC),1)'["D"

                       DO WH^GMTSPN1

 +9                if $GET(GMTSTIUC)="DCS"

                       DO WDH^GMTSPN1

 +10               if GMTSCNT=1&($GET(GMTSTIUC)="DSB")

                       DO WDBH^GMTSPN1

 +11               IF $GET(GMTSTIUC)="DSB"

                       DO WDB^GMTSPN1(GMTSDIC,CURIEN)

                       QUIT

 +12               if $DATA(@(GMTSDIC_CURIEN_",""PROBLEM"")"))

                       DO WP^GMTSPN1(GMTSDIC,CURIEN)

 +13               DO WT^GMTSPN1(GMTSDIC,CURIEN)

                   DO WS^GMTSPN2(GMTSDIC,CURIEN)

                   DO WARN2^GMTSPN2

 +14               if +($GET(PN("AMENDMNT")))>0

                       DO AM^GMTSPN1(GMTSDIC,CURIEN)

 +15               DO BL^GMTSPN2

                   NEW GMTSODIC

                   SET GMTSODIC=GMTSTDIC_CURIEN_","

                   DO ANOTE

                   DO INOTE

 +16               IF GMTSID

                       DO ST^GMTSPN1("End Interdisciplinary Note")

                       SET GMTSID=0

               End DoDot:1

 +17       QUIT

ANOTE     ;   Addendum to a Progress Note

 +1        NEW GMTSAI,GMTSXTRA

           SET GMTSAI=0

 +2        FOR

               SET GMTSAI=$ORDER(@(GMTSODIC_"""ZADD"","_GMTSAI_")"))

               if +GMTSAI=0

                   QUIT

               Begin DoDot:1

 +3                SET (GMTSTDIC,GMTSDIC)=GMTSODIC_"""ZADD"","

                   SET CURIEN=GMTSAI

 +4                KILL PN

                   SET PN("#")=GMTSI_"^"_CURIEN

                   SET PN("#",0)="ADDENDUM TO A NOTE"

                   SET TYPE=""

 +5                if $DATA(@(GMTSPDIC_PARIEN_",""ZZID"")"))

                       SET TYPE="Addendum to a Parent Interdisciplinary Note"

 +6                DO FLDS(GMTSDIC,CURIEN)

                   DO WARN1^GMTSPN2

                   DO WAH^GMTSPN1

 +7                DO WT^GMTSPN1(GMTSDIC,CURIEN)

                   DO WS^GMTSPN2(GMTSDIC,CURIEN)

                   DO WARN2^GMTSPN2

                   DO BL^GMTSPN2

               End DoDot:1

 +8        QUIT

INOTE     ;   Interdisciplinary Progress Note

 +1        if +($GET(@(GMTSODIC_"""ZZID"",0)")))'>0

               QUIT

 +2        NEW GMTSIQ,GMTSII,GMTSXTRA

           SET GMTSIQ=0

 +3        FOR

               SET GMTSIQ=$ORDER(@(GMTSODIC_"""ZZID"","_GMTSIQ_")"))

               if +GMTSIQ=0

                   QUIT

               Begin DoDot:1

 +4                SET GMTSTDIC=GMTSODIC

                   NEW GMTSODIC

                   SET GMTSODIC=GMTSTDIC_"""ZZID"","_GMTSIQ_","

 +5                SET GMTSII=0

FOR

                       SET GMTSII=$ORDER(@(GMTSODIC_GMTSII_")"))

                       if +GMTSII=0

                           QUIT

                       Begin DoDot:2

 +6                        SET GMTSDIC=GMTSODIC

                           SET CURIEN=GMTSII

 +7                        KILL PN

                           SET PN("#")=GMTSI_"^"_CURIEN

                           SET PN("#",0)="INTERDISCIPLINARY NOTE"

 +8                        SET TYPE="Child Interdisciplinary Note"

 +9                        DO FLDS(GMTSDIC,CURIEN)

                           DO ST^GMTSPN1("Interdisciplinary Note Cont.")

 +10                       DO WARN1^GMTSPN2

                           DO WIH^GMTSPN1

                           if $DATA(@(GMTSDIC_CURIEN_",""PROBLEM"")"))

                               DO WP^GMTSPN1(GMTSDIC,CURIEN)

 +11                       DO WT^GMTSPN1(GMTSDIC,CURIEN)

                           DO WS^GMTSPN2(GMTSDIC,CURIEN)

 +12                       DO WARN2^GMTSPN2

                           if +($GET(PN("AMENDMNT")))>0

                               DO AM^GMTSPN1(GMTSDIC,CURIEN)

                           DO BL^GMTSPN2

 +13                       SET GMTSTDIC=GMTSODIC

                           NEW GMTSODIC

                           SET GMTSODIC=GMTSTDIC_GMTSII_",""ZADD"","

 +14                       DO AINOTE

                       End DoDot:2

               End DoDot:1

 +15       QUIT

AINOTE    ;   Addendum to an Interdisciplinary Progress Note

 +1        NEW GMTSAII,GMTSXTRA

           SET GMTSAII=0

 +2        FOR

               SET GMTSAII=$ORDER(@(GMTSODIC_GMTSAII_")"))

               if +GMTSAII=0

                   QUIT

               Begin DoDot:1

 +3                SET GMTSDIC=GMTSODIC

                   SET CURIEN=GMTSAII

 +4                KILL PN

                   SET PN("#")=GMTSI_"^"_GMTSII_"^"_CURIEN

 +5                SET PN("#",0)="ADDENDUM TO AN INTERDISCIPLINARY NOTE"

 +6                SET TYPE="Addendum to a Child Interdisciplinary Note"

 +7                DO FLDS(GMTSDIC,CURIEN)

                   DO WARN1^GMTSPN2

                   DO WAIH^GMTSPN1

                   DO WT^GMTSPN1(GMTSDIC,CURIEN)

 +8                DO WS^GMTSPN2(GMTSDIC,CURIEN)

                   DO WARN2^GMTSPN2

                   DO BL^GMTSPN2

               End DoDot:1

 +9        QUIT

 +10      ;

 +11      ; Get Data

EXTIU     ;   Extract Patient/Visit VIA TIU

 +1        NEW MAX

           SET DFN=+($GET(DFN))

           if DFN=0

               QUIT

           SET TIUTYPE=+($GET(TIUTYPE))

           if TIUTYPE=0

               QUIT

 +2        SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:99999)

 +3        SET GMTS1=+($GET(GMTS1))

           if GMTS1=0

               QUIT

           SET GMTS2=+($GET(GMTS2))

           if GMTS2=0

               QUIT

           SET GMTSX=+($GET(GMTSX))

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

               IF $LENGTH($TEXT(VISIT^TIULAPIC))

                   DO VISIT^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,MAX,+($GET(GMTSX)))

                   QUIT

 +5        DO MAIN^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,MAX,+($GET(GMTSX)))

 +6        QUIT

FLDS(X,I) ; Get Fields

 +1        NEW GMTSDIC,GMTSIEN

 +2        SET GMTSDIC=$GET(X)

           SET GMTSIEN=$GET(I)

           if '$LENGTH(GMTSIEN)

               QUIT

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

               QUIT

 +4        if '$DATA(@($PIECE(GMTSDIC,",",1,($LENGTH(GMTSDIC,",")-1))_")"))

               QUIT

 +5        if '$DATA(@(GMTSDIC_GMTSIEN_")"))

               QUIT

 +6        SET GMTSDIC=GMTSDIC_GMTSIEN_","

 +7        NEW GMTSXTRA

           SET GMTSCNT=+$GET(GMTSCNT)+1

 +8        SET X=$GET(@(GMTSDIC_".07,""I"")"))

           DO REGDT4^GMTSU

           SET ADMIT=X

 +9        SET X=$GET(@(GMTSDIC_".08,""I"")"))

           DO REGDT4^GMTSU

           SET DISCHG=X

 +10       if +DISCHG'>0

               SET DISCHG="Present"

 +11       if +ADMIT'>0

               SET ADMIT="Unknown"

 +12       SET AUTHOR=$GET(@(GMTSDIC_"1202,""E"")"))

 +13       SET ATTNDNG=$GET(@(GMTSDIC_"1209,""E"")"))

 +14       SET TSPEC=$GET(@(GMTSDIC_"1402,""E"")"))

 +15       SET STATUS=$GET(@(GMTSDIC_".05,""E"")"))

 +16       SET PN("DATE")=$GET(@(GMTSDIC_"1301,""I"")"))

 +17       IF PN("DATE")]""

               SET PN("DATE")=$$EDT^GMTSU(PN("DATE"))

 +18       SET REASON=""

           SET PN("DOCTYPE")=$GET(@(GMTSDIC_".01,""E"")"))

 +19       SET PN("VHATYPE")=$GET(@(GMTSDIC_"89261,""E"")"))

 +20       SET PN("STATUS")=$GET(@(GMTSDIC_".05,""E"")"))

 +21       SET PN("AUTHOR")=$GET(@(GMTSDIC_"1202,""E"")"))

 +22       SET PN("EXPSIGNR")=$GET(@(GMTSDIC_"1204,""E"")"))

 +23       SET PN("LOC")=$GET(@(GMTSDIC_"1205,""E"")"))

 +24       SET PN("EXPCOSNR")=$GET(@(GMTSDIC_"1208,""E"")"))

 +25       if $GET(@(GMTSDIC_"1307,""I"")"))'=""

               SET PN("DDATE")=$$ED^GMTSU($GET(@(GMTSDIC_"1307,""I"")")))

 +26       if $GET(@(GMTSDIC_"1501,""I"")"))'=""

               SET PN("SIGNDATE")=$$ED^GMTSU($GET(@(GMTSDIC_"1501,""I"")")))

 +27       SET PN("SIGDT")=$GET(@(GMTSDIC_"1501,""I"")"))

 +28       IF PN("SIGDT")]""

               SET PN("SIGDT")=$$EDT^GMTSU(PN("SIGDT"))

 +29       SET SIGNEDBY=$GET(@(GMTSDIC_"1502,""I"")"))

 +30       SET PN("SIGBLK")=$GET(@(GMTSDIC_"1503,""E"")"))

 +31       SET PN("STITLE")=$GET(@(GMTSDIC_"1504,""E"")"))

 +32       SET PN("COSDT")=$GET(@(GMTSDIC_"1507,""I"")"))

 +33       IF PN("COSDT")]""

               SET (COSIG,PN("COSDT"))=$$EDT^GMTSU(PN("COSDT"))

 +34       SET COSGEDBY=$GET(@(GMTSDIC_"1508,""I"")"))

 +35       SET CONEED=0

           if +($GET(COSGEDBY))>0

               SET CONEED=1

 +36       SET PN("COBLK")=$GET(@(GMTSDIC_"1509,""E"")"))

 +37       SET PN("COTITLE")=$GET(@(GMTSDIC_"1510,""E"")"))

 +38       SET COSAME=$SELECT(+($GET(SIGNEDBY))>0&(+($GET(SIGNEDBY))=+($GET(COSGEDBY))):1,1:0)

 +39       if CONEED>0

               SET CONEED=$SELECT(COSAME=1:0,1:CONEED)

 +40       SET PN("SUBJ")=$GET(@(GMTSDIC_"1701,""E"")"))

 +41       IF $GET(@(GMTSDIC_"1505,""I"")"))="C"

               Begin DoDot:1

 +42               SET PN("SCHART")="Signed on Chart by:"

                   SET PN("SCHARTBY")="."

 +43               if $GET(@(GMTSDIC_"1512,""E"")"))'=""

                       SET PN("SCHARTBY")=$GET(@(GMTSDIC_"1512,""E"")"))

               End DoDot:1

 +44       IF $EXTRACT($GET(GMTSTIUC),1)'["D"

               IF $GET(@(GMTSDIC_"1511,""I"")"))="C"

                   Begin DoDot:1

 +45                   SET PN("COCHART")="Cosigned on Chart by:"

                       SET PN("COCHARTBY")="."

 +46                   if $GET(@(GMTSDIC_"1513,""E"")"))'=""

                           SET PN("COCHARTBY")=$GET(@(GMTSDIC_"1513,""E"")"))

                   End DoDot:1

 +47       IF $EXTRACT($GET(GMTSTIUC),1)["D"

               IF CONEED

                   IF $GET(@(GMTSDIC_"1511,""I"")"))="C"

                       Begin DoDot:1

 +48                       SET PN("COCHART")="Cosigned on Chart by:"

                           SET PN("COCHARTBY")="."

 +49                       if $GET(@(GMTSDIC_"1513,""E"")"))'=""

                               SET PN("COCHARTBY")=$GET(@(GMTSDIC_"1513,""E"")"))

                       End DoDot:1

 +50       if $GET(@(GMTSDIC_"1202,""I"")"))'=$GET(@(GMTSDIC_"1502,""I"")"))

               SET PN("AUTH")="AUTHOR:  "_PN("AUTHOR")

 +51       SET PN("AMENDMNT")=+($GET(@(GMTSDIC_"1601,""I"")")))

 +52       QUIT

GMTSPN.m