source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLRPTS.m@ 1261

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1GMPLRPTS ; SLC/MKB -- Problem List Mgt Reports ;1/26/95 10:00
2 ;;2.0;Problem List;**2**;Aug 25, 1994
3PAT ; List patients having data in Problem file #9000011
4 N DFN,IFN,CNT,ST S GMPRT=0
5 D WAIT^DICD
6 F DFN=0:0 S DFN=$O(^AUPNPROB("AC",DFN)) Q:DFN'>0 D
7 . S (CNT("A"),CNT("I"),IFN)=0
8 . F S IFN=$O(^AUPNPROB("AC",DFN,IFN)) Q:IFN'>0 I $P($G(^AUPNPROB(IFN,1)),U,2)'="H" S ST=$P(^(0),U,12),CNT(ST)=CNT(ST)+1
9 . I (CNT("A")>0)!(CNT("I")>0) S GMPRT=GMPRT+1,^TMP("GMPRT",$J,$P(^DPT(DFN,0),U))=" "_+CNT("A")_$E(" ",1,7-$L(CNT("A")))_+CNT("I") W "."
10 I GMPRT'>0 W $C(7),!!,"No patient data available.",! G PATQ
11 S GMPLHDR="PROBLEM LIST PATIENT LISTING",GMPLCNT=1
12 D DEVICE G:$D(GMPQUIT) PATQ
13 D PRT
14PATQ D KILL
15 Q
16 ;
17PROB ; Search for/List patients with selected problem
18 N X,Y,GMPTERM,GMPTEXT,IFN,DFN,STATUS,ST,TXT,NAME
19PROB1 D SEARCH^GMPLX(.X,.Y) G:Y'>0 PROBQ
20 S GMPTERM=Y,GMPTEXT=$$UP^XLFSTR(X) S:+GMPTERM'>1 GMPTERM="1^"_GMPTEXT
21 S STATUS=$$STATUS G:STATUS="^" PROBQ
22 D WAIT^DICD S GMPRT=0
23 F IFN=0:0 S IFN=$O(^AUPNPROB("C",+GMPTERM,IFN)) Q:IFN'>0 D
24 . Q:$P($G(^AUPNPROB(IFN,1)),U,2)="H"
25 . Q:STATUS'[$P($G(^AUPNPROB(IFN,0)),U,12)
26 . S NODE=$G(^AUPNPROB(IFN,0)),DFN=$P(NODE,U,2),NAME=$P(^DPT(DFN,0),U),ST=$S($P(NODE,U,12)="A":"active",1:"inactive"),TXT=$P(NODE,U,5)
27 . I GMPTERM'>1,GMPTEXT'=$$UP^XLFSTR($P(^AUTNPOV(+TXT,0),U)) Q
28 . I '$D(^TMP("GMPRT",$J,NAME)) S GMPRT=GMPRT+1,^TMP("GMPRT",$J,NAME)=ST Q
29 . Q:(" "_^TMP("GMPRT",$J,NAME))[(" "_ST) ; already included
30 . S:$E(ST)="a" ^TMP("GMPRT",$J,NAME)=ST_", "_^TMP("GMPRT",$J,NAME)
31 . S:$E(ST)="i" ^TMP("GMPRT",$J,NAME)=^TMP("GMPRT",$J,NAME)_", "_ST
32 I GMPRT'>0 W $C(7),!!,"No patient data available.",! D KILL G PROB1
33 S GMPLHDR="PATIENTS WITH '"_$$UP^XLFSTR($P(GMPTERM,U,2))_"'",GMPLCNT=0
34 D DEVICE I $D(GMPQUIT) D KILL G PROB1
35 D PRT D KILL G PROB1
36PROBQ D KILL
37 Q
38 ;
39KILL ; Clean-up after ourselves
40 K GMPRT,GMPLHDR,GMPQUIT,X,Y,^TMP("GMPRT",$J)
41 Q
42 ;
43DEVICE ; Prompt for device to send report to -- Sets GMPQUIT to quit
44 S %ZIS="Q" D ^%ZIS I POP S GMPQUIT=1 G DQ
45 I $D(IO("Q")) D
46 . S ZTRTN="PRT^GMPLRPTS",ZTDESC=GMPLHDR
47 . S (ZTSAVE("GMPRT"),ZTSAVE("^TMP(""GMPRT"",$J,"),ZTSAVE("GMPLHDR"),ZTSAVE("GMPLCNT"))=""
48 . D ^%ZTLOAD,HOME^%ZIS S:$D(ZTSK) GMPQUIT=1
49DQ K IO("Q"),POP,%ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTSK
50 Q
51 ;
52PRT ; Print patient listing from ^TMP("GMPRT",$J,)
53 U IO N NAME,PAGE S NAME="",PAGE=0 D HDR
54 F S NAME=$O(^TMP("GMPRT",$J,NAME)) Q:NAME="" D Q:$D(GMPQUIT)
55 . I $Y>(IOSL-4) D RETURN Q:$D(GMPQUIT) D HDR
56 . W !,NAME,?60,^TMP("GMPRT",$J,NAME)
57 W:'$D(GMPQUIT) !!?10,"Total of "_GMPRT_" patients found."
58 W:IOST?1"P".E @IOF I IOST'?1"P".E,'$D(GMPQUIT) D RETURN
59 I $D(ZTQUEUED) S ZTREQ="@" D KILL
60 D ^%ZISC
61 Q
62 ;
63HDR ; Prints report header
64 W @IOF S PAGE=PAGE+1
65 W GMPLHDR,?60,$$EXTDT^GMPLX(DT),?70,"PAGE "_PAGE,!!
66 W "Patient Name",?60,$S(GMPLCNT:"# Active/Inactive",1:"Status"),!
67 W $$REPEAT^XLFSTR("-",79),!
68 Q
69 ;
70RETURN ; Checks for end-of-page, continue
71 Q:IOST?1"P".E N X,Y,DIR,I
72 F I=1:1:(IOSL-$Y-2) W !
73 S DIR(0)="E" D ^DIR S:'Y GMPQUIT=1
74 Q
75 ;
76STATUS() ; Prompts for problem status to search for
77 N DIR,X,Y
78 S DIR(0)="SA^A:ACTIVE;I:INACTIVE;B:BOTH;"
79 S DIR("A")="Select STATUS: ",DIR("B")="ACTIVE"
80 S DIR("?",1)="To list only those patients with this problem in a specific status, select:",DIR("?",2)=" ACTIVE",DIR("?",3)=" INACTIVE",DIR("?")=" BOTH ACTIVE & INACTIVE"
81 D ^DIR S:$D(DTOUT)!($D(DUOUT)) Y="^" S:Y="B" Y="AI"
82 Q Y
Note: See TracBrowser for help on using the repository browser.