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
Q
;
; 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"),!
Q
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,!
Q
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),!
Q
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 !
Q
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)
Q
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)
Q
; 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 !
Q
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 !
Q
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 !
Q
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),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPN1 6356 printed Sep 15, 2024@21:23:31 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
