1 | GMTSPN1 ; SLC/KER - Progress Note Header/Sig/Text/Prob ; 5/17/06 2:03pm
|
---|
2 | ;;2.7;Health Summary;**12,35,45,49,81**;Oct 20, 1995;Build 23
|
---|
3 | Q
|
---|
4 | ;
|
---|
5 | ; External References
|
---|
6 | ; DBIA 10104 call $$UP^XLFSTR
|
---|
7 | ;
|
---|
8 | ; Write Headers
|
---|
9 | WH ; Note Header
|
---|
10 | Q:$D(GMTSQIT) I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
11 | W $G(PN("DATE")),?18,"Local Title: ",$$UP^XLFSTR($G(PN("DOCTYPE"))),!
|
---|
12 | I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT) W ?15,"Standard Title: ",PN("VHATYPE"),!
|
---|
13 | S (ADATE,PDATE)=$G(PN("DATE")),(ATYPE,PTYPE)=$G(PN("DOCTYPE")),(ASUB,PSUB)=$G(PN("SUBJ"))
|
---|
14 | I $D(PN("AUTH")) D CKP^GMTSUP Q:$D(GMTSQIT) W ?20,PN("AUTH"),!
|
---|
15 | I PN("SUBJ")'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?19,"Subject: ",PN("SUBJ"),!
|
---|
16 | Q
|
---|
17 | WDH ; Discharge Summary Header
|
---|
18 | Q:$D(GMTSQIT) I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
19 | D CKP^GMTSUP Q:$D(GMTSQIT) W ADMIT,?12,"-",?14,DISCHG,?56,"Status: ",STATUS,!
|
---|
20 | I $D(PN("DOCTYPE")) D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Local Title: ",PN("VHATYPE"),!
|
---|
21 | I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,"Standard Title: ",PN("VHATYPE"),!
|
---|
22 | D CKP^GMTSUP Q:$D(GMTSQIT) W ?3,"Last Tr Specialty: ",TSPEC,?49,"Dict'd By: ",AUTHOR,!
|
---|
23 | D CKP^GMTSUP Q:$D(GMTSQIT) W ?47,"Approved By: ",ATTNDNG,!
|
---|
24 | Q
|
---|
25 | WDBH ; Brief Discharge Summary Header
|
---|
26 | D CKP^GMTSUP Q:$D(GMTSQIT) W "Admitted",?11,"Disch'd",?23,"Dictated By",?38,"Approved By",?53,"Cosigned",?64,"Status",!! Q
|
---|
27 | WAH ; Addendum Header
|
---|
28 | Q:$D(GMTSQIT) I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
29 | W PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE")),!
|
---|
30 | I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT) W ?15,"Standard Title: ",PN("VHATYPE"),!
|
---|
31 | I $L($G(ADATE)),$L($G(ATYPE)) D Q:$D(GMTSQIT)
|
---|
32 | . I $D(GMTSREF) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,"Ref: ",$E(ATYPE,1,25),?55,"Dated: ",ADATE,!
|
---|
33 | I $D(PN("AUTH")) D CKP^GMTSUP Q:$D(GMTSQIT) W ?20,PN("AUTH"),!
|
---|
34 | I PN("SUBJ")'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?19,"Subject: ",PN("SUBJ"),!
|
---|
35 | I '$L($G(PN("SUBJ"))),$L($G(ASUB)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?19,"Subject: ",$G(ASUB),!
|
---|
36 | Q
|
---|
37 | ST(X) ; Sub-Titles
|
---|
38 | N GMTS,GMTS1,GMTS2,GMTST,GMTSB S GMTST=$G(X) Q:'$L(GMTST)
|
---|
39 | S GMTST="<< "_GMTST_" >>",GMTS="",$P(GMTS,"-",((((79-$L(GMTST))\2)\2)-6))="-"
|
---|
40 | S $P(GMTS1," ",((((79-$L(GMTST))\2)\2)+6))=" "
|
---|
41 | S GMTS2=GMTS_GMTS1,GMTS1=GMTS1_GMTS,GMTSB=GMTS1_GMTST_GMTS2
|
---|
42 | D CKP^GMTSUP Q:$D(GMTSQIT) W !,GMTSB D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
43 | Q
|
---|
44 | WIH ; Interdisciplinary Note Header
|
---|
45 | Q:$D(GMTSQIT) I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
46 | W PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE"))
|
---|
47 | I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT) W !?15,"Standard Title: ",PN("VHATYPE"),!
|
---|
48 | S ADATE=$G(PN("DATE")),ATYPE=$G(PN("DOCTYPE")),ASUB=$G(PN("SUBJ"))
|
---|
49 | I $L($G(PDATE)),$L($G(PTYPE)) D Q:$D(GMTSQIT)
|
---|
50 | . I $D(GMTSREF) D CKP^GMTSUP Q:$D(GMTSQIT) W !,?23,"Ref: ",$E(PTYPE,1,25),?55,"Dated: ",PDATE
|
---|
51 | I $D(PN("AUTH")) D CKP^GMTSUP Q:$D(GMTSQIT) W !?20,PN("AUTH")
|
---|
52 | I PN("SUBJ")'="" D CKP^GMTSUP Q:$D(GMTSQIT) W !?19,"Subject: ",PN("SUBJ")
|
---|
53 | I '$L($G(PN("SUBJ"))),$L($G(PSUB)) D CKP^GMTSUP Q:$D(GMTSQIT) W !?19,"Subject: ",$G(PSUB)
|
---|
54 | Q
|
---|
55 | WAIH ; Addendum to Interdisciplinary Note Header
|
---|
56 | Q:$D(GMTSQIT) I GMTSCNT>1 D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
57 | W PN("DATE"),?18,"Local Title: ",$$UP^XLFSTR(PN("DOCTYPE"))
|
---|
58 | I $D(PN("VHATYPE")) D CKP^GMTSUP Q:$D(GMTSQIT) W !?15,"Standard Title: ",PN("VHATYPE"),!
|
---|
59 | I $L($G(ADATE)),$L($G(ATYPE)) D Q:$D(GMTSQIT)
|
---|
60 | . I $D(GMTSREF) D CKP^GMTSUP Q:$D(GMTSQIT) W !,?23,"Ref: ",$E(ATYPE,1,25),?55,"Dated: ",ADATE
|
---|
61 | I $L($G(PDATE)),$L($G(PTYPE)) D Q:$D(GMTSQIT)
|
---|
62 | . I $D(GMTSREF) D CKP^GMTSUP Q:$D(GMTSQIT) W !,?23,"Ref: ",$E(PTYPE,1,29),?55,"Dated: ",PDATE
|
---|
63 | I $D(PN("AUTH")) D CKP^GMTSUP Q:$D(GMTSQIT) W !?20,PN("AUTH")
|
---|
64 | I PN("SUBJ")'="" D CKP^GMTSUP Q:$D(GMTSQIT) W !?19,"Subject: ",PN("SUBJ")
|
---|
65 | I '$L($G(PN("SUBJ"))),$L($G(ASUB)) D CKP^GMTSUP Q:$D(GMTSQIT) W !?19,"Subject: ",$G(ASUB)
|
---|
66 | I '$L($G(PN("SUBJ"))),'$L($G(ASUB)),$L(PSUB) D CKP^GMTSUP Q:$D(GMTSQIT) W !?19,"Subject: ",$G(PSUB)
|
---|
67 | Q
|
---|
68 | ; Write Note
|
---|
69 | WT(X,I) ; Write Progress Note Text
|
---|
70 | N GMTSD,GMTSIEN S GMTSD=$G(X),GMTSIEN=$G(I) Q:'$L(GMTSIEN) Q:$E($P(GMTSD,$J,1),1,11)'="^TMP(""TIU"","
|
---|
71 | Q:'$D(@($P(GMTSD,",",1,($L(GMTSD,",")-1))_")")) Q:'$D(@(GMTSD_GMTSIEN_")")) S GMTSD=GMTSD_GMTSIEN_",""TEXT"","
|
---|
72 | N GMTSK S GMTSK=0 F S GMTSK=$O(@(GMTSD_GMTSK_")")) Q:+GMTSK'>0 D Q:$D(GMTSQIT)
|
---|
73 | . D CKP^GMTSUP Q:$D(GMTSQIT) W !,$G(@(GMTSD_GMTSK_",0)"))
|
---|
74 | Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
75 | Q
|
---|
76 | WP(X,I) ; Writes Problems associated with Note
|
---|
77 | Q:$G(TIUNAM)["DISCHARGE"
|
---|
78 | N GMTSD,GMTSIEN S GMTSD=$G(X),GMTSIEN=$G(I) Q:'$L(GMTSIEN) Q:$E($P(GMTSD,$J,1),1,11)'="^TMP(""TIU"","
|
---|
79 | Q:'$D(@($P(GMTSD,",",1,($L(GMTSD,",")-1))_")")) Q:'$D(@(GMTSD_GMTSIEN_")")) S GMTSD=GMTSD_GMTSIEN_",""PROBLEM"","
|
---|
80 | D CKP^GMTSUP Q:$D(GMTSQIT) W !,"PROBLEM(S): "
|
---|
81 | N GMTSPR S GMTSPR=0 F S GMTSPR=$O(@(GMTSD_GMTSPR_")")) Q:+GMTSPR'>0 D Q:$D(GMTSQIT)
|
---|
82 | . D:GMTSPR>1 CKP^GMTSUP Q:$D(GMTSQIT) W !?15,$G(@(GMTSD_GMTSPR_",0)"))
|
---|
83 | Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
84 | Q
|
---|
85 | AM(X,I) ; Write Amendment
|
---|
86 | 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"","
|
---|
87 | Q:'$D(@($P(GMTSD,",",1,($L(GMTSD,",")-1))_")")) Q:'$D(@(GMTSD_GMTSIEN_")"))
|
---|
88 | S GMTSD=GMTSD_GMTSIEN_"," D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
89 | D CKP^GMTSUP Q:$D(GMTSQIT) W !,$G(@(GMTSD_"1601,""E"")"))," AMENDMENT FILED:"
|
---|
90 | I $G(@(GMTSD_"1603,""E"")"))'="" D Q:$D(GMTSQIT)
|
---|
91 | . D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
92 | . D CKP^GMTSUP Q:$D(GMTSQIT) W !?10 F GMTSI=1:1:$L($G(@(GMTSD_"1602,""E"")"))) W "_"
|
---|
93 | I $G(@(GMTSD_"1604,""E"")"))'="" D Q:$D(GMTSQIT)
|
---|
94 | . D CKP^GMTSUP Q:$D(GMTSQIT) W !?28," /es/ ",$G(@(GMTSD_"1604,""E"")"))
|
---|
95 | I $G(@(GMTSD_"1605,""E"")"))'="" D Q:$D(GMTSQIT)
|
---|
96 | . D CKP^GMTSUP Q:$D(GMTSQIT) W !?34,$G(@(GMTSD_"1605,""E"")"))
|
---|
97 | D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
98 | Q
|
---|
99 | WDB(X,I) ; Writes Brief Discharge Summary
|
---|
100 | 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"","
|
---|
101 | Q:'$D(@($P(GMTSD,",",1,($L(GMTSD,",")-1))_")")) Q:'$D(@(GMTSD_GMTSIEN_")"))
|
---|
102 | D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG WDBH
|
---|
103 | 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),!
|
---|
104 | Q
|
---|