| 1 | GMPL1 ; SLC/MKB/AJB -- Problem List actions ; 04/22/03
|
---|
| 2 | ;;2.0;Problem List;**3,20,28**;Aug 25, 1994
|
---|
| 3 | ; 10 MAR 2000 - MA - Added to the routine another user prompt
|
---|
| 4 | ; to backup and refine Lexicon search if ICD code 799.9
|
---|
| 5 | ADD ;add new entry to list - Requires GMPDFN
|
---|
| 6 | N GMPROB,GMPTERM,GMPICD,Y,DUP W !
|
---|
| 7 | S GMPROB=$$TEXT^GMPLEDT4("") I GMPROB="^" S GMPQUIT=1 Q
|
---|
| 8 | I 'GMPARAM("CLU")!('$D(GMPLUSER)&('$D(^XUSEC("GMPL ICD CODE",DUZ)))) S GMPTERM="",GMPICD="799.9" G ADD1
|
---|
| 9 | F D Q:$D(GMPQUIT)!(+$G(Y))
|
---|
| 10 | . D SEARCH^GMPLX(.GMPROB,.Y,"PROBLEM: ","1")
|
---|
| 11 | . I +Y'>0 S GMPQUIT=1 Q
|
---|
| 12 | . S DUP=$$DUPL^GMPLX(+GMPDFN,+Y,GMPROB)
|
---|
| 13 | . I DUP,'$$DUPLOK^GMPLX(DUP) S (Y,GMPROB)=""
|
---|
| 14 | . I +Y=1 D ICDMSG
|
---|
| 15 | Q:$D(GMPQUIT)
|
---|
| 16 | S GMPTERM=$S(+$G(Y)>1:Y,1:""),GMPICD=$G(Y(1))
|
---|
| 17 | S:'$L(GMPICD) GMPICD="799.9"
|
---|
| 18 | ADD1 ; set up default values
|
---|
| 19 | ; -- May enter here with GMPROB=text,GMPICD=code,GMPTERM=#^term
|
---|
| 20 | ; added for Code Set Versioning (CSV)
|
---|
| 21 | I '+$$STATCHK^ICDAPIU(GMPICD,DT) W !,GMPROB,!,"has an inactive code. Please edit before adding." H 3 Q
|
---|
| 22 | N OK,GMPI,GMPFLD K GMPLJUMP
|
---|
| 23 | S GMPFLD(1.01)=GMPTERM,GMPFLD(.05)=U_GMPROB
|
---|
| 24 | S GMPFLD(.01)=$O(^ICD9("AB",GMPICD_" ",0))_U_GMPICD
|
---|
| 25 | S:'GMPFLD(.01) GMPFLD(.01)=$$NOS^GMPLX ; cannot resolve code
|
---|
| 26 | S (GMPFLD(1.04),GMPFLD(1.05))=$G(GMPROV),GMPFLD(1.03)=DUZ
|
---|
| 27 | S GMPFLD(1.06)=$$SERVICE^GMPLX1(+GMPFLD(1.04)),GMPFLD(1.08)=$G(GMPCLIN)
|
---|
| 28 | S (GMPFLD(.08),GMPFLD(1.09))=DT_U_$$EXTDT^GMPLX(DT)
|
---|
| 29 | S GMPFLD(.12)="A^ACTIVE",GMPFLD(1.14)="",GMPFLD(10,0)=0
|
---|
| 30 | S GMPFLD(1.02)=$S('$G(GMPARAM("VER")):"P",$D(GMPLUSER):"P",1:"T")
|
---|
| 31 | S (GMPFLD(.13),GMPFLD(1.07))="" ; initialize dates
|
---|
| 32 | S GMPFLD(1.1)=$S('GMPSC:"0^NO",1:""),GMPFLD(1.11)=$S('GMPAGTOR:"0^NO",1:"")
|
---|
| 33 | S GMPFLD(1.12)=$S('GMPION:"0^NO",1:""),GMPFLD(1.13)=$S('GMPGULF:"0^NO",1:"")
|
---|
| 34 | ADD2 ; prompt for values
|
---|
| 35 | D FLDS^GMPLEDT3 ; set GMPFLD("FLD") of editable fields
|
---|
| 36 | F GMPI=2:1:7 D @(GMPFLD("FLD",GMPI)_"^GMPLEDT1") Q:$D(GMPQUIT) K GMPLJUMP ; cannot ^-jump here
|
---|
| 37 | Q:$D(GMPQUIT)
|
---|
| 38 | ADD3 ; Ok to save?
|
---|
| 39 | S OK=$$ACCEPT^GMPLDIS1(.GMPFLD),GMPLJUMP=0 ; ok to save values?
|
---|
| 40 | I OK="^" W !!?10,"< Nothing Saved !! >",! S GMPQUIT=1 H 1 Q
|
---|
| 41 | I OK D Q ; ck DA for error?
|
---|
| 42 | . N I W !!,"Saving ..." D NEW^GMPLSAVE
|
---|
| 43 | . S I=$S(GMPLIST(0)'>0:1,GMPARAM("REV"):$O(GMPLIST(0))-.01,1:GMPLIST(0)+1)
|
---|
| 44 | . S GMPLIST(I)=DA,GMPLIST("B",DA)=I,GMPLIST(0)=$G(GMPLIST(0))+1
|
---|
| 45 | . W " done."
|
---|
| 46 | ; Not ok -- edit values, ask again
|
---|
| 47 | F GMPI=1:1:GMPFLD("FLD",0) D @(GMPFLD("FLD",GMPI)_"^GMPLEDT1") Q:$D(GMPQUIT)!($D(GMPSAVED)) I $G(GMPLJUMP) S GMPI=GMPLJUMP-1 S GMPLJUMP=0 ; reset GMPI to desired fld
|
---|
| 48 | Q:$D(DTOUT) K GMPQUIT,DUOUT G ADD3
|
---|
| 49 | Q
|
---|
| 50 | ;
|
---|
| 51 | ; *********************************************************************
|
---|
| 52 | ; * GMPIFN expected for the following calls:
|
---|
| 53 | ;
|
---|
| 54 | STATUS ; -- inactivate problem
|
---|
| 55 | N DIE,DA,DR,X,Y,CHNGE,GMPFLD,PROMPT,DEFAULT
|
---|
| 56 | S GMPFLD(.13)=$P($G(^AUPNPROB(GMPIFN,0)),U,13) ; Onset
|
---|
| 57 | W !!,$$PROBTEXT^GMPLX(GMPIFN) D RESOLVED^GMPLEDT4 Q:$D(GMPQUIT)
|
---|
| 58 | S PROMPT="COMMENT (<60 char): ",DEFAULT="" D EDNOTE^GMPLEDT4 Q:$D(GMPQUIT)
|
---|
| 59 | W ! I Y'="" S GMPFLD(10,"NEW",1)=Y D NEWNOTE^GMPLSAVE W "."
|
---|
| 60 | S DIE="^AUPNPROB(",DR=".12///I;1.07////"_$P($G(GMPFLD(1.07)),U)
|
---|
| 61 | S DA=GMPIFN D ^DIE W "."
|
---|
| 62 | S CHNGE=GMPIFN_"^.12^"_$$HTFM^XLFDT($H)_U_DUZ_"^A^I^^"_+$G(GMPROV)
|
---|
| 63 | D AUDIT^GMPLX(CHNGE,"") W "." ; audit trail
|
---|
| 64 | D DTMOD^GMPLX(GMPIFN) W "." ; update Dt Last Mod
|
---|
| 65 | W "... inactivated!",!
|
---|
| 66 | H 1 S GMPSAVED=1
|
---|
| 67 | Q
|
---|
| 68 | ;
|
---|
| 69 | NEWNOTE ; -- add a new comment
|
---|
| 70 | N GMPFLD
|
---|
| 71 | W !!,$$PROBTEXT^GMPLX(GMPIFN)
|
---|
| 72 | I '$$CODESTS^GMPLX(GMPIFN,DT) W !,"is inactive. Edit the problem before adding comments.",! H 2 Q
|
---|
| 73 | D NOTE^GMPLEDT1 Q:$D(GMPQUIT)!($D(GMPFLD(10,"NEW"))'>9)
|
---|
| 74 | D NEWNOTE^GMPLSAVE,DTMOD^GMPLX(GMPIFN)
|
---|
| 75 | S GMPSAVED=1
|
---|
| 76 | Q
|
---|
| 77 | ;
|
---|
| 78 | DELETE ; -- delete a problem
|
---|
| 79 | N PROMPT,DEFAULT,X,Y,CHNGE,GMPFLD
|
---|
| 80 | W !!,$$PROBTEXT^GMPLX(GMPIFN)
|
---|
| 81 | S PROMPT="REASON FOR REMOVAL: ",DEFAULT=""
|
---|
| 82 | D EDNOTE^GMPLEDT4 Q:$D(GMPQUIT) W !
|
---|
| 83 | I Y'="" S GMPFLD(10,"NEW",1)=Y D NEWNOTE^GMPLSAVE W "."
|
---|
| 84 | S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV)
|
---|
| 85 | S $P(^AUPNPROB(GMPIFN,1),U,2)="H",GMPSAVED=1 W "."
|
---|
| 86 | D AUDIT^GMPLX(CHNGE,""),DTMOD^GMPLX(GMPIFN) W "."
|
---|
| 87 | W "... removed!",! H 1
|
---|
| 88 | Q
|
---|
| 89 | ;
|
---|
| 90 | VERIFY ; -- verify a transcribed problem, if parameter on
|
---|
| 91 | N NOW,CHNGE S NOW=$$HTFM^XLFDT($H)
|
---|
| 92 | W !!,$$PROBTEXT^GMPLX(GMPIFN),!
|
---|
| 93 | I '$$CODESTS^GMPLX(GMPIFN,DT) W "has an inactive ICD9 code. Edit the problem before verification.",! H 2 Q
|
---|
| 94 | I $P($G(^AUPNPROB(GMPIFN,1)),U,2)'="T" W "does not require verification.",! H 2 Q
|
---|
| 95 | L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),$$LOCKED^GMPLX,! H 2 Q
|
---|
| 96 | S $P(^AUPNPROB(GMPIFN,1),U,2)="P",GMPSAVED=1 W "."
|
---|
| 97 | S CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ W "."
|
---|
| 98 | D AUDIT^GMPLX(CHNGE,""),DTMOD^GMPLX(GMPIFN) W "."
|
---|
| 99 | L -^AUPNPROB(GMPIFN,0) W " verified.",!
|
---|
| 100 | Q
|
---|
| 101 | ICDMSG ; If Lexicon returns ICD code 799.9
|
---|
| 102 | N DIR,DTOUT,DUOUT
|
---|
| 103 | S DIR(0)="YAO"
|
---|
| 104 | S DIR("A",1)="<< If you PROCEED WITH THIS NON SPECIFIC TERM, an ICD CODE OF 799.9 >>"
|
---|
| 105 | S DIR("A",2)="<< OTHER UNKNOWN AND UNSPECIFIED CAUSE OF MORBIDITY OR MORTALITY >>"
|
---|
| 106 | S DIR("A",3)="<< will be assigned. Adding more specificity to your diagnosis may >>"
|
---|
| 107 | S DIR("A",4)="<< allow a more accurate ICD code. >>"
|
---|
| 108 | S DIR("A",5)=""
|
---|
| 109 | S DIR("A")="Continue (YES/NO) ",DIR("B")="NO"
|
---|
| 110 | S DIR("T")=DTIME
|
---|
| 111 | D ^DIR
|
---|
| 112 | I $D(DTOUT)!$D(DUOUT) S Y=0
|
---|
| 113 | I +Y=0 S (GMPLY,GMPROB)=""
|
---|
| 114 | Q
|
---|