| 1 | GMPLMGR2 ; SLC/MKB/KER/AJB -- Problem List VALM Utilities cont ; 04/15/2002
|
|---|
| 2 | ;;2.0;Problem List;**26,28**;Aug 25, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10082 ^ICD9(
|
|---|
| 6 | ; DBIA 872 ^ORD(101
|
|---|
| 7 | ; DBIA 10026 ^DIR
|
|---|
| 8 | ; DBIA 10116 $$SETFLD^VALM1
|
|---|
| 9 | ; DBIA 10116 CLEAR^VALM1
|
|---|
| 10 | ; DBIA 10140 EN^XQORM
|
|---|
| 11 | ;
|
|---|
| 12 | BLDPROB(IFN) ; Build Line for Problem in List
|
|---|
| 13 | ; Input INF Pointer to Problem file 9000011
|
|---|
| 14 | ; Expects GMPCOUNT
|
|---|
| 15 | N GMPL0,GMPL1,RESOLVED,TEXT,I,LINE,STR,SC,SP,ICD,ONSET,PROBLEM,STATUS
|
|---|
| 16 | Q:'$D(GMPCOUNT) S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) Q:'$L(GMPL0)
|
|---|
| 17 | S SC=$P(GMPL1,U,10),SP=$P(GMPL1,U,11,13)_"^"_$P(GMPL1,U,15,16),STATUS=$P(GMPL0,U,12)
|
|---|
| 18 | S:$P(GMPL1,U,2)="H" PROBLEM="< DELETED >" I $P(GMPL1,U,2)'="H" D
|
|---|
| 19 | . S PROBLEM=$$PROBTEXT^GMPLX(IFN),ONSET=$P(GMPL0,U,13)
|
|---|
| 20 | . I ONSET S PROBLEM=PROBLEM_", Onset "_$$EXTDT^GMPLX(ONSET)
|
|---|
| 21 | S RESOLVED=$J($$EXTDT^GMPLX($P(GMPL1,U,7)),8)
|
|---|
| 22 | S ICD=$P($G(^ICD9(+GMPL0,0)),U),GMPCOUNT=GMPCOUNT+1
|
|---|
| 23 | D WRAP^GMPLX(PROBLEM,40,.TEXT)
|
|---|
| 24 | S LINE=$$SETFLD^VALM1(GMPCOUNT,"","NUMBER")
|
|---|
| 25 | ; added for Code Set Versioning (CSV) - checks ICD code - # if inactive
|
|---|
| 26 | I '$$CODESTS^GMPLX(IFN,DT) D
|
|---|
| 27 | . I STATUS="A" S LINE=$$SETFLD^VALM1(" #",LINE,"STATUS")
|
|---|
| 28 | . I STATUS="I" S LINE=$$SETFLD^VALM1(STATUS_"#",LINE,"STATUS")
|
|---|
| 29 | E S:STATUS="I" LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
|
|---|
| 30 | ; S:STATUS="I" LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
|
|---|
| 31 | S LINE=$$SETFLD^VALM1(TEXT(1),LINE,"PROBLEM")
|
|---|
| 32 | S LINE=$$SETFLD^VALM1(ICD,LINE,"ICD")
|
|---|
| 33 | I $L(SC) D
|
|---|
| 34 | . S STR=$S(+SC:"YES",SC=0:"NO",1:" ")
|
|---|
| 35 | . S LINE=$$SETFLD^VALM1(STR,LINE,"SERV CONNECTED")
|
|---|
| 36 | I $L(SP) D
|
|---|
| 37 | . S STR=$S(+$P(SP,U):"Agent Orange",+$P(SP,U,2):"Radiation",+$P(SP,U,3):"Contaminants",+$P(SP,U,4):"Head/Neck Cancer",+$P(SP,U,5):"Mil Sexual Trauma",1:"")
|
|---|
| 38 | . S LINE=$$SETFLD^VALM1(STR,LINE,"EXPOSURE")
|
|---|
| 39 | S LINE=$$SETFLD^VALM1(RESOLVED,LINE,"RESOLVED")
|
|---|
| 40 | S VALMCNT=VALMCNT+1,^TMP("GMPL",$J,VALMCNT,0)=LINE
|
|---|
| 41 | S ^TMP("GMPLIDX",$J,GMPCOUNT)=VALMCNT_U_IFN
|
|---|
| 42 | I TEXT>1 F I=2:1:TEXT D
|
|---|
| 43 | . S LINE="",LINE=$$SETFLD^VALM1(TEXT(I),LINE,"PROBLEM")
|
|---|
| 44 | . S VALMCNT=VALMCNT+1,^TMP("GMPL",$J,VALMCNT,0)=LINE
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | HELP ; Help Code
|
|---|
| 48 | N X W !!?4,"You may take a variety of actions from this prompt. To update"
|
|---|
| 49 | W !?4,"the problem list select from Add, Remove, Edit, Inactivate,"
|
|---|
| 50 | W !?4,"and Enter Comment; you will then be prompted for the problem"
|
|---|
| 51 | W !?4,"number. To see all of this patient's problems, both active and"
|
|---|
| 52 | W !?4,"inactive, select Show All Problems; select Print to print the"
|
|---|
| 53 | W !?4,"same complete list in a chartable format. To see a listing of"
|
|---|
| 54 | W !?4,"actions that facilitate navigating the list, enter '??'."
|
|---|
| 55 | W !!,"Press <return> to continue ... " R X:DTIME
|
|---|
| 56 | S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | EXIT ; Exit Code
|
|---|
| 60 | I GMPARAM("PRT"),$D(GMPRINT) D AUTO
|
|---|
| 61 | K ^TMP("GMPL",$J),^TMP("GMPLIDX",$J)
|
|---|
| 62 | K XQORM("KEY","="),XQORM("XLATE")
|
|---|
| 63 | K GMPDFN,GMPROV,GMPLVIEW,GMPARAM,VALMBCK,VALMHDR,VALMCNT,GMPCOUNT,GMPLUSER,GMPSC,VALMSG,GMPVAMC,GMPLIST,GMPAGTOR,GMPION,GMPGULF,GMPVA,GMPTOTAL,GMPRINT,AUPNSEX,GMPCLIN
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | AUTO ; Print Problem List when Exiting Patient?
|
|---|
| 67 | ; Called from EXIT,NEWPAT^GMPLMGR1
|
|---|
| 68 | N DIR,X,Y Q:'GMPARAM("PRT") Q:'$D(GMPRINT)
|
|---|
| 69 | S DIR(0)="YA",DIR("A")="Print a new problem list? ",DIR("B")="YES"
|
|---|
| 70 | S DIR("?",1)="Press <return> to generate a new complete problem list for this patient;",DIR("?")="enter NO to continue without printing."
|
|---|
| 71 | W $C(7),!!,">>> THIS PATIENT'S PROBLEM LIST HAS CHANGED!"
|
|---|
| 72 | D ^DIR I $D(DTOUT)!($D(DTOUT)) S GMPQUIT=1 Q
|
|---|
| 73 | Q:'Y D VAF^GMPLPRNT,DEVICE^GMPLPRNT G:$D(GMPQUIT) AUTQ
|
|---|
| 74 | D CLEAR^VALM1,PRT^GMPLPRNT
|
|---|
| 75 | AUTQ ; Quit Auto-Print
|
|---|
| 76 | D KILL^GMPLX
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | SHOW ; Show Current View of List
|
|---|
| 80 | N VIEW,NUM,NAME S VIEW=$E(GMPLVIEW("VIEW")),NUM=$L(GMPLVIEW("VIEW"),"/")
|
|---|
| 81 | W !!,"CURRENT VIEW: "_$S(VIEW="S":"Inpatient, ",1:"Outpatient, ")
|
|---|
| 82 | I '((NUM>2)!($L(GMPLVIEW("ACT")))!(GMPLVIEW("PROV"))) W "all problems" Q
|
|---|
| 83 | W $S(GMPLVIEW("ACT")="A":"active",GMPLVIEW("ACT")="I":"inactive",1:"all")_" problems"
|
|---|
| 84 | I NUM>2 W " from "_$S(GMPLVIEW("VIEW")=$$VIEW^GMPLX1(DUZ):"preferred",1:"selected")_$S(VIEW="S":" services",1:" clinics")
|
|---|
| 85 | I GMPLVIEW("PROV") S NAME=$$NAME^GMPLX1(GMPLVIEW("PROV")) W:($X+$L(NAME)+4>80) ! W " by "_NAME
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | ENVIEW ; Entry Action to Display Appropriate View Menu
|
|---|
| 89 | N XQORM,X,Y,GMPLX S GMPLX=0 D SHOW S X="GMPL VIEW "_$S($E(GMPLVIEW("VIEW"))="S":"INPAT",1:"OUTPAT")
|
|---|
| 90 | S XQORM=+$O(^ORD(101,"B",X,0))_";ORD(101,",XQORM(0)="3AD"
|
|---|
| 91 | W !,"You may change your view of this patient's problem list by selecting one or",!,"more of the following attributes to alter:",!
|
|---|
| 92 | D EN^XQORM F S GMPLX=$O(Y(GMPLX)) Q:GMPLX'>0 X:$D(^ORD(101,+$P(Y(GMPLX),U,2),20)) ^(20)
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | EXVIEW ; Exit Action to Rebuild List w/New View
|
|---|
| 96 | S VALMBCK=$S(VALMCC:"",1:"R") I '$D(GMPQUIT),$G(GMPREBLD) D
|
|---|
| 97 | . S VALMBG=1,VALMBCK="R" D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
|
|---|
| 98 | . D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
|
|---|
| 99 | K GMPQUIT,GMPREBLD S VALMSG=$$MSG^GMPLX
|
|---|
| 100 | Q
|
|---|
