Routine: GMTSDS

GMTSDS ; SLC/KER - Discharge Summary              ; 09/21/2001

 ;;2.7;Health Summary;**12,28,35,45,47**;Oct 20, 1995

 ; External References

 ;    DBIA  2902  MAIN^TIULAPIC

 ;    DBIA 10006  ^DIC (file #8935.1)

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,GMTSII,GMTSIQ,GMTSJ,GMTSK

 N GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX,GMTSXTRA

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

 N TIUTYPE,TIUFPRIV,TIUNAM,GMTSTIUC,DIC,X,Y S (TIUNAM,X)="DISCHARGE SUMMARY",GMTSTIUC="DCS"

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

 D ^DIC Q:+($G(Y))=0  S TIUTYPE=+Y K ^TMP("TIU",$J)

 D MAIN^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,GMTSNDM,1)

 Q:'$D(^TMP("TIU",$J))  D PNOTE^GMTSPN Q

GMTSDS    ; SLC/KER - Discharge Summary              ; 09/21/2001

 +1       ;;2.7;Health Summary;**12,28,35,45,47**;Oct 20, 1995

 +2       ;

 +3       ; External References

 +4       ;    DBIA  2902  MAIN^TIULAPIC

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

 +6       ;

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,GMTSII,GMTSIQ,GMTSJ,GMTSK

 +4        NEW GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX,GMTSXTRA

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

 +6        NEW TIUTYPE,TIUFPRIV,TIUNAM,GMTSTIUC,DIC,X,Y

           SET (TIUNAM,X)="DISCHARGE SUMMARY"

           SET GMTSTIUC="DCS"

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

           SET DIC(0)="X"

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

 +8        DO ^DIC

           IF +($GET(Y))=0

               QUIT

           SET TIUTYPE=+Y

           KILL ^TMP("TIU",$JOB)

 +9        DO MAIN^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,GMTSNDM,1)

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

               QUIT

           DO PNOTE^GMTSPN

           QUIT

GMTSDS.m