GMTSPNSL.m

GMTSPNSL ; SLC/KER - Progress Note - Selected          ; 08/27/2002

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

 ;                          

 ; External References

 ;    DBIA  3062  MAIN^TIULAPIS

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

 ;                     

MAIN ; Control branching

 N ADATE,ASUB,ATDATE,ATTYPE,ATYPE,CHILD,COSGEDBY,CURIEN,GMTSA,GMTSAI

 N GMTSAII,GMTSCNT,GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSII,GMTSIQ

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

 N GMTSXTRA,GMTDOC,I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,TYPE

 N TIUDOC,TIUSTAT,GMTSTIUC,X,Y K ^TMP("TIU",$J) S GMTSX=1,GMTSI=0,GMTSTIUC="P"

 F  S GMTSI=$O(GMTSEG(+GMTSEGN,8925.1,GMTSI)) Q:+GMTSI'>0  D

 . S TIUDOC(GMTSI)=+$G(GMTSEG(+GMTSEGN,8925.1,GMTSI))

 . S GMTDOC(GMTSI)=$$GET1^DIQ(8925.1,(+(TIUDOC(GMTSI))_","),.01)

 . S:$L($G(GMTDOC(GMTSI))) GMTDOC("B",GMTDOC(GMTSI),GMTSI)=""

 D MAIN^TIULAPIS(DFN,.TIUDOC,"ALL",GMTS1,GMTS2,GMTSNDM,GMTSX)

 Q:'$D(^TMP("TIU",$J))  D SNOTE^GMTSPN K ^TMP("TIU",$J),PN Q

GMTSPNSL  ; SLC/KER - Progress Note - Selected          ; 08/27/2002

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

 +2       ;                          

 +3       ; External References

 +4       ;    DBIA  3062  MAIN^TIULAPIS

 +5       ;    DBIA  2056  $$GET1^DIQ (file #8925.1)

 +6       ;                     

MAIN      ; Control branching

 +1        NEW ADATE,ASUB,ATDATE,ATTYPE,ATYPE,CHILD,COSGEDBY,CURIEN,GMTSA,GMTSAI

 +2        NEW GMTSAII,GMTSCNT,GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSII,GMTSIQ

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

 +4        NEW GMTSXTRA,GMTDOC,I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,TYPE

 +5        NEW TIUDOC,TIUSTAT,GMTSTIUC,X,Y

           KILL ^TMP("TIU",$JOB)

           SET GMTSX=1

           SET GMTSI=0

           SET GMTSTIUC="P"

 +6        FOR 

               SET GMTSI=$ORDER(GMTSEG(+GMTSEGN,8925.1,GMTSI))

               IF +GMTSI'>0

                   QUIT 

               Begin DoDot:1

 +7                SET TIUDOC(GMTSI)=+$GET(GMTSEG(+GMTSEGN,8925.1,GMTSI))

 +8                SET GMTDOC(GMTSI)=$$GET1^DIQ(8925.1,(+(TIUDOC(GMTSI))_","),.01)

 +9                IF $LENGTH($GET(GMTDOC(GMTSI)))

                       SET GMTDOC("B",GMTDOC(GMTSI),GMTSI)=""

               End DoDot:1

 +10       DO MAIN^TIULAPIS(DFN,.TIUDOC,"ALL",GMTS1,GMTS2,GMTSNDM,GMTSX)

 +11       IF '$DATA(^TMP("TIU",$JOB))

               QUIT 

           DO SNOTE^GMTSPN

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

           QUIT