| [613] | 1 | GMPLX ; SLC/MKB/AJB -- Problem List Problem Utilities ; 02/27/2004
|
|---|
| 2 | ;;2.0;Problem List;**7,23,26,28,27**;Aug 25, 1994;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 446 ^AUTNPOV(
|
|---|
| 6 | ; DBIA 10082 ^ICD9("BA"
|
|---|
| 7 | ; DBIA 10060 ^VA(200
|
|---|
| 8 | ; DBIA 10006 ^DIC
|
|---|
| 9 | ; DBIA 10009 FILE^DICN
|
|---|
| 10 | ; DBIA 10013 EN^DIK
|
|---|
| 11 | ; DBIA 10013 IX1^DIK
|
|---|
| 12 | ; DBIA 10026 ^DIR
|
|---|
| 13 | ; DBIA 1609 CONFIG^LEXSET
|
|---|
| 14 | ; DBIA 10103 $$FMTE^XLFDT
|
|---|
| 15 | ; DBIA 10104 $$UP^XLFSTR
|
|---|
| 16 | ; DBIA 2742 GMPLX
|
|---|
| 17 | ; DBIA 3991 $$STATCHK^ICDAPIU
|
|---|
| 18 | ;
|
|---|
| 19 | SEARCH(X,Y,PROMPT,UNRES,VIEW) ; Search Lexicon for Problem X
|
|---|
| 20 | N DIC S:'$L($G(VIEW)) VIEW="PL1" D CONFIG^LEXSET("GMPL",VIEW,DT)
|
|---|
| 21 | S DIC("A")=$S($L($G(PROMPT)):PROMPT,1:"Select PROBLEM: ")
|
|---|
| 22 | S DIC="^LEX(757.01,",DIC(0)=$S('$L($G(X)):"A",1:"")_"EQM"
|
|---|
| 23 | S:'$G(UNRES) LEXUN=0 D ^DIC S:+Y>1 X=$P(Y,U,2)
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | PROVNARR(X,CL) ; Returns IFN ^ Text of Narrative (#9999999.27)
|
|---|
| 27 | N DIC,Y,DLAYGO,DD,DO,DA S:$L(X)>80 X=$E(X,1,80)
|
|---|
| 28 | S DIC="^AUTNPOV(",DIC(0)="L",DLAYGO=9999999.27,(DA,Y)=0
|
|---|
| 29 | F S DA=$O(^AUTNPOV("B",$E(X,1,30),DA)) Q:DA'>0 I $P(^AUTNPOV(DA,0),U)=X S Y=DA_U_X Q
|
|---|
| 30 | I '(+Y) K DA,Y D FILE^DICN S:Y'>0 Y=U_X I Y>0,CL>1 S ^AUTNPOV(+Y,757)=CL
|
|---|
| 31 | Q $P(Y,U,1,2)
|
|---|
| 32 | ;
|
|---|
| 33 | PROBTEXT(IFN) ; Returns Display Text
|
|---|
| 34 | N X,Y,GMPLEXP,GMPLPOV,GMPLSO,GMPLTXT
|
|---|
| 35 | S Y=$P($G(^AUPNPROB(+IFN,0)),U,5),X=$P($G(^AUTNPOV(+Y,0)),U)
|
|---|
| 36 | S GMPLEXP=$$EP(IFN),GMPLSO=$$CS(X),GMPLPOV=$$PT(X,GMPLSO)
|
|---|
| 37 | S GMPLTXT=GMPLPOV S:$L(GMPLEXP) GMPLTXT=GMPLTXT_" ("_GMPLEXP_")"
|
|---|
| 38 | S:$L(GMPLSO) GMPLTXT=GMPLTXT_" "_GMPLSO
|
|---|
| 39 | S:GMPLTXT["*" GMPLTXT=$TR(GMPLTXT,"*","")
|
|---|
| 40 | ;S:$L(GMPLTXT) GMPLTXT=GMPLTXT_" ("_$$HFP^GMPLUTL4_","_$$PTR^GMPLUTL4_")"
|
|---|
| 41 | S:$L(GMPLTXT) X=GMPLTXT Q X
|
|---|
| 42 | PROBNARR(IFN) ; Returns Provider Narrative
|
|---|
| 43 | N X,Y S Y=$P($G(^AUPNPROB(+IFN,0)),U,5),X=$P($G(^AUTNPOV(+Y,0)),U)
|
|---|
| 44 | Q X
|
|---|
| 45 | CS(X) ; Problem Codes
|
|---|
| 46 | N GMPLSAB,GMPLSO S GMPLSO="" S X=$G(X) Q:X'["(" ""
|
|---|
| 47 | F GMPLSAB="ICD-","CPT-","DSM-","HCPCS","NANDA","NIC","NOC","LOINC","SNOMED","OMAHA" S:$G(X)[("("_GMPLSAB) GMPLSO="("_GMPLSAB_$P(X,("("_GMPLSAB),2,299) Q:$L(GMPLSO)
|
|---|
| 48 | I $L(GMPLSO) S X=GMPLSO Q X
|
|---|
| 49 | F GMPLSAB="ACR","AI/RHEUM","CONGRESS","COSTAR","COSTART","CRISP","DODFAC" S:$G(X)[("("_GMPLSAB) GMPLSO="("_GMPLSAB_$P(X,("("_GMPLSAB),2,299) Q:$L(GMPLSO)
|
|---|
| 50 | I $L(GMPLSO) S X=GMPLSO Q X
|
|---|
| 51 | F GMPLSAB="DORLAND","DXPLAIN","HHCC","MCMASTER","META","MTF","MeSH","RVC","TITLE 38","UMDNS","UWA" S:$G(X)[("("_GMPLSAB) GMPLSO="("_GMPLSAB_$P(X,("("_GMPLSAB),2,299) Q:$L(GMPLSO)
|
|---|
| 52 | I $L(GMPLSO) S X=GMPLSO Q X
|
|---|
| 53 | Q ""
|
|---|
| 54 | EP(X) ; Exposures
|
|---|
| 55 | N GMPLSC S X=+($G(X)) D SCS^GMPLX1(+X,.GMPLSC) S X=$G(GMPLSC(1)) Q X
|
|---|
| 56 | PT(X,C) ; Problem Text (only)
|
|---|
| 57 | N GMPLTERM,GMPLSO S GMPLTERM=$G(X),GMPLSO=$G(C)
|
|---|
| 58 | S:$L(GMPLSO)&(GMPLTERM[GMPLSO) GMPLTERM=$P(GMPLTERM,GMPLSO,1) S GMPLTERM=$$TRIM(GMPLTERM)
|
|---|
| 59 | S:$L(GMPLTERM) X=GMPLTERM Q X
|
|---|
| 60 | TRIM(X) ; Trim Spaces and "*"
|
|---|
| 61 | S X=$G(X) F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
|---|
| 62 | F Q:$E(X,$L(X))'="*" S X=$E(X,1,($L(X)-1))
|
|---|
| 63 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
|---|
| 64 | F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
|---|
| 65 | Q X
|
|---|
| 66 | WRAP(PROB,MAX,TEXT) ; Splits Text into TEXT array
|
|---|
| 67 | N I,J S J=0 K TEXT I $L(PROB)'>MAX S J=J+1,TEXT(J)=PROB G WRQ
|
|---|
| 68 | WR0 ; Loop for Remaining Text
|
|---|
| 69 | S I=$F(PROB," ") I ('I)!(I>(MAX+2)) S J=J+1,TEXT(J)=$E(PROB,1,MAX),PROB=$E(PROB,MAX+1,999)
|
|---|
| 70 | I $L(PROB)>MAX F I=(MAX+1):-1:1 I $E(PROB,I)=" " S J=J+1,TEXT(J)=$E(PROB,1,I-1),PROB=$E(PROB,I+1,999) Q
|
|---|
| 71 | G:$L(PROB)>MAX WR0
|
|---|
| 72 | S:$L(PROB) J=J+1,TEXT(J)=PROB
|
|---|
| 73 | WRQ ; Quit Wrap
|
|---|
| 74 | S TEXT=J
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | NOS() ; Return PTR ^ 799.9 ICD code
|
|---|
| 78 | N X S X=$O(^ICD9("BA",799.9,0)) Q (+X_"^799.9")
|
|---|
| 79 | ;
|
|---|
| 80 | SEL(HELP) ; Select List of Problems
|
|---|
| 81 | N X,Y,DIR,MAX S MAX=+$G(^TMP("GMPL",$J,0)) I MAX'>0 Q "^"
|
|---|
| 82 | S DIR(0)="LAO^1:"_MAX,DIR("A")="Select Problem(s)"
|
|---|
| 83 | S:MAX>1 DIR("A")=DIR("A")_" (1-"_MAX_"): "
|
|---|
| 84 | S:MAX'>1 DIR("A")=DIR("A")_": ",DIR("B")=1
|
|---|
| 85 | S DIR("?")="Enter the problems you wish to "
|
|---|
| 86 | S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")_", as a range or list of numbers"
|
|---|
| 87 | D ^DIR I $D(DTOUT)!(X="") S Y="^"
|
|---|
| 88 | Q Y
|
|---|
| 89 | ;
|
|---|
| 90 | SEL1(HELP) ; Select 1 Problem
|
|---|
| 91 | N X,Y,DIR,MAX S MAX=+$G(^TMP("GMPL",$J,0)) I MAX'>0 Q "^"
|
|---|
| 92 | S DIR(0)="NAO^1:"_MAX_":0",DIR("A")="Select Problem"
|
|---|
| 93 | S:MAX>1 DIR("A")=DIR("A")_" (1-"_MAX_"): "
|
|---|
| 94 | S:MAX'>1 DIR("A")=DIR("A")_": ",DIR("B")=1
|
|---|
| 95 | S DIR("?")="Enter the number of the problem you wish to "
|
|---|
| 96 | S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")
|
|---|
| 97 | D ^DIR I $D(DTOUT)!(X="") S Y="^"
|
|---|
| 98 | Q Y
|
|---|
| 99 | ;
|
|---|
| 100 | DUPL(DFN,TERM,TEXT) ; Check's for Duplicate Entries
|
|---|
| 101 | N DA,IFN,NODE0,NODE1 S DA=0,TEXT=$$UP^XLFSTR(TEXT)
|
|---|
| 102 | I '$D(^AUPNPROB("C",TERM))!('$D(^AUPNPROB("AC",DFN))) Q DA
|
|---|
| 103 | F IFN=0:0 S IFN=$O(^AUPNPROB("AC",DFN,IFN)) Q:IFN'>0 D Q:DA>0
|
|---|
| 104 | . S NODE0=$G(^AUPNPROB(IFN,0)),NODE1=$G(^(1)) Q:$P(NODE1,U,2)="H"
|
|---|
| 105 | . I TERM>1 S:+NODE1=TERM DA=IFN Q
|
|---|
| 106 | . S:TEXT=$$UP^XLFSTR($P(^AUTNPOV($P(NODE0,U,5),0),U)) DA=IFN
|
|---|
| 107 | Q DA
|
|---|
| 108 | ;
|
|---|
| 109 | DUPLOK(IFN) ; Ask to Duplicate Problem
|
|---|
| 110 | N DIR,X,Y,GMPL0,GMPL1,DATE,PROV S DIR(0)="YA",GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1))
|
|---|
| 111 | S DIR("A")="Are you sure you want to continue? ",DIR("B")="NO"
|
|---|
| 112 | S DIR("?",1)="Enter YES if you want to duplicate this problem on this patient's list;",DIR("?")="press <return> to re-enter the problem name."
|
|---|
| 113 | W $C(7),!!,">>> "_$$PROBTEXT(IFN),!?5,"is already an "
|
|---|
| 114 | W $S($P(GMPL0,U,12)="I":"IN",1:"")_"ACTIVE problem on this patient's list!",!
|
|---|
| 115 | S PROV=+$P(GMPL1,U,5) W:PROV !?5,"Provider: "_$P($G(^VA(200,PROV,0)),U)_" ("_$P($$SERVICE^GMPLX1(PROV),U,2)_")"
|
|---|
| 116 | I $P(GMPL0,U,12)="A" W !?8,"Onset: " S DATE=$P(GMPL0,U,13)
|
|---|
| 117 | I $P(GMPL0,U,12)="I" W !?5,"Resolved: " S DATE=$P(GMPL1,U,7)
|
|---|
| 118 | W $S(DATE>0:$$FMTE^XLFDT(DATE),1:"unspecified"),!
|
|---|
| 119 | D ^DIR W !
|
|---|
| 120 | Q +Y
|
|---|
| 121 | ;
|
|---|
| 122 | LOCKED() ; Returns Message that Problem is Locked
|
|---|
| 123 | Q "This problem is currently being edited by another user!"
|
|---|
| 124 | ;
|
|---|
| 125 | SURE() ; Ask to Delete
|
|---|
| 126 | ; Returns 1 if YES, else 0
|
|---|
| 127 | N DIR,X,Y S DIR(0)="YA",DIR("B")="NO"
|
|---|
| 128 | S DIR("?")="Enter YES to remove this value or NO to leave it unchanged."
|
|---|
| 129 | S DIR("A")="Are you sure you want to remove this value? " D ^DIR
|
|---|
| 130 | Q +Y
|
|---|
| 131 | ;
|
|---|
| 132 | EXTDT(DATE) ; Formats Date into MM/DD/YY
|
|---|
| 133 | N X,MM,DD,YY,YYY S X="",DATE=$P(DATE,".") Q:'DATE ""
|
|---|
| 134 | S MM=+$E(DATE,4,5),DD=+$E(DATE,6,7),YY=$E(DATE,2,3),YYY=$E(DATE,1,3)
|
|---|
| 135 | S:MM X=MM_"/" S:DD X=X_DD_"/" S X=$S($L(X):X_YY,1:1700+YYY)
|
|---|
| 136 | Q X
|
|---|
| 137 | ;
|
|---|
| 138 | AUDIT(DATA,OLD) ; Makes Entry in Audit File
|
|---|
| 139 | ; DATA = string for 0-node
|
|---|
| 140 | ; OLD = string for 1-node
|
|---|
| 141 | ; = 0-node from reform/react problem
|
|---|
| 142 | N DA,DD,DO,DIC,X,Y,DIK,DLAYGO
|
|---|
| 143 | S DIC="^GMPL(125.8,",DIC(0)="L",X=$P(DATA,U),DLAYGO=125.8
|
|---|
| 144 | D FILE^DICN Q:+Y'>0 S DA=+Y,DIK="^GMPL(125.8,"
|
|---|
| 145 | S ^GMPL(125.8,DA,0)=DATA D IX1^DIK
|
|---|
| 146 | S:$L(OLD) ^GMPL(125.8,DA,1)=OLD
|
|---|
| 147 | Q
|
|---|
| 148 | ;
|
|---|
| 149 | DTMOD(DA) ; Update Date Last Modified
|
|---|
| 150 | N DIE,DR
|
|---|
| 151 | S DR=".03///TODAY",DIE="^AUPNPROB("
|
|---|
| 152 | D ^DIE
|
|---|
| 153 | Q
|
|---|
| 154 | ;
|
|---|
| 155 | MSG() ; List Manager Message Bar
|
|---|
| 156 | Q "+ Next Screen - Prev Screen ?? More actions"
|
|---|
| 157 | ;
|
|---|
| 158 | KILL ; Clean-Up Variables
|
|---|
| 159 | K X,Y,DIC,DIE,DR,DA,DUOUT,DTOUT,GMPQUIT,GMPRT,GMPSAVED,GMPIFN,GMPLNO,GMPLNUM,GMPLSEL,GMPREBLD,GMPI,GMPLSLST,GMPLJUMP
|
|---|
| 160 | Q
|
|---|
| 161 | ;
|
|---|
| 162 | CODESTS(PROB,ADATE) ;check status of code associated with a problem
|
|---|
| 163 | ; Input:
|
|---|
| 164 | ; PROB = pointer to the PROBLEM (#9000011) file
|
|---|
| 165 | ; ADATE = FM date on which to check the status of ICD9 code (opt.)
|
|---|
| 166 | ;
|
|---|
| 167 | ; Output:
|
|---|
| 168 | ; 1 = ACTIVE on the date passed or current date if not passed
|
|---|
| 169 | ; 0 = INACTIVE on the date passed or current date if not passed
|
|---|
| 170 | ;
|
|---|
| 171 | I '$G(ADATE) S ADATE=DT
|
|---|
| 172 | I '$D(^AUPNPROB(PROB,0)) Q 0
|
|---|
| 173 | S PROB=$P(^AUPNPROB(PROB,0),U)
|
|---|
| 174 | Q +($$STATCHK^ICDAPIU($$CODEC^ICDCODE(+(PROB)),ADATE))
|
|---|
