source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLMGR1.m@ 623

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1GMPLMGR1 ; SLC/MKB -- Problem List VALM Utilities cont ;5/10/94 16:42
2 ;;2.0;Problem List;**10**;Aug 25, 1994
3NEWPAT ; select new patient
4 N NEWPT S VALMBCK="R"
5 I GMPARAM("PRT"),$D(GMPRINT) D AUTO^GMPLMGR2 I $D(DTOUT) S VALMBCK="Q" Q
6 W ! D FULL^VALM1
7 S NEWPT=$S($D(ORVP)&(+$$VERSION^XPDUTL("OR")<3):$$OEPAT,1:$$PAT^GMPLX1)
8 I (+NEWPT>0),(+NEWPT'=+GMPDFN) D
9 . S GMPDFN=NEWPT,VALMBG=1
10 . S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(+GMPDFN)
11 . D GETPLIST(.GMPLIST,.GMPTOTAL,.GMPLVIEW) K GMPRINT
12 . D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
13 S VALMSG=$$MSG^GMPLX
14 Q
15 ;
16OEPAT() ; Calls OE/RR to return new patient, or -1
17 N DFN,VADM,Y
18 D IN^OR I +ORVP'>0 Q -1
19 I +ORVP=+GMPDFN Q GMPDFN
20 S DFN=+ORVP D DEM^VADPT
21 S Y=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")
22 I VADM(6) S Y=Y_U_+VADM(6) ; date of death
23 Q Y
24 ;
25INACTIVE ; Incl inactive problems
26 S VALMBCK=$S(VALMCC:"",1:"R")
27 I GMPLVIEW("ACT")="" D Q
28 . W !!,"Listing already includes inactive problems!" H 1
29 I '$D(^AUPNPROB("ACTIVE",+GMPDFN,"I")) D Q
30 . W !!,"Patient has no inactive problems to include.",! H 1
31 S GMPLVIEW("ACT")="",VALMBCK="R",VALMSG=$$MSG^GMPLX
32 D GETPLIST(.GMPLIST,.GMPTOTAL,.GMPLVIEW),BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
33 Q
34 ;
35NEWSRV ; select new service
36 N DIC,NEWVIEW,VIEW,PROMPT,HELPMSG Q:$D(GMPQUIT)
37 S DIC="^DIC(49,",DIC("S")="I $P(^(0),U,9)=""C"""
38 S VIEW="service(s)",PROMPT="Select SERVICE: ",HELPMSG="LISTSERV"
39 D NEW Q:$D(GMPQUIT)
40 I NEWVIEW'=$E(GMPLVIEW("VIEW"),2,99) S GMPLVIEW("VIEW")="S"_NEWVIEW,GMPREBLD=1
41 Q
42 ;
43NEWCLIN ; Select new clinic
44 N DIC,NEWVIEW,VIEW,PROMPT,HELPMSG Q:$D(GMPQUIT)
45 S DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C"""
46 S VIEW="clinic(s)",PROMPT="Select CLINIC: ",HELPMSG="LISTCLIN"
47 D NEW Q:$D(GMPQUIT)
48 I NEWVIEW'=$E(GMPLVIEW("VIEW"),2,99) S GMPLVIEW("VIEW")="C"_NEWVIEW,GMPREBLD=1
49 Q
50 ;
51NEW ; prompt, from NEWSRV or NEWCLIN
52 N X,Y S NEWVIEW="",DIC(0)="EMQ"
53 W !!,"Enter the "_VIEW_" from which you wish to view problems:"
54 F D Q:$D(GMPQUIT)!(X="")
55 . W !,PROMPT R X:DTIME I '$T!(X["^") S GMPQUIT=1 Q
56 . Q:X="" I X="?" W !!?3,"Enter the "_VIEW_", one at a time, from which you wish to view",!?3,"problems; press <return> when you have finished.",! Q
57 . I X["??" D @HELPMSG Q
58 . D ^DIC I Y>0 S NEWVIEW=NEWVIEW_+Y_"/",PROMPT="ANOTHER ONE: "
59 I '$D(GMPQUIT),$L(NEWVIEW) S NEWVIEW="/"_NEWVIEW
60 Q
61 ;
62LISTSERV ; List clinical services
63 N I,CNT,Y S CNT=0,Y=""
64 W !,"Choose from: "
65 F I=0:0 S I=$O(^DIC(49,"F","C",I)) Q:I'>0 D Q:Y'=""
66 . S CNT=CNT+1 I '(CNT#8) D Q:Y="^"
67 . . W " ... more, or ^ to stop: " R Y:DTIME S:'$T Y="^"
68 . W !," "_$P(^DIC(49,I,0),U)
69 . W:$P(^(0),U,4) " ("_$P(^DIC(49,$P(^(0),U,4),0),U)_")"
70 W ! Q
71 ;
72LISTCLIN ; List clinics
73 N I,CNT,Y S CNT=0,Y=""
74 W !,"Choose from: "
75 F I=0:0 S I=$O(^SC(I)) Q:I'>0 D Q:Y'=""
76 . Q:$P($G(^SC(I,0)),U,3)'="C" ; must be a clinic
77 . S CNT=CNT+1 I '(CNT#8) D Q:Y="^"
78 . . W " ... more, or ^ to stop: " R Y:DTIME S:'$T Y="^"
79 . W !," "_$P($G(^SC(I,0)),U)
80 W ! Q
81 ;
82NEWPROV ; select new provider
83 N X,Y,DIC,NEWPROV Q:$D(GMPQUIT) S NEWPROV=""
84 S DIC="^VA(200,",DIC(0)="EMQ" ; screen on PROVIDER key ??
85 W !!,"Enter the name of the provider whose problems you wish to view:"
86NPRV R !,"Select PROVIDER: ",X:DTIME I '$T!(X["^") S GMPQUIT=1 Q
87 Q:X="" I X="?" D G NPRV
88 . W !!?3,"If you wish to see only those problems of the current patient that"
89 . W !?3,"are associated with a specific provider, enter his/her name here.",!
90 I X["??" D NPHELP^GMPLEDT2 G NPRV
91 D ^DIC S:+Y NEWPROV=Y I +Y'>0 G NPRV
92 I +NEWPROV'=+GMPLVIEW("PROV") S GMPLVIEW("PROV")=NEWPROV,GMPREBLD=1
93 Q
94 ;
95KEYS ; adds to XQORM("KEY") array
96 I $G(GMPARAM("VER")) S XQORM("KEY","$")=$O(^ORD(101,"B","GMPL VERIFY",0))_"^1"
97KEY S XQORM("KEY","=")=$O(^ORD(101,"B","VALM NEXT SCREEN",0))_"^1"
98 Q
99 ;
100GETPLIST(PLIST,TOTAL,VIEW) ; Build PLIST(#)=IFN for view
101 N STBEG,STEND,ST,CNT,IFN,RECORD,DATE,LIST K PLIST
102 W:'$G(GMPARAM("QUIET")) !,"Searching for the patient's problem list ..."
103 S STBEG=$S(VIEW("ACT")="I":"A",1:""),STEND=$S(VIEW("ACT")="A":"I",1:""),ST=STBEG,TOTAL=0
104 F S ST=$O(^AUPNPROB("ACTIVE",+GMPDFN,ST)) Q:(ST="")!(ST=STEND) D
105 . F IFN=0:0 S IFN=$O(^AUPNPROB("ACTIVE",+GMPDFN,ST,IFN)) Q:IFN'>0 D
106 . . S RECORD=$G(^AUPNPROB(IFN,1)) Q:'$L(RECORD)
107 . . Q:$P(RECORD,U,2)="H" S TOTAL=TOTAL+1
108 . . I $L(VIEW("VIEW"))>2,VIEW("VIEW")'[("/"_$P(RECORD,U,$S($E(VIEW("VIEW"))="S":6,1:8))_"/") Q
109 . . I VIEW("PROV"),$P(RECORD,U,5)'=+VIEW("PROV") Q
110 . . S DATE=$P(RECORD,U,9) S:'DATE DATE=$P($G(^AUPNPROB(IFN,0)),U,8)
111 . . S:GMPARAM("REV") DATE=9999999-DATE
112 . . S LIST(ST,DATE,IFN)=""
113 S ST="",CNT=0 F S ST=$O(LIST(ST)) Q:ST="" D
114 . S DATE="" F S DATE=$O(LIST(ST,DATE)) Q:DATE="" D
115 . . S IFN="" F S IFN=$O(LIST(ST,DATE,IFN)) Q:IFN="" S CNT=CNT+1,PLIST(CNT)=IFN,PLIST("B",IFN)=CNT
116 S PLIST(0)=CNT
117 Q
Note: See TracBrowser for help on using the repository browser.