| 1 | GMRAFX ;SLC/DAN Fix existing allergy entries ;3/2/06 13:46
|
|---|
| 2 | ;;4.0;Adverse Reaction Tracking;**17,19,23,20**;Mar 29, 1996;Build 1
|
|---|
| 3 | ;DBIA SECTION
|
|---|
| 4 | ;10118 - VALM
|
|---|
| 5 | ;2056 - DIQ
|
|---|
| 6 | ;3744 - $$TESTPAT^VADPT
|
|---|
| 7 | ;10006 - DIC
|
|---|
| 8 | ;10103 - XLFDT
|
|---|
| 9 | ;10102 - XQORM1
|
|---|
| 10 | ;10104 - XLFSTR
|
|---|
| 11 | ;10117 - VALM10
|
|---|
| 12 | ;10116 - VALM1
|
|---|
| 13 | ;10026 - DIR
|
|---|
| 14 | ;10018 - DIE
|
|---|
| 15 | ;10013 - DIK
|
|---|
| 16 | ;10061 - VADPT
|
|---|
| 17 | ;10101 - XQOR
|
|---|
| 18 | ;
|
|---|
| 19 | EN ; -- main entry point for GMRA FIX
|
|---|
| 20 | N NMBR,REBLD,Y,DIR,I,LTYPE
|
|---|
| 21 | S LTYPE=$$GETTYPE^GMRAFX3(.LTYPE) Q:LTYPE=0
|
|---|
| 22 | I $D(^XTMP("GMRAFX",LTYPE,"B")) W !,"The list is currently being built by another user so this option is",!,"temporarily unavailable. Please try again in a few minutes." Q
|
|---|
| 23 | I $D(^XTMP("GMRAFX",LTYPE,"INUSE")) D
|
|---|
| 24 | .W !,"The utility is currently in use by the following people:",!
|
|---|
| 25 | .S I=0 F S I=$O(^XTMP("GMRAFX",LTYPE,"INUSE",I)) Q:'+I W !,$$GET1^DIQ(200,I,.01)
|
|---|
| 26 | .W !!,"As a result, the existing "_$S(LTYPE="FREE":"free text",LTYPE="ING":"ingredient",1:"drug class")_" list will be used." D WAIT^GMRAFX3
|
|---|
| 27 | I $D(^XTMP("GMRAFX",LTYPE)),'$D(^XTMP("GMRAFX",LTYPE,"INUSE")) D
|
|---|
| 28 | .W !,"The "_$S(LTYPE="FREE":"free text",LTYPE="ING":"ingredient",1:"drug class")_" list was last built on ",$$FMTE^XLFDT($P(^XTMP("GMRAFX",LTYPE,0),U,2)),!
|
|---|
| 29 | .S DIR(0)="Y",DIR("A")="Do you want to rebuild the list",DIR("B")="NO",DIR("?")="Enter yes to rebuild the list of entries. Enter NO to use the currently existing list"
|
|---|
| 30 | .D ^DIR I Y=1 K ^XTMP("GMRAFX",LTYPE) S REBLD=1
|
|---|
| 31 | I $G(REBLD)!('$D(^XTMP("GMRAFX",LTYPE))) W !,"Building list of "_$S(LTYPE="FREE":"free text",LTYPE="ING":"ingredient",1:"drug class")_" allergies...this may take a few minutes",!
|
|---|
| 32 | S ^XTMP("GMRAFX",LTYPE,"INUSE",+$G(DUZ))=""
|
|---|
| 33 | D EN^VALM("GMRA FIX")
|
|---|
| 34 | K ^XTMP("GMRAFX",LTYPE,"INUSE",+$G(DUZ))
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | HDR ; -- header code
|
|---|
| 38 | S VALMHDR(1)="Allergy Tracking "_$S(LTYPE="FREE":"Free Text",LTYPE="ING":"Ingredient",1:"Drug CLass")_" Entries"
|
|---|
| 39 | Q
|
|---|
| 40 | PHDR ;
|
|---|
| 41 | S VALMSG="Select one or more entries"
|
|---|
| 42 | S XQORM("#")=$$FIND1^DIC(101,,"BX","GMRA FIX FREE TEXT LIST") ;19
|
|---|
| 43 | D SHOW^VALM
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | INIT ;Initialize variables, etc
|
|---|
| 47 | S VALMBCK="",VALMBG=$S($G(VALMBG)'="":VALMBG,1:1),VALMCNT=$S($D(^XTMP("GMRAFX",LTYPE,0)):$P(^(0),U,3),1:0),VALMWD=80
|
|---|
| 48 | Q
|
|---|
| 49 | LIST ; -- obtain and display list of free text allergies
|
|---|
| 50 | N GMRAIEN,GMRAOTH,GMRATXT,GMRAUTXT,SP1,SP2,SP3,UP,TXT
|
|---|
| 51 | S VALMBCK="R",VALMCNT=0
|
|---|
| 52 | K ^XTMP("GMRAFX",LTYPE) S ^XTMP("GMRAFX",LTYPE,"B")="",^XTMP("GMRAFX",LTYPE,"INUSE",+$G(DUZ))=""
|
|---|
| 53 | S GMRAOTH=$O(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0))_";GMRD(120.82," ;Gets IEN;FILE ENTRY for free text entries
|
|---|
| 54 | S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,GMRAIEN)) Q:'+GMRAIEN D
|
|---|
| 55 | .I LTYPE="FREE" I $P($G(^GMR(120.8,GMRAIEN,0)),U,3)'=GMRAOTH Q
|
|---|
| 56 | .I LTYPE="ING" I $P($G(^GMR(120.8,GMRAIEN,0)),U,3)'["50.416" Q
|
|---|
| 57 | .I LTYPE="DRUG" I $P($G(^GMR(120.8,GMRAIEN,0)),U,3)'["50.605" Q
|
|---|
| 58 | .Q:+$G(^GMR(120.8,GMRAIEN,"ER")) ;Quit if reactant entered in error
|
|---|
| 59 | .Q:$$DECEASED(+$P($G(^GMR(120.8,GMRAIEN,0)),U)) ;Don't report expired patients
|
|---|
| 60 | .Q:$$TESTPAT^VADPT($P($G(^GMR(120.8,GMRAIEN,0)),U)) ;Don't report test patients
|
|---|
| 61 | .S GMRATXT=$E($P($G(^GMR(120.8,GMRAIEN,0)),U,2),1,75) ;Get "reactant" text entry, no more than 75 characters
|
|---|
| 62 | .S GMRATXT=$TR(GMRATXT,"""","") ;19 remove quote marks from text
|
|---|
| 63 | .S GMRAUTXT=$$UP^XLFSTR(GMRATXT) ;Convert to upper case
|
|---|
| 64 | .S ^XTMP("GMRAFX",LTYPE,"GMRAR",GMRAUTXT,GMRATXT)=$G(^XTMP("GMRAFX",LTYPE,"GMRAR",GMRAUTXT,GMRATXT))+1 ;# of active entries
|
|---|
| 65 | .S ^XTMP("GMRAFX",LTYPE,"GMRAR",GMRAUTXT,GMRATXT,GMRAIEN)="" ;Store entry number
|
|---|
| 66 | .Q
|
|---|
| 67 | S UP="" F S UP=$O(^XTMP("GMRAFX",LTYPE,"GMRAR",UP)) Q:UP="" S TXT="" F S TXT=$O(^XTMP("GMRAFX",LTYPE,"GMRAR",UP,TXT)) Q:TXT="" D
|
|---|
| 68 | .S VALMCNT=VALMCNT+1
|
|---|
| 69 | .S SP1=4-$L(VALMCNT),SP2=40-$L(TXT),SP3=16-$L(^XTMP("GMRAFX",LTYPE,"GMRAR",UP,TXT))\2 ;Set up spacing before storing
|
|---|
| 70 | .D SET^VALM10(VALMCNT,VALMCNT_$$REPEAT^XLFSTR(" ",SP1)_TXT_$$REPEAT^XLFSTR(" ",SP2)_$$REPEAT^XLFSTR(" ",SP3)_^XTMP("GMRAFX",LTYPE,"GMRAR",UP,TXT))
|
|---|
| 71 | .S ^XTMP("GMRAFX",LTYPE,"IDX",VALMCNT)=UP_"^"_TXT
|
|---|
| 72 | K ^XTMP("GMRAFX",LTYPE,"B") ;Done building
|
|---|
| 73 | S ^XTMP("GMRAFX",LTYPE,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_$G(VALMCNT)
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | HELP ; -- help code
|
|---|
| 77 | D FULL^VALM1
|
|---|
| 78 | W !!,"Use AE to add local allergies to the GMR ALLERGY file. This",!,"should only be done if you're sure no existing reactant matches your needs."
|
|---|
| 79 | W !!,"Use EE to mark all entries within the selected group as entered",!,"in error. You may select multiple groups if you like."
|
|---|
| 80 | W !!,"Use DD to get a detailed display. It's highly recommended that you",!,"use the detailed display menu to make all changes."
|
|---|
| 81 | W !!,"Use UR to update the reactant. Extreme caution should be used when doing",!,"mass updates. It would be better to do the updates from within",!,"the detailed display menu.",!
|
|---|
| 82 | D WAIT^GMRAFX3 S VALMBCK="R"
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | EXIT ; -- exit code
|
|---|
| 86 | D FULL^VALM1
|
|---|
| 87 | D DESELECT ;Clear any remaining items
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | EXPND ; -- expand code
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | CHKSEL ;Evaluate selection if done by number
|
|---|
| 94 | N J,TMP,DIR,NUM,X,Y,TNMBR
|
|---|
| 95 | S VALMBCK="R"
|
|---|
| 96 | S NUM=$P($G(XQORNOD(0)),"=",2) ;get currently selected entries
|
|---|
| 97 | I NUM'="" D
|
|---|
| 98 | .I NUM=$G(NMBR) D DESELECT Q ;If user selects same entry without taking an entry, unhighlight and stop processing
|
|---|
| 99 | .D DESELECT:$G(NMBR) ;If user previously selected entries but took no action, unhighlight before highlighting new choices
|
|---|
| 100 | .S NMBR=$P(XQORNOD(0),"=",2),DIR(0)="L^"_"1:"_VALMCNT,X=NMBR,DIR("V")="" D ^DIR K DIR
|
|---|
| 101 | .I Y="" D FULL^VALM1 W !,"Invalid selection." D WAIT^GMRAFX3 K NMBR Q ;Selection out of range, stop processing
|
|---|
| 102 | .S TNMBR=""
|
|---|
| 103 | .F J=1:1:$L(NMBR,",")-1 S TMP=$P(NMBR,",",J) I $$LOCK^GMRAFX3(TMP) S TNMBR=TNMBR_TMP_"," D CNTRL^VALM10(TMP,1,+$G(VALMWD),IORVON,IORVOFF)
|
|---|
| 104 | .I TNMBR="" K NMBR Q
|
|---|
| 105 | .S NMBR=TNMBR
|
|---|
| 106 | Q
|
|---|
| 107 | ;
|
|---|
| 108 | DESELECT ;Un-highlight selected choices
|
|---|
| 109 | N J,TMP
|
|---|
| 110 | F J=1:1:$L($G(NMBR),",")-1 S TMP=$P(NMBR,",",J) D CNTRL^VALM10(TMP,1,+$G(VALMWD),IORVOFF,IORVOFF) L -^XTMP("GMRAFX","IDX",TMP)
|
|---|
| 111 | K NMBR
|
|---|
| 112 | Q
|
|---|
| 113 | ;
|
|---|
| 114 | AEA ; Entry for GMRA LOCAL ALLERGIES EDIT option
|
|---|
| 115 | S VALMBCK="R" D FULL^VALM1,PROCESS^GMRAFUT0,WAIT^GMRAFX3 Q ;23
|
|---|
| 116 | N DLAYGO,DIC,Y,GMRAIEN,DA,GMRALN,DIE,GMRACT,DR,GMRAX,GMRAY,X
|
|---|
| 117 | S VALMBCK="R" D FULL^VALM1
|
|---|
| 118 | W ! S DLAYGO=120.82,DIC="^GMRD(120.82,",DIC("A")="Select a LOCAL ALLERGY/ADVERSE REACTION: ",DIC(0)="AEQML",DIC("DR")="1" D ^DIC K DIC,DLAYGO Q:+Y'>0 S (DA,GMRAIEN)=+Y
|
|---|
| 119 | L +^GMRD(120.82,GMRAIEN):1 I '$T W !,"THIS ENTRY IS BEING EDITED BY SOMEONE ELSE" Q
|
|---|
| 120 | S GMRALN=$G(^GMRD(120.82,GMRAIEN,0))
|
|---|
| 121 | S DIE="^GMRD(120.82,",DR="",GMRACT=1
|
|---|
| 122 | I +$P(GMRALN,U,3) S DR(1,120.82,1)="@1;W !!,$C(7),""CANNOT EDIT NAME FIELD OF A NATIONAL ALLERGY."",!;3;"
|
|---|
| 123 | E D
|
|---|
| 124 | .S DR(1,120.82,1)=".01;3;"
|
|---|
| 125 | .S DR(1,120.82,2)="S (GMRAY,GMRAX)=$P(GMRALN,U,2) D EDTTYPE^GMRAUTL(.GMRAX);"
|
|---|
| 126 | .S DR(1,120.82,3)="S:GMRAX=GMRAY!(""^^""[GMRAX) X=GMRAX,Y=$S(""^^""[GMRAX:""@3"",1:""@4"");1///^S X=GMRAX;@4;4;5;@3;"
|
|---|
| 127 | .Q
|
|---|
| 128 | D ^DIE
|
|---|
| 129 | L -^GMRD(120.82,GMRAIEN)
|
|---|
| 130 | Q
|
|---|
| 131 | ;
|
|---|
| 132 | PROCESS(TYPE) ;API to mark all entries as entered in error or update entries to new reactant
|
|---|
| 133 | N GMRAPA,GMRAI,GMRAJ,DIR,Y,ROOT,NUM,ENTRY,GMRADONE,STOP,J,TNMBR,GMRAAR,GMRASURE
|
|---|
| 134 | S VALMBCK="R" D FULL^VALM1
|
|---|
| 135 | I '$G(NMBR) S NMBR=$$GETNUM^GMRAFX3("") Q:'+NMBR D Q:'+$G(NMBR)
|
|---|
| 136 | .S TNMBR=""
|
|---|
| 137 | .F J=1:1:$L(NMBR,",")-1 S TMP=$P(NMBR,",",J) I $$LOCK^GMRAFX3(TMP) S TNMBR=TNMBR_TMP_","
|
|---|
| 138 | .I TNMBR="" K NMBR Q
|
|---|
| 139 | .S NMBR=TNMBR
|
|---|
| 140 | I TYPE="U" W !!,"You should use the detailed display option to review entries in",!,"this group before doing a mass update. CHANGES CANNOT BE UN-DONE!" D WAIT^GMRAFX3
|
|---|
| 141 | W !!,"You are about to ",$S(TYPE="E":"mark",1:"update")," ALL allergies with the selected reactant ",!,$S(TYPE="E":"as entered in error.",1:"to a new reactant."),!
|
|---|
| 142 | S DIR(0)="Y",DIR("B")="NO",DIR("A")="ARE YOU SURE"
|
|---|
| 143 | S DIR("?")="If you're unsure, use the 'detailed display' option to get a list of individual patients."
|
|---|
| 144 | S DIR("?",1)="Answering YES to this prompt will cause all allergies associated with"
|
|---|
| 145 | S DIR("?",2)="the selected reactant to be "_$S(TYPE="E":"marked as entered in error.",1:"updated to the new reactant.")
|
|---|
| 146 | S DIR("?",3)=""
|
|---|
| 147 | S DIR("?",4)="Be SURE this is what you want to do."
|
|---|
| 148 | D ^DIR Q:Y'=1 ;Stop if user doesn't answer yes
|
|---|
| 149 | F GMRAI=1:1:($L(NMBR,",")-1) D
|
|---|
| 150 | .S NUM=$P(NMBR,",",GMRAI),ENTRY=^XTMP("GMRAFX",LTYPE,"IDX",NUM),STOP=0
|
|---|
| 151 | .S ROOT="^XTMP(""GMRAFX"",LTYPE,""GMRAR"","_""""_$P(ENTRY,"^")_""""_","_""""_$P(ENTRY,"^",2)_""""_")",GMRAJ=0 Q:'@ROOT
|
|---|
| 152 | .I TYPE="U" W !!,"Updating ",$P(ENTRY,U)," reactions"
|
|---|
| 153 | .F S GMRAJ=$O(@ROOT@(GMRAJ)) Q:GMRAJ=""!($G(STOP)) I GMRAJ D
|
|---|
| 154 | ..S GMRAPA=GMRAJ,GMRADONE=1 D @$S(TYPE="E":"EIE",1:"UIE^GMRAFX3")
|
|---|
| 155 | ..D:GMRADONE UPDATE^GMRAFX3
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
| 158 | EIE ;Mark individual entry as entered in error
|
|---|
| 159 | D EIE^GMRAFX3 ;Moved due to size limits
|
|---|
| 160 | Q
|
|---|
| 161 | ;
|
|---|
| 162 | DECEASED(GMRAIFN) ;Function returns 1 if patient is deceased, 0 if living
|
|---|
| 163 | N DFN,VADM
|
|---|
| 164 | Q:GMRAIFN=0 1 ;If no patient entry return true
|
|---|
| 165 | S DFN=GMRAIFN
|
|---|
| 166 | D DEM^VADPT
|
|---|
| 167 | Q $S(+VADM(6):1,1:0) ;VADM(6) holds date of death
|
|---|
| 168 | ;
|
|---|
| 169 | ADCOM(ENTRY,TYPE,COM) ;Add comment to allergy
|
|---|
| 170 | N DIC,DIE,DR,DA,Y,X
|
|---|
| 171 | S DA(1)=ENTRY
|
|---|
| 172 | S DIC="^GMR(120.8,"_DA(1)_",26,",DIC(0)="L" F S X=$$NOW^XLFDT Q:'$D(^GMR(120.8,DA(1),26,"B",X)) ;23 Don't allow duplicate entries
|
|---|
| 173 | D ^DIC Q:Y=-1 ;add new comment multiple
|
|---|
| 174 | S DA=+Y
|
|---|
| 175 | S DIE=DIC K DIC
|
|---|
| 176 | S DR="1////"_$G(DUZ,.5)_";1.5///"_TYPE_";2///"_$TR(COM,";"," ") ;remove semi-colon from free text
|
|---|
| 177 | D ^DIE ;Comment added by user
|
|---|
| 178 | Q
|
|---|
