source: FOIAVistA/trunk/r/PROBLEM_LIST-GMPL/GMPLMGR.m@ 813

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1GMPLMGR ; SLC/MKB/AJB -- Problem List VALM Utilities ;3/1/00 12:28
2 ;;2.0;Problem List;**21,28**;Aug 25, 1994
3 ; 28 Feb 00 - MA added view comments accross Divisions
4INIT ; -- init variables, list array
5 S:'$G(GMPDFN) GMPDFN=$$PAT^GMPLX1 I +GMPDFN'>0 K GMPDFN S VALMQUIT=1 Q
6 S GMPROV=$$REQPROV^GMPLX1 I +GMPROV'>0 K GMPDFN,GMPROV S VALMQUIT=1 Q
7IN1 S GMPVA=$S($G(DUZ("AG"))="V":1,1:0),GMPVAMC=+$G(DUZ(2))
8 S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(+GMPDFN) ;reset
9 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0
10 S GMPLVIEW("VIEW")=$$VIEW^GMPLX1(DUZ)
11 S X=$G(^GMPL(125.99,1,0)),GMPARAM("VER")=+$P(X,U,2),GMPARAM("PRT")=+$P(X,U,3),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=$S($P(X,U,5)="R":1,1:0) K X
12 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW),BUILD(.GMPLIST)
13 D:$E(GMPLVIEW("VIEW"))="S" CHGCAP^VALM("CLINIC","Service/Provider")
14 S VALMSG=$$MSG^GMPLX
15 Q
16 ;
17BUILD(PLIST) ; -- build list array
18 N I D CLEAN^VALM10 K ^TMP("GMPLIDX",$J) S (I,GMPCOUNT,VALMCNT)=0
19 D:$D(XRTL) T0^%ZOSV ; Start RT Monitor
20 F S I=$O(PLIST(I)) Q:I'>0 D:$D(GMPLUSER) BLDPROB(+PLIST(I)) D:'$D(GMPLUSER) BLDPROB^GMPLMGR2(+PLIST(I))
21 S ^TMP("GMPL",$J,0)=+$G(GMPCOUNT)_U_+$G(VALMCNT) ; # entries^# lines
22 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Monitor
23 I $G(GMPCOUNT)'>0 S ^TMP("GMPL",$J,1,0)=" ",^TMP("GMPL",$J,2,0)=" No data available meeting criteria."
24 Q
25BLDPROB(IFN) ; Add problem line
26 N GMPL0,GMPL1,DATE,TEXT,NAME,LINE,ACTIVE,I,NOTE,FAC,PROBLEM,NIFN,DELETED
27 S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) Q:'$L(GMPL0)
28 S DELETED=$S($P(GMPL1,U,2)="H":1,1:0) ; flag if prob was deleted
29 S ACTIVE=$P(GMPL0,U,12),DATE=$J($$EXTDT^GMPLX($P(GMPL0,U,3)),8)
30 S PROBLEM=$S(DELETED:"< DELETED >",1:$$PROBTEXT^GMPLX(IFN))
31 I ACTIVE="A",$P(GMPL0,U,13),'DELETED S PROBLEM=PROBLEM_", Onset "_$$EXTDT^GMPLX($P(GMPL0,U,13))
32 I ACTIVE="I",$P(GMPL1,U,7),'DELETED S PROBLEM=PROBLEM_", Resolved "_$$EXTDT^GMPLX($P(GMPL1,U,7))
33 D WRAP^GMPLX(PROBLEM,40,.TEXT) ; format text to 41 chr
34 I $E(GMPLVIEW("VIEW"))="S" S NAME=$$SERV^GMPLX1($P(GMPL1,U,6))_$$NAME^GMPLX1($P(GMPL1,U,5))
35 E S NAME=$P($G(^SC(+$P(GMPL1,U,8),0)),U)
36BLD1 S GMPCOUNT=+$G(GMPCOUNT)+1
37 S LINE=$$SETFLD^VALM1(GMPCOUNT,"","NUMBER")
38 S:ACTIVE="A" ACTIVE=$S($P(GMPL1,U,14)="A":"*",1:"") ; reset for priority
39 S LINE=$$SETFLD^VALM1(ACTIVE,LINE,"STATUS")
40 S LINE=$$SETFLD^VALM1(TEXT(1),LINE,"PROBLEM")
41 S LINE=$$SETFLD^VALM1(DATE,LINE,"DATE")
42 S LINE=$$SETFLD^VALM1(NAME,LINE,"CLINIC"),VALMCNT=+$G(VALMCNT)+1
43 S ^TMP("GMPL",$J,VALMCNT,0)=LINE,^TMP("GMPL",$J,"IDX",VALMCNT,GMPCOUNT)=""
44 S ^TMP("GMPLIDX",$J,GMPCOUNT)=VALMCNT_U_IFN
45 I GMPARAM("VER"),$P(GMPL1,U,2)="T",'DELETED S LINE=$E(LINE,1,4)_"$"_$E(LINE,6,79),^TMP("GMPL",$J,VALMCNT,0)=LINE D CNTRL^VALM10(VALMCNT,5,1,IOINHI,IOINORM)
46 ; added for Code Set Versioning (CSV) - annotates inactive ICD code with #
47 I '$$CODESTS^GMPLX(IFN,DT) S LINE=$E(LINE,1,4)_"#"_$E(LINE,6,79),^TMP("GMPL",$J,VALMCNT,0)=LINE D CNTRL^VALM10(VALMCNT,5,1,IOINHI,IOINORM)
48 Q:DELETED
49BLD2 I TEXT>1 F I=2:1:TEXT D
50 . S LINE="",LINE=$$SETFLD^VALM1(TEXT(I),LINE,"PROBLEM")
51 . S VALMCNT=VALMCNT+1,^TMP("GMPL",$J,VALMCNT,0)=LINE
52 . S ^TMP("GMPL",$J,"IDX",VALMCNT,GMPCOUNT)=""
53 ;Q:'$D(^AUPNPROB(IFN,11,"B",+GMPVAMC)) ; display current user's notes
54 ; Routine has been changed to show all Problem List Comments for
55 ; Divisions per Clinical Workgroup decision 26 Jan 2000
56 F FAC=0:0 S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D
57 . F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:+NIFN'>0 D
58 . . S NOTE=$P($G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3)
59 . . S VALMCNT=VALMCNT+1,^TMP("GMPL",$J,"IDX",VALMCNT,GMPCOUNT)=""
60 . . S ^TMP("GMPL",$J,VALMCNT,0)=" "_NOTE
61 Q
62 ;
63HDR ; -- header code
64 N HDR,LNM,FNM,PAT,NUM
65 S PAT=$P(GMPDFN,U,2)_" ("_$P(GMPDFN,U,3)_")"
66 S NUM=GMPCOUNT S:GMPTOTAL>GMPCOUNT NUM=NUM_" of "_GMPTOTAL
67 S NUM=NUM_$S(GMPLVIEW("ACT")="A":" active",GMPLVIEW("ACT")="I":" inactive",1:"")_" problems"
68 S VALMHDR(1)=PAT_$J(NUM,79-$L(PAT))
69 S HDR=$S(GMPLVIEW("ACT")="I":"INACTIVE",GMPLVIEW("ACT")="A":"ACTIVE",1:"ALL")
70 I $L(GMPLVIEW("VIEW"))>2 S HDR=HDR_$S($E(GMPLVIEW("VIEW"))="S":" SERVICE",1:" CLINIC") ; screened
71 S HDR=HDR_" PROBLEMS"
72 S:GMPLVIEW("PROV") LNM=$P($P(GMPLVIEW("PROV"),U,2),","),FNM=$P($P(GMPLVIEW("PROV"),U,2),",",2),HDR=HDR_" BY "_FNM_" "_LNM
73 S VALMHDR(2)=$J(HDR,$L(HDR)\2+41)
74 Q
75 ;
76HELP ; -- help code
77 N X
78 W !!?4,"To update the problem list first select from Add, Remove, Edit,"
79 W !?4 W:GMPARAM("VER") "Verify, "
80 W "Inactivate, or Comment, then enter the problem number(s)."
81 W !?4,"If you need more information on a problem, select Detailed"
82 W !?4,"Display; to change whether all or only selected problems for this"
83 W !?4,"patient are listed, choose Select View. Enter ?? to see more"
84 W !?4,"actions for facilitating navigation of the list."
85 W !?4,"Problem statuses: *-Acute I-Inactive #-Inactive ICD Code"
86 W:GMPARAM("VER") " $-Unverified"
87 W !!,"Press <return> to continue ... " R X:DTIME
88 S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
89 Q
Note: See TracBrowser for help on using the repository browser.