[613] | 1 | GMTSPN ; SLC/KER - Progress Note ; 5/17/06 2:06pm
|
---|
| 2 | ;;2.7;Health Summary;**12,28,33,35,45,47,49,55,81**;Oct 20, 1995;Build 23
|
---|
| 3 | ;
|
---|
| 4 | ; External References
|
---|
| 5 | ; DBIA 2902 VISIT^TIULAPIC
|
---|
| 6 | ; DBIA 2902 MAIN^TIULAPIC
|
---|
| 7 | ; DBIA 10006 ^DIC
|
---|
| 8 | ;
|
---|
| 9 | PN ; Progress Note Health Summary Component
|
---|
| 10 | N TIUSTAT,TIUTYPE,TIUNAM,DIC,TIUFPRIV,TIUXREF,GMTSTIUC,X,Y,GMTSREF
|
---|
| 11 | S TIUFPRIV=1,TIUSTAT="ALL",TIUXREF="""APT""",GMTSTIUC="P",(TIUNAM,X)="PROGRESS NOTES"
|
---|
| 12 | S DIC="^TIU(8925.1,",DIC(0)="X",DIC("S")="I $P($G(^(0)),U,4)=""CL"""
|
---|
| 13 | D ^DIC K DIC("S") S:Y>0 TIUTYPE=+Y S GMTSREF="" D MAIN K GMTSREF
|
---|
| 14 | Q
|
---|
| 15 | MAIN ; Control branching
|
---|
| 16 | N ADATE,ADMIT,ASUB,ATDATE,ATTNDNG,ATTYPE,ATYPE,AUTHOR,CHILD,CONEED
|
---|
| 17 | N COSAME,COSGEDBY,COSIG,CURIEN,DISCHG,GMTSA,GMTSAI,GMTSAII,GMTSCNT
|
---|
| 18 | N GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSID,GMTSIDC,GMTSII,GMTSIQ
|
---|
| 19 | N GMTSJ,GMTSK,GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX
|
---|
| 20 | N GMTSXTRA,I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,STATUS,TSPEC
|
---|
| 21 | N TYPE,X,Y
|
---|
| 22 | K ^TMP("TIU",$J) S GMTSX=1 D EXTIU Q:'$D(^TMP("TIU",$J)) D PNOTE
|
---|
| 23 | K ^TMP("TIU",$J),PN Q
|
---|
| 24 | ;
|
---|
| 25 | ; Progress Notes
|
---|
| 26 | ;
|
---|
| 27 | ; ^TMP("TIU",$J,IDT,0)
|
---|
| 28 | ; ^TMP("TIU",$J,IDT,IEN,FLD,"E")
|
---|
| 29 | ; ^TMP("TIU",$J,IDT,IEN,FLD,"I")
|
---|
| 30 | ; ^TMP("TIU",$J,IDT,IEN,"TEXT",0)
|
---|
| 31 | ; ^TMP("TIU",$J,IDT,IEN,"TEXT",#,0)
|
---|
| 32 | ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,FLD,"E")
|
---|
| 33 | ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,FLD,"I")
|
---|
| 34 | ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,"TEXT",0)
|
---|
| 35 | ; ^TMP("TIU",$J,IDT,IEN,"ZADD",IEN,"TEXT",#,0)
|
---|
| 36 | ; ^TMP("TIU",$J,IDT,IEN,"ZZAD",0)
|
---|
| 37 | ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,FLD,"E")
|
---|
| 38 | ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,FLD,"I")
|
---|
| 39 | ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"TEXT",0)
|
---|
| 40 | ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"TEXT",#,0)
|
---|
| 41 | ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"E")
|
---|
| 42 | ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"I")
|
---|
| 43 | ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",0)
|
---|
| 44 | ; ^TMP("TIU",$J,IDT,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",#,0)
|
---|
| 45 | ;
|
---|
| 46 | ; Selected Progress Notes
|
---|
| 47 | ;
|
---|
| 48 | ; ^TMP("TIU",$J,IDT,#,0)
|
---|
| 49 | ; ^TMP("TIU",$J,IDT,#,IEN,FLD,"E")
|
---|
| 50 | ; ^TMP("TIU",$J,IDT,#,IEN,FLD,"I")
|
---|
| 51 | ; ^TMP("TIU",$J,IDT,#,IEN,"TEXT",0)
|
---|
| 52 | ; ^TMP("TIU",$J,IDT,#,IEN,"TEXT",#,0)
|
---|
| 53 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,FLD,"E")
|
---|
| 54 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,FLD,"I")
|
---|
| 55 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,"TEXT",0)
|
---|
| 56 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZADD",IEN,"TEXT",#,0)
|
---|
| 57 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",0)
|
---|
| 58 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,FLD,"E")
|
---|
| 59 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,FLD,"I")
|
---|
| 60 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"TEXT",0)
|
---|
| 61 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"TEXT",#,0)
|
---|
| 62 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"E")
|
---|
| 63 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,FLD,"I")
|
---|
| 64 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",0)
|
---|
| 65 | ; ^TMP("TIU",$J,IDT,#,IEN,"ZZID",#,IEN,"ZADD",IEN,"TEXT",#,0)
|
---|
| 66 | ;
|
---|
| 67 | PNOTE ; Progress Notes
|
---|
| 68 | D CKP^GMTSUP Q:$D(GMTSQIT) S GMTSD=0 F S GMTSD=$O(^TMP("TIU",$J,GMTSD)) Q:+GMTSD=0 D
|
---|
| 69 | . S GMTSODIC="^TMP(""TIU"","_$J_","_GMTSD_"," D NOTE
|
---|
| 70 | Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) W ! Q
|
---|
| 71 | SNOTE ; Selected Progress Notes
|
---|
| 72 | D CKP^GMTSUP Q:$D(GMTSQIT) S GMTSD=0 F S GMTSD=$O(^TMP("TIU",$J,GMTSD)) Q:+GMTSD=0 D
|
---|
| 73 | . N GMTSS S GMTSS=0 F S GMTSS=$O(^TMP("TIU",$J,GMTSD,GMTSS)) Q:+GMTSS=0 D
|
---|
| 74 | . . S GMTSODIC="^TMP(""TIU"","_$J_","_GMTSD_","_GMTSS_"," D NOTE
|
---|
| 75 | Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) W ! Q
|
---|
| 76 | ;
|
---|
| 77 | NOTE ; Primary Note
|
---|
| 78 | N GMTSTDIC,GMTSI,GMTSXTRA S GMTSI=0
|
---|
| 79 | F S GMTSI=$O(@(GMTSODIC_GMTSI_")")) Q:+GMTSI=0 D
|
---|
| 80 | . S (GMTSTDIC,GMTSPDIC,GMTSDIC)=GMTSODIC,(PARIEN,CURIEN)=GMTSI
|
---|
| 81 | . S CHILD=+($G(@(GMTSDIC_CURIEN_",""ZZID"",0)"))),TYPE="",GMTSID=0
|
---|
| 82 | . S:$D(@(GMTSDIC_CURIEN_",""ZZID"")")) TYPE="Parent Interdisciplinary Note",GMTSID=1
|
---|
| 83 | . K PN S PN("#")=CURIEN,PN("#",0)="NOTE"
|
---|
| 84 | . D FLDS(GMTSDIC,CURIEN) D:$D(@(GMTSDIC_CURIEN_",""ZZID"")")) ST^GMTSPN1("Begin Interdisciplinary Note")
|
---|
| 85 | . D WARN1^GMTSPN2 D:$E($G(GMTSTIUC),1)'["D" WH^GMTSPN1
|
---|
| 86 | . D:$G(GMTSTIUC)="DCS" WDH^GMTSPN1
|
---|
| 87 | . D:GMTSCNT=1&($G(GMTSTIUC)="DSB") WDBH^GMTSPN1
|
---|
| 88 | . I $G(GMTSTIUC)="DSB" D WDB^GMTSPN1(GMTSDIC,CURIEN) Q
|
---|
| 89 | . D:$D(@(GMTSDIC_CURIEN_",""PROBLEM"")")) WP^GMTSPN1(GMTSDIC,CURIEN)
|
---|
| 90 | . D WT^GMTSPN1(GMTSDIC,CURIEN),WS^GMTSPN2(GMTSDIC,CURIEN),WARN2^GMTSPN2
|
---|
| 91 | . D:+($G(PN("AMENDMNT")))>0 AM^GMTSPN1(GMTSDIC,CURIEN)
|
---|
| 92 | . D BL^GMTSPN2 N GMTSODIC S GMTSODIC=GMTSTDIC_CURIEN_"," D ANOTE,INOTE
|
---|
| 93 | . I GMTSID D ST^GMTSPN1("End Interdisciplinary Note") S GMTSID=0
|
---|
| 94 | Q
|
---|
| 95 | ANOTE ; Addendum to a Progress Note
|
---|
| 96 | N GMTSAI,GMTSXTRA S GMTSAI=0
|
---|
| 97 | F S GMTSAI=$O(@(GMTSODIC_"""ZADD"","_GMTSAI_")")) Q:+GMTSAI=0 D
|
---|
| 98 | . S (GMTSTDIC,GMTSDIC)=GMTSODIC_"""ZADD"",",CURIEN=GMTSAI
|
---|
| 99 | . K PN S PN("#")=GMTSI_"^"_CURIEN,PN("#",0)="ADDENDUM TO A NOTE",TYPE=""
|
---|
| 100 | . S:$D(@(GMTSPDIC_PARIEN_",""ZZID"")")) TYPE="Addendum to a Parent Interdisciplinary Note"
|
---|
| 101 | . D FLDS(GMTSDIC,CURIEN),WARN1^GMTSPN2,WAH^GMTSPN1
|
---|
| 102 | . D WT^GMTSPN1(GMTSDIC,CURIEN),WS^GMTSPN2(GMTSDIC,CURIEN),WARN2^GMTSPN2,BL^GMTSPN2
|
---|
| 103 | Q
|
---|
| 104 | INOTE ; Interdisciplinary Progress Note
|
---|
| 105 | Q:+($G(@(GMTSODIC_"""ZZID"",0)")))'>0
|
---|
| 106 | N GMTSIQ,GMTSII,GMTSXTRA S GMTSIQ=0
|
---|
| 107 | F S GMTSIQ=$O(@(GMTSODIC_"""ZZID"","_GMTSIQ_")")) Q:+GMTSIQ=0 D
|
---|
| 108 | . S GMTSTDIC=GMTSODIC N GMTSODIC S GMTSODIC=GMTSTDIC_"""ZZID"","_GMTSIQ_","
|
---|
| 109 | . S GMTSII=0 F S GMTSII=$O(@(GMTSODIC_GMTSII_")")) Q:+GMTSII=0 D
|
---|
| 110 | . . S GMTSDIC=GMTSODIC,CURIEN=GMTSII
|
---|
| 111 | . . K PN S PN("#")=GMTSI_"^"_CURIEN,PN("#",0)="INTERDISCIPLINARY NOTE"
|
---|
| 112 | . . S TYPE="Child Interdisciplinary Note"
|
---|
| 113 | . . D FLDS(GMTSDIC,CURIEN),ST^GMTSPN1("Interdisciplinary Note Cont.")
|
---|
| 114 | . . D WARN1^GMTSPN2,WIH^GMTSPN1 D:$D(@(GMTSDIC_CURIEN_",""PROBLEM"")")) WP^GMTSPN1(GMTSDIC,CURIEN)
|
---|
| 115 | . . D WT^GMTSPN1(GMTSDIC,CURIEN),WS^GMTSPN2(GMTSDIC,CURIEN)
|
---|
| 116 | . . D WARN2^GMTSPN2 D:+($G(PN("AMENDMNT")))>0 AM^GMTSPN1(GMTSDIC,CURIEN) D BL^GMTSPN2
|
---|
| 117 | . . S GMTSTDIC=GMTSODIC N GMTSODIC S GMTSODIC=GMTSTDIC_GMTSII_",""ZADD"","
|
---|
| 118 | . . D AINOTE
|
---|
| 119 | Q
|
---|
| 120 | AINOTE ; Addendum to an Interdisciplinary Progress Note
|
---|
| 121 | N GMTSAII,GMTSXTRA S GMTSAII=0
|
---|
| 122 | F S GMTSAII=$O(@(GMTSODIC_GMTSAII_")")) Q:+GMTSAII=0 D
|
---|
| 123 | . S GMTSDIC=GMTSODIC,CURIEN=GMTSAII
|
---|
| 124 | . K PN S PN("#")=GMTSI_"^"_GMTSII_"^"_CURIEN
|
---|
| 125 | . S PN("#",0)="ADDENDUM TO AN INTERDISCIPLINARY NOTE"
|
---|
| 126 | . S TYPE="Addendum to a Child Interdisciplinary Note"
|
---|
| 127 | . D FLDS(GMTSDIC,CURIEN),WARN1^GMTSPN2,WAIH^GMTSPN1,WT^GMTSPN1(GMTSDIC,CURIEN)
|
---|
| 128 | . D WS^GMTSPN2(GMTSDIC,CURIEN),WARN2^GMTSPN2,BL^GMTSPN2
|
---|
| 129 | Q
|
---|
| 130 | ;
|
---|
| 131 | ; Get Data
|
---|
| 132 | EXTIU ; Extract Patient/Visit VIA TIU
|
---|
| 133 | N MAX S DFN=+($G(DFN)) Q:DFN=0 S TIUTYPE=+($G(TIUTYPE)) Q:TIUTYPE=0
|
---|
| 134 | S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
|
---|
| 135 | S GMTS1=+($G(GMTS1)) Q:GMTS1=0 S GMTS2=+($G(GMTS2)) Q:GMTS2=0 S GMTSX=+($G(GMTSX))
|
---|
| 136 | I +($G(GMTSPXGO))>0,$L($T(VISIT^TIULAPIC)) D VISIT^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,MAX,+($G(GMTSX))) Q
|
---|
| 137 | D MAIN^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,MAX,+($G(GMTSX)))
|
---|
| 138 | Q
|
---|
| 139 | FLDS(X,I) ; Get Fields
|
---|
| 140 | N GMTSDIC,GMTSIEN
|
---|
| 141 | S GMTSDIC=$G(X),GMTSIEN=$G(I) Q:'$L(GMTSIEN)
|
---|
| 142 | Q:$E($P(GMTSDIC,$J,1),1,11)'="^TMP(""TIU"","
|
---|
| 143 | Q:'$D(@($P(GMTSDIC,",",1,($L(GMTSDIC,",")-1))_")"))
|
---|
| 144 | Q:'$D(@(GMTSDIC_GMTSIEN_")"))
|
---|
| 145 | S GMTSDIC=GMTSDIC_GMTSIEN_","
|
---|
| 146 | N GMTSXTRA S GMTSCNT=+$G(GMTSCNT)+1
|
---|
| 147 | S X=$G(@(GMTSDIC_".07,""I"")")) D REGDT4^GMTSU S ADMIT=X
|
---|
| 148 | S X=$G(@(GMTSDIC_".08,""I"")")) D REGDT4^GMTSU S DISCHG=X
|
---|
| 149 | S:+DISCHG'>0 DISCHG="Present"
|
---|
| 150 | S:+ADMIT'>0 ADMIT="Unknown"
|
---|
| 151 | S AUTHOR=$G(@(GMTSDIC_"1202,""E"")"))
|
---|
| 152 | S ATTNDNG=$G(@(GMTSDIC_"1209,""E"")"))
|
---|
| 153 | S TSPEC=$G(@(GMTSDIC_"1402,""E"")"))
|
---|
| 154 | S STATUS=$G(@(GMTSDIC_".05,""E"")"))
|
---|
| 155 | S PN("DATE")=$G(@(GMTSDIC_"1301,""I"")"))
|
---|
| 156 | I PN("DATE")]"" S PN("DATE")=$$EDT^GMTSU(PN("DATE"))
|
---|
| 157 | S REASON="",PN("DOCTYPE")=$G(@(GMTSDIC_".01,""E"")"))
|
---|
| 158 | S PN("VHATYPE")=$G(@(GMTSDIC_"89261,""E"")"))
|
---|
| 159 | S PN("STATUS")=$G(@(GMTSDIC_".05,""E"")"))
|
---|
| 160 | S PN("AUTHOR")=$G(@(GMTSDIC_"1202,""E"")"))
|
---|
| 161 | S PN("EXPSIGNR")=$G(@(GMTSDIC_"1204,""E"")"))
|
---|
| 162 | S PN("LOC")=$G(@(GMTSDIC_"1205,""E"")"))
|
---|
| 163 | S PN("EXPCOSNR")=$G(@(GMTSDIC_"1208,""E"")"))
|
---|
| 164 | S:$G(@(GMTSDIC_"1307,""I"")"))'="" PN("DDATE")=$$ED^GMTSU($G(@(GMTSDIC_"1307,""I"")")))
|
---|
| 165 | S:$G(@(GMTSDIC_"1501,""I"")"))'="" PN("SIGNDATE")=$$ED^GMTSU($G(@(GMTSDIC_"1501,""I"")")))
|
---|
| 166 | S PN("SIGDT")=$G(@(GMTSDIC_"1501,""I"")"))
|
---|
| 167 | I PN("SIGDT")]"" S PN("SIGDT")=$$EDT^GMTSU(PN("SIGDT"))
|
---|
| 168 | S SIGNEDBY=$G(@(GMTSDIC_"1502,""I"")"))
|
---|
| 169 | S PN("SIGBLK")=$G(@(GMTSDIC_"1503,""E"")"))
|
---|
| 170 | S PN("STITLE")=$G(@(GMTSDIC_"1504,""E"")"))
|
---|
| 171 | S PN("COSDT")=$G(@(GMTSDIC_"1507,""I"")"))
|
---|
| 172 | I PN("COSDT")]"" S (COSIG,PN("COSDT"))=$$EDT^GMTSU(PN("COSDT"))
|
---|
| 173 | S COSGEDBY=$G(@(GMTSDIC_"1508,""I"")"))
|
---|
| 174 | S CONEED=0 S:+($G(COSGEDBY))>0 CONEED=1
|
---|
| 175 | S PN("COBLK")=$G(@(GMTSDIC_"1509,""E"")"))
|
---|
| 176 | S PN("COTITLE")=$G(@(GMTSDIC_"1510,""E"")"))
|
---|
| 177 | S COSAME=$S(+($G(SIGNEDBY))>0&(+($G(SIGNEDBY))=+($G(COSGEDBY))):1,1:0)
|
---|
| 178 | S:CONEED>0 CONEED=$S(COSAME=1:0,1:CONEED)
|
---|
| 179 | S PN("SUBJ")=$G(@(GMTSDIC_"1701,""E"")"))
|
---|
| 180 | I $G(@(GMTSDIC_"1505,""I"")"))="C" D
|
---|
| 181 | . S PN("SCHART")="Signed on Chart by:",PN("SCHARTBY")="."
|
---|
| 182 | . S:$G(@(GMTSDIC_"1512,""E"")"))'="" PN("SCHARTBY")=$G(@(GMTSDIC_"1512,""E"")"))
|
---|
| 183 | I $E($G(GMTSTIUC),1)'["D",$G(@(GMTSDIC_"1511,""I"")"))="C" D
|
---|
| 184 | . S PN("COCHART")="Cosigned on Chart by:",PN("COCHARTBY")="."
|
---|
| 185 | . S:$G(@(GMTSDIC_"1513,""E"")"))'="" PN("COCHARTBY")=$G(@(GMTSDIC_"1513,""E"")"))
|
---|
| 186 | I $E($G(GMTSTIUC),1)["D",CONEED,$G(@(GMTSDIC_"1511,""I"")"))="C" D
|
---|
| 187 | . S PN("COCHART")="Cosigned on Chart by:",PN("COCHARTBY")="."
|
---|
| 188 | . S:$G(@(GMTSDIC_"1513,""E"")"))'="" PN("COCHARTBY")=$G(@(GMTSDIC_"1513,""E"")"))
|
---|
| 189 | S:$G(@(GMTSDIC_"1202,""I"")"))'=$G(@(GMTSDIC_"1502,""I"")")) PN("AUTH")="AUTHOR: "_PN("AUTHOR")
|
---|
| 190 | S PN("AMENDMNT")=+($G(@(GMTSDIC_"1601,""I"")")))
|
---|
| 191 | Q
|
---|