source: FOIAVistA/trunk/r/PROBLEM_LIST-GMPL/GMPLPRNT.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1GMPLPRNT ; SLC/MKB,KER -- Problem List prints/displays; 04/15/2002
2 ;;2.0;Problem List;**1,13,26**;Aug 25, 1994
3 ;
4 ; External References
5 ; DBIA 10090 ^DIC(4
6 ; DBIA 10082 ^ICD9(
7 ; DBIA 10086 ^%ZIS
8 ; DBIA 10086 HOME^%ZIS
9 ; DBIA 10089 ^%ZISC
10 ; DBIA 10063 ^%ZTLOAD
11 ; DBIA 10026 ^DIR
12 ; DBIA 10061 OERR^VADPT
13 ; DBIA 10116 CLEAR^VALM1
14 ; DBIA 10103 $$FMTE^XLFDT
15 ; DBIA 10103 $$NOW^XLFDT
16 ; DBIA 10104 $$REPEAT^XLFSTR
17 ;
18EN ; Print/Display (Main)
19 N DIR,X,Y S VALMBCK=$S(VALMCC:"",1:"R") W !
20 I '(($L(GMPLVIEW("ACT")))!(GMPLVIEW("PROV"))!($L(GMPLVIEW("VIEW"),"/")>2)) S Y="A" G EN1
21 S DIR(0)="SAOM^C:CURRENT VIEW;A:ALL PROBLEMS;"
22 S DIR("A")="Print (C)urrently displayed problems only, or include (A)ll problems? "
23 S DIR("?",1)="Enter C to print a copy of your currently displayed view"
24 S DIR("?",2)="of this patient's list; to print a complete list of all"
25 S DIR("?",3)="active and inactive problems, which may be included in"
26 S DIR("?")="the patient's chart, select A."
27 D ^DIR G:$D(DTOUT)!($D(DUOUT))!(Y="") ENQ
28EN1 ; Print View
29 W ! D @$S(Y="C":"LIST",1:"VAF")
30 I GMPRT'>0 W !!,"No problems found.",!,$C(7) H 1 G ENQ
31 D DEVICE G:$D(GMPQUIT) ENQ
32 D CLEAR^VALM1,PRT S VALMBCK="R"
33ENQ ; Quit Print/Display
34 D KILL^GMPLX S VALMSG=$$MSG^GMPLX Q
35 ;
36VAF ; Build Chart Copy
37 N TOTAL,VIEW K GMPLCURR S (TOTAL,GMPRT)=0
38 Q:'$D(^AUPNPROB("AC",+GMPDFN))
39 S (VIEW("ACT"),VIEW("VIEW"))="",VIEW("PROV")=0
40 D GETPLIST^GMPLMGR1(.GMPRT,.TOTAL,.VIEW)
41 S GMPRT=TOTAL
42 Q
43 ;
44LIST ; Build Current View
45 S GMPLCURR=1,GMPRT=0 Q:+$G(GMPCOUNT)'>0 N I,IFN
46 W !,"One moment, please ..."
47 F I=0:0 S I=$O(^TMP("GMPLIDX",$J,I)) Q:I'>0 D
48 . S IFN=$P($G(^TMP("GMPLIDX",$J,I)),U,2) Q:IFN'>0
49 . S GMPRT=GMPRT+1,GMPRT(I)=IFN W "."
50 Q
51 ;
52DEVICE ; Get Device
53 S %ZIS="Q",%ZIS("B")="" D ^%ZIS I POP S GMPQUIT=1 G DQ
54 I '$D(GMPLCURR) K GMPRINT
55 I $D(IO("Q")) D
56 . S ZTRTN="PRT^GMPLPRNT",ZTDESC="PROBLEM LIST OF "_$P(GMPDFN,U,2)
57 . S (ZTSAVE("GMPRT"),ZTSAVE("GMPRT("),ZTSAVE("GMPDFN"),ZTSAVE("GMPVAMC"))=""
58 . S:$D(GMPLCURR) ZTSAVE("GMPLCURR")="" S ZTDTH=$H
59 . D ^%ZTLOAD,HOME^%ZIS S:$D(ZTSK) GMPQUIT=1
60DQ ; Quit Device
61 K IO("Q"),POP,%ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTSK
62 Q
63 ;
64HDR ; Header Code
65 N PAGE S PAGE="Page: "_GMPLPAGE,GMPLPAGE=GMPLPAGE+1
66 W $C(13),$$REPEAT^XLFSTR("-",79),!
67 I IOST?1"P".E W:$D(GMPLCURR) "** NOT for " W "Medical Record" W:$D(GMPLCURR) " **"
68 I IOST'?1"P".E W $P(GMPDFN,U,2)_" ("_$P(GMPDFN,U,3)_")"
69 W ?41,"| " W:$D(GMPLCURR) "PARTIAL "
70 W "PROBLEM LIST",?(79-$L(PAGE)),PAGE,!
71 W $$REPEAT^XLFSTR("-",79),!
72 W !," Date",?63,"Date of Date"
73 W !," Recorded Problems",?64,"Onset Resolved"
74 W !,$$REPEAT^XLFSTR("-",79)
75 Q
76 ;
77FTR ; Footer Code
78 N I,SITE,DFN,VA,VADM,LOC,DATE,FORM
79 F I=1:1:(IOSL-$Y-6) W !
80 S SITE=$O(^DIC(4,"D",+GMPVAMC,0)),SITE=$P($G(^DIC(4,+SITE,0)),U)
81 S:SITE'["VAMC" SITE=SITE_" VAMC"
82 S DFN=+GMPDFN D OERR^VADPT
83 S LOC="Pt Loc: "_$S(VAIN(4)]"":$P(VAIN(4),U,2)_" "_VAIN(5),1:"OUTPATIENT") K VAIN
84 I $L(LOC)>51 S LOC=$E(LOC,1,51),FORM="VAF10-141"
85 E S FORM="VA FORM 10-1415"
86 W !,$S($D(GMPLFLAG):"$ = Requires verification by provider",1:"")
87 W !,$$REPEAT^XLFSTR("-",79)
88 W !,$P(GMPDFN,U,2),?(79-$L(SITE)\2),SITE
89 S DATE=$$FMTE^XLFDT($E(($$NOW^XLFDT),1,12),2)
90 S DATE="Printed:"_$P(DATE,"@")_" "_$P(DATE,"@",2)
91 W ?(79-$L(DATE)),DATE
92 W !,VA("PID"),?(79-$L(LOC)\2),LOC,?(79-$L(FORM)),FORM
93 W !,$$REPEAT^XLFSTR("-",79),@IOF
94 Q
95 ;
96RETURN() ; End of page
97 N X,Y,DIR,I F I=1:1:(IOSL-$Y-3) W !
98 S DIR(0)="E" D ^DIR
99 Q +Y
100 ;
101PRT ; Body of Problem List
102 U IO N I,IFN,GMPLPAGE,GMPLFLAG S GMPLPAGE=1 D HDR
103 F I=0:0 S I=$O(GMPRT(I)) Q:I'>0 D Q:$D(GMPQUIT)
104 . S IFN=GMPRT(I) Q:IFN'>0
105 . D PROB(IFN,I)
106 D FTR:IOST?1"P".E I '$D(GMPQUIT),IOST?1"C".E S I=$$RETURN
107 I $D(ZTQUEUED) S ZTREQ="@" K GMPDFN,GMPLCURR,GMPQUIT,GMPRT
108 D ^%ZISC
109 Q
110 ;
111PROB(DA,NUM) ; Get Problem Text Line
112 N GMPL0,GMPL1,ONSET,DATE,TEXT,NOTES,J,RESOLVED,X,LINES,PROB,SCS,SP
113 S GMPL0=$G(^AUPNPROB(DA,0)),GMPL1=$G(^(1)) Q:GMPL0="" Q:GMPL1=""
114 S ONSET=$P(GMPL0,U,13),DATE=$P(GMPL1,U,9),RESOLVED=$P(GMPL1,U,7)
115 D SCS^GMPLX1(+DA,.SCS) S SP=$G(SCS(3))
116 I 'DATE S DATE=$P(GMPL0,U,8)
117 S PROB=$$PROBTEXT^GMPLX(DA)
118 S PROB=PROB_" ("_$P($G(^ICD9(+GMPL0,0)),U)_")"
119 I $P($G(^AUPNPROB(DA,1)),"^",14)="A" S PROB="*"_PROB
120 E S PROB=" "_PROB
121 D WRAP^GMPLX(PROB,50,.TEXT)
122 D NOTES(DA) S LINES=TEXT+NOTES+1
123 I ($Y+LINES)>(IOSL-7) D Q:$D(GMPQUIT)
124 . I IOST?1"P".E D FTR,HDR Q
125 . I $$RETURN W @IOF D HDR Q
126 . S GMPQUIT=1
127PR1 ; Write Problem Text Line
128 W !!,$E(" ",1,3-$L(NUM))_NUM_". "_$J($$EXTDT^GMPLX(DATE),8)
129 I $P(GMPL1,U,2)="T",$P($G(^GMPL(125.99,1,0)),U,2) W ?14,"$" S GMPLFLAG=1
130 W ?15,TEXT(1),?62,$J($$EXTDT^GMPLX(ONSET),8)
131 I $P(GMPL0,U,12)="I" W ?71,$S(RESOLVED:$J($$EXTDT^GMPLX(RESOLVED),8),1:"unknown")
132 I TEXT>1 F J=2:1:TEXT W !?15,TEXT(J)
133 Q:'NOTES S DATE=$P(DATE,".")
134 F J=1:1:NOTES S X=$S(DATE'=$P(NOTES(J),U):$$EXTDT^GMPLX($P(NOTES(J),U)),1:"") W !?5,$J(X,8),?17,$P(NOTES(J),U,2) S DATE=$P(NOTES(J),U)
135 Q
136NOTES(IFN) ; Place Comments in NOTES array
137 N I,NOTE,DATE,TEXT,FAC,NIFN S (NOTES,I)=0
138 Q:'$D(^AUPNPROB(IFN,11))
139 S FAC=$O(^AUPNPROB(IFN,11,"B",+GMPVAMC,0)) Q:FAC'>0
140 F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D
141 . S NOTE=$G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)) Q:NOTE=""
142 . S DATE=$P(NOTE,U,5),TEXT=$P(NOTE,U,3),I=I+1
143 . S NOTES(I)=$P(DATE,".")_U_TEXT
144 S NOTES=I
145 Q
Note: See TracBrowser for help on using the repository browser.