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
Q
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
Q
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
Q
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
Q
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
Q
;
; 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)))
Q
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"")")))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPN 9622 printed Nov 22, 2024@17:09:26 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
