source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPN.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1GMTSPN ; 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 ;
9PN ; 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
15MAIN ; 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 ;
67PNOTE ; 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
71SNOTE ; 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 ;
77NOTE ; 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
95ANOTE ; 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
104INOTE ; 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
120AINOTE ; 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
132EXTIU ; 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
139FLDS(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
Note: See TracBrowser for help on using the repository browser.