source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPN1.m@ 619

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1GMTSPN1 ; 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
9WH ; 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
17WDH ; 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
25WDBH ; 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
27WAH ; 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
37ST(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
44WIH ; 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
55WAIH ; 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
69WT(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
76WP(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
85AM(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
99WDB(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
Note: See TracBrowser for help on using the repository browser.