GMTSDSB ; SLC/KER - Brief 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 #8925.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="DSB"
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,TIUNAM="DISCHARGE SUMMARY BRIEF" K ^TMP("TIU",$J)
D MAIN^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,GMTSNDM,1)
Q:'$D(^TMP("TIU",$J)) D PNOTE^GMTSPN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDSB 999 printed Nov 22, 2024@17:07:36 Page 2
GMTSDSB ; SLC/KER - Brief 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 #8925.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="DSB"
+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
SET TIUNAM="DISCHARGE SUMMARY BRIEF"
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
