| 1 | GMRAPES0 ;HIRMFO/RM-SELECT PATIENT ALLERGY TO EDIT ;4/5/06 14:30
|
|---|
| 2 | ;;4.0;Adverse Reaction Tracking;**13,17,19,21,23,20**;Mar 29, 1996;Build 1
|
|---|
| 3 | EN1 ; GIVEN DFN, SELECT PATIENT ALLERGY
|
|---|
| 4 | N GMRAGOUT,ROOT,CNT,LST,NAM,DIR,GMRAET
|
|---|
| 5 | S GMRARET=0
|
|---|
| 6 | S GMRAPA=-1,GMRANEW=0 R !!,"Enter Causative Agent: ",GMRALAR:DTIME S:'$T GMRALAR="^^" S:GMRALAR="" GMRARET=1 I "^^"[GMRALAR S GMRAOUT='$L(GMRALAR)+1 G Q1
|
|---|
| 7 | I GMRALAR?1P.E!($L(GMRALAR)<3)!($L(GMRALAR)>30) S GMRAHLP=1 D EN1^GMRAHLP0 G EN1:'GMRAOUT,Q1
|
|---|
| 8 | I GMRALAR?.E1L.E S GMRALAR=$$UP^XLFSTR(GMRALAR)
|
|---|
| 9 | PAL K Y,DTOUT,DUOUT S DGSENFLG="",DIC="^GMR(120.8,",DIC(0)="SEZ",X=GMRANAM,DIC("S")="I '+$G(^(""ER"")),$P(^(0),U,2)?@(""1""""""_GMRALAR_"""""".E""),$D(^GMR(120.8,""B"",DFN,+Y))",DIC("W")="W $P(^(0),U,2)"
|
|---|
| 10 | W !!,"Checking existing PATIENT ALLERGIES (#120.8) file for matches...",!
|
|---|
| 11 | D ^DIC S X=$P($G(Y(0)),"^",2) K DIC,DGSENFLG,DTOUT,DUOUT D DIC I GMRAOUT S GMRAOUT=GMRAOUT-1 G:GMRAOUT Q1 G EN1
|
|---|
| 12 | S:+Y>0 GMRAPA=+Y G Q1:+Y>0!GMRAOUT,PAL:X?1"?".E,EN1:Y=0
|
|---|
| 13 | G Q1:'GMRALAGO
|
|---|
| 14 | NPA W !!,"Now checking GMR ALLERGIES (#120.82) file for matches...",!
|
|---|
| 15 | S DIC("S")="I $P(^(0),U)'=""OTHER ALLERGY/ADVERSE REACTION""&($S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.82,.01,Y_"",""),1:1))" ;21,23
|
|---|
| 16 | K Y,DTOUT,DUOUT S X=GMRALAR,DIC="^GMRD(120.82,",DIC(0)="EZM",DIC("W")="" D ^DIC K DIC S:+Y>0 X=$P(Y,"^",2) D DIC I GMRAOUT S GMRAOUT=GMRAOUT-1 G:GMRAOUT Q1 G EN1
|
|---|
| 17 | I +Y>0 S GMRAAR=+Y_";GMRD(120.82,",GMRAAR(0)=$P(Y,"^",2),GMRAAR("O")=$P(Y(0),"^",2) D:'GMRAOUT ADAR^GMRAPES1 G EN1:GMRAPA'>0,Q1
|
|---|
| 18 | G Q1:GMRAOUT,NPA:X?1"?".E,EN1:Y=0
|
|---|
| 19 | NDF ;find partial matches and select from NDF
|
|---|
| 20 | K Y,DTOUT,DUOUT
|
|---|
| 21 | W !!,"Now checking the National Drug File - Generic Names (#50.6)",!
|
|---|
| 22 | S DIC=50.6,X=GMRALAR,DIC(0)="EZM",DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.6,.01,Y_"",""),1:1)" D ^DIC K DIC D DIC ;23
|
|---|
| 23 | I +Y>0 S GMRAAR=+Y_";PSNDF(50.6,",GMRAAR(0)=$P(Y,U,2),GMRAAR("O")="D" D:'GMRAOUT ADAR^GMRAPES1 G EN1:GMRAPA'>0,Q1
|
|---|
| 24 | W !!,"Now checking the National Drug File - Trade Names (#50.67)",!
|
|---|
| 25 | K DUOUT,DTOUT,Y
|
|---|
| 26 | S ROOT=$$T^PSNAPIS,CNT=0,X=GMRALAR
|
|---|
| 27 | I $D(@ROOT@(X)),$S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.6,.01,$$TGTOG^PSNAPIS(X)_","),1:1) S CNT=CNT+1,LST(CNT)=$$TGTOG^PSNAPIS(X)_U_X ;23 Exact match stores IEN in 50.6 along with trade name
|
|---|
| 28 | S NAM=X F S NAM=$O(@ROOT@(NAM)) Q:NAM=""!($E(NAM,1,$L(X))'=X) D
|
|---|
| 29 | .Q:$S($L($T(SCREEN^XTID)):$$SCREEN^XTID(50.6,.01,$$TGTOG^PSNAPIS(NAM)_","),1:0) ;23
|
|---|
| 30 | .S CNT=CNT+1,LST(CNT)=$$TGTOG^PSNAPIS(NAM)_U_NAM
|
|---|
| 31 | I 'CNT S Y=-1 ;No matches found
|
|---|
| 32 | I CNT=1 S Y(0)=LST(1),X=$P(Y(0),U,2),Y=+LST(1) ;Only one choice
|
|---|
| 33 | I CNT>1 D
|
|---|
| 34 | .D MATCHES
|
|---|
| 35 | .S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
|
|---|
| 36 | .S DIR("?")="Select the number of desired causative agent"
|
|---|
| 37 | .D ^DIR S Y=$S(+Y:+Y,1:-1) S:Y>0 Y(0)=LST(Y),X=$P(Y(0),U,2)
|
|---|
| 38 | D DIC I GMRAOUT S GMRAOUT=GMRAOUT=1 G:GMRAOUT Q1 G EN1
|
|---|
| 39 | I +Y>0 S GMRAAR=+Y(0)_";PSNDF(50.6,",GMRAAR(0)=$P(Y(0),U,2),GMRAAR("O")="D" D:'GMRAOUT ADAR^GMRAPES1 G EN1:GMRAPA'>0,Q1
|
|---|
| 40 | ;Selection from file 50 removed in patch 23
|
|---|
| 41 | DRUG ;W !!,"Now checking the DRUG (#50) file for matches...",! K Y,DTOUT,DUOUT
|
|---|
| 42 | ;S CNT=0,X=GMRALAR K LST
|
|---|
| 43 | ;F ROOT="^PSDRUG(""B"")","^PSDRUG(""C"")" D
|
|---|
| 44 | ;.I $D(@ROOT@(X)) S CNT=CNT+1,LST(CNT)=$O(@ROOT@(X,0))_U_$S(ROOT["C":$$GET1^DIQ(50,$O(@ROOT@(X,0)),.01)_" <"_X_">",1:X)
|
|---|
| 45 | ;.S NAM=X F S NAM=$O(@ROOT@(NAM)) Q:NAM=""!($E(NAM,1,$L(X))'=X) D
|
|---|
| 46 | ;..S CNT=CNT+1,LST(CNT)=$O(@ROOT@(NAM,0))_U_$S(ROOT["C":$$GET1^DIQ(50,$O(@ROOT@(NAM,0)),.01)_" <"_NAM_">",1:NAM)
|
|---|
| 47 | ;I 'CNT S Y=-1 ;No matches found
|
|---|
| 48 | ;I CNT=1 S Y(0)=LST(1),X=$P(Y(0),U,2),Y=+LST(1) ;Only one choice
|
|---|
| 49 | ;I CNT>1 D
|
|---|
| 50 | ;.D MATCHES
|
|---|
| 51 | ;.S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
|
|---|
| 52 | ;.S DIR("?")="Select the number of desired causative agent"
|
|---|
| 53 | ;.D ^DIR S Y=$S(+Y:+Y,1:-1) S:Y>0 Y(0)=LST(Y),X=$P(Y(0),U,2)
|
|---|
| 54 | ;D DIC I GMRAOUT S GMRAOUT=GMRAOUT-1 G:GMRAOUT Q1 G EN1
|
|---|
| 55 | ;I +Y>0 S GMRAAR=+Y(0)_";PSDRUG(",GMRAAR(0)=$$GET1^DIQ(50,+Y(0),.01),GMRAAR("O")="D" D:'GMRAOUT ADAR^GMRAPES1 G EN1:GMRAPA'>0,Q1
|
|---|
| 56 | ;19 - Moved ING and CLASS code here
|
|---|
| 57 | ING W !!,"Now checking the INGREDIENTS (#50.416) file for matches...",!
|
|---|
| 58 | K Y,DTOUT,DUOUT S D="P",DIC="^PS(50.416,",DIC(0)="SEMZ",DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.416,.01,Y_"",""),1:1)",X=GMRALAR D IX^DIC K DIC D DIC I GMRAOUT S GMRAOUT=GMRAOUT-1 G:GMRAOUT Q1 G EN1
|
|---|
| 59 | I +Y>0 S GMRAAR=+Y_";PS(50.416,",GMRAAR(0)=$S(X?1A.E:X,1:$P(Y,"^",2)),GMRAAR("O")="D" D:'GMRAOUT ADAR^GMRAPES1 G EN1:GMRAPA'>0,Q1
|
|---|
| 60 | G Q1:GMRAOUT,ING:X?1"?".E,EN1:Y=0
|
|---|
| 61 | CLASS W !!,"Now checking VA DRUG CLASS (50.605) file for matches...",!
|
|---|
| 62 | K Y,DTOUT,DUOUT S X=GMRALAR,DIC="^PS(50.605,",DIC(0)="SEZ",D="C",DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.605,.01,Y_"",""),1:1)" D IX^DIC K DIC D DIC I GMRAOUT S GMRAOUT=GMRAOUT-1 G:GMRAOUT Q1 G EN1
|
|---|
| 63 | I +Y>0 S GMRAAR=+Y_";PS(50.605,",GMRAAR(0)=$S(X?1A.E:X,1:$P(Y,"^",2)),GMRAAR("O")="D" D:'GMRAOUT ADAR^GMRAPES1 G EN1:GMRAPA'>0,Q1
|
|---|
| 64 | G Q1:GMRAOUT,CLASS:X?1"?".E,EN1:Y=0
|
|---|
| 65 | YNOTH W !!,"Could not find ",GMRALAR," in any files."
|
|---|
| 66 | W !!,"Before sending an email requesting the addition of a new reactant, please",!,"try entering the first 3 or 4 letters of the reactant to search for",!,"the desired entry.",!
|
|---|
| 67 | W !,"Would you like to send an email requesting ",GMRALAR,!,"be added as a causative agent?"
|
|---|
| 68 | S DIR("A")="Send email"
|
|---|
| 69 | S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D MESS^GMRAPES0"
|
|---|
| 70 | D ^DIR
|
|---|
| 71 | I Y'=+Y S GMRAOUT=1 G Q1
|
|---|
| 72 | I '+Y G EN1
|
|---|
| 73 | YNDRG ;
|
|---|
| 74 | D GETINPUT(.GMRAET)
|
|---|
| 75 | S X=$$SENDREQ(DUZ,DFN,GMRALAR,.GMRAET)
|
|---|
| 76 | I '+X W !!,"Error - Message not sent - ",$P(X,U,2)
|
|---|
| 77 | I +X W !!,"Message sent - NOTE: This reactant was NOT added for this patient."
|
|---|
| 78 | W !
|
|---|
| 79 | Q1 ;
|
|---|
| 80 | S:GMRAPA>0 GMRAPA(0)=$S($D(^GMR(120.8,+GMRAPA,0)):^(0),1:"")
|
|---|
| 81 | K %,D,DA,DIC,DTOUT,DUOUT,GMRAAR,GMRAHLP,GMRAING,GMRALAGO,GMRALAR,PSNDA,PSODA,X,Y
|
|---|
| 82 | Q
|
|---|
| 83 | DIC ; VALIDATE LOOKUP FOR A/AR
|
|---|
| 84 | S:$D(DTOUT) X="^^" I X="^^" S GMRAOUT=1 Q
|
|---|
| 85 | S:$D(DUOUT) Y=0 Q:+Y'>0
|
|---|
| 86 | YNOK W !?3,X," OK" S %=1 D YN^DICN S:%=-1 GMRAOUT=1,Y=-1 Q:GMRAOUT S:%=2 Y=-1 Q:Y=-1 S:$$DUPCHK(X,DFN,Y) Y=-1 Q:GMRAOUT I % W ! Q ;19
|
|---|
| 87 | W !?5,$C(7),"ANSWER YES IF THIS IS THE CORRECT ALLERGY/ADVERSE REACTION,",!?5,"ELSE ANSWER NO."
|
|---|
| 88 | G YNOK
|
|---|
| 89 | DUPCHK(X,Y,Z) ;CHECK FOR ENTERED IN ERROR
|
|---|
| 90 | N GMRAPA,GMRAGOUT,%,%Y S GMRAGOUT=0
|
|---|
| 91 | I $P($G(^GMR(120.8,+Z,0)),U,2)=X Q GMRAGOUT
|
|---|
| 92 | I $O(^GMR(120.8,"B",Y,0)) S GMRAPA=0 F S GMRAPA=$O(^GMR(120.8,"B",Y,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT!(GMRAGOUT)
|
|---|
| 93 | .I $P(^GMR(120.8,GMRAPA,0),U,2)'=X Q
|
|---|
| 94 | .I $D(^GMR(120.8,GMRAPA,"ER")) D
|
|---|
| 95 | ..F S %=2 W !,?5,$C(7),"This Agent has been Entered in Error once before.",!,?5,"Are you sure you want to select this Agent again" D Q:%
|
|---|
| 96 | ...D YN^DICN S:%'=1 %=2,GMRAOUT=1 S:%Y?2"^" GMRAOUT=2
|
|---|
| 97 | ...Q:% W !,?10,"ENTER 'Y' FOR YES OR 'N' FOR NO"
|
|---|
| 98 | ...Q
|
|---|
| 99 | ..S GMRAGOUT=%
|
|---|
| 100 | ..Q
|
|---|
| 101 | .Q
|
|---|
| 102 | I GMRAGOUT=0 S GMRAGOUT=1
|
|---|
| 103 | Q (GMRAGOUT-1)
|
|---|
| 104 | MATCHES ; -- List matches for NDF
|
|---|
| 105 | N I,J,QUIT
|
|---|
| 106 | W !!,"Choose from the following "_+$G(CNT)_" matches:"
|
|---|
| 107 | S (I,J,QUIT)=0 F S I=$O(LST(I)) Q:I'>0 D Q:QUIT
|
|---|
| 108 | . S J=J+1 I '(J#(IOSL-5)) S:'$$MORE QUIT=1 Q:QUIT
|
|---|
| 109 | . W !,J," ",$P(LST(I),"^",2)
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | MORE() ; -- show more matches
|
|---|
| 113 | N DIR,DTOUT,DUOUT,X,Y
|
|---|
| 114 | S DIR(0)="EA",DIR("A")="Press <return> to see more, or ^ to stop ..."
|
|---|
| 115 | D ^DIR
|
|---|
| 116 | Q +Y
|
|---|
| 117 | ;
|
|---|
| 118 | SENDREQ(USER,PAT,TEXT,GMRAET) ;Send email to GMRA REQUEST NEW REACTANT indicating user's request for a new allergy
|
|---|
| 119 | ;Returns 0^reason for error
|
|---|
| 120 | ; 1 if successful
|
|---|
| 121 | N XMDUZ,XMY,XMSUB,GMRATXT,XMTEXT,XMZ,XMMG,GMRAUI,GMRAPI,GMRAUS,GMRAPS,CNT,J
|
|---|
| 122 | Q:'$G(USER)!('+$G(DUZ))!('$L(TEXT)) "0^Required information missing"
|
|---|
| 123 | S XMDUZ="Allergy Package",XMSUB="Request to add new reactant"
|
|---|
| 124 | S XMY("G.GMRA REQUEST NEW REACTANT")=""
|
|---|
| 125 | S XMY(DUZ)="" ;Include requestor in message
|
|---|
| 126 | D GETS^DIQ(200,USER,".01;.132;.138;8","E","GMRAUI"),GETS^DIQ(2,PAT,".01;.09","IE","GMRAPI") S GMRAUS=USER_",",GMRAPS=PAT_","
|
|---|
| 127 | S CNT=1
|
|---|
| 128 | S GMRATXT(CNT)="A request to add "_TEXT_" as a new reactant was entered",CNT=CNT+1
|
|---|
| 129 | S GMRATXT(CNT)="by "_GMRAUI(200,GMRAUS,.01,"E")_" for patient "_GMRAPI(2,GMRAPS,.01,"E")_" ("_$E(GMRAPI(2,GMRAPS,.09,"I"),6,9)_")",CNT=CNT+1
|
|---|
| 130 | S GMRATXT(CNT)="",CNT=CNT+1
|
|---|
| 131 | S GMRATXT(CNT)="User's contact information:",CNT=CNT+1
|
|---|
| 132 | S GMRATXT(CNT)="Title : "_GMRAUI(200,GMRAUS,8,"E"),CNT=CNT+1
|
|---|
| 133 | S GMRATXT(CNT)="Office Phone : "_GMRAUI(200,GMRAUS,.132,"E"),CNT=CNT+1
|
|---|
| 134 | S GMRATXT(CNT)="Digital Pager: "_GMRAUI(200,GMRAUS,.138,"E"),CNT=CNT+1
|
|---|
| 135 | S GMRATXT(CNT)="",CNT=CNT+1
|
|---|
| 136 | I $D(GMRAET) S GMRATXT(CNT)="The user added the following comment:",CNT=CNT+1,GMRATXT(CNT)="",CNT=CNT+1 F J=1:1:$P(GMRAET(0),U,3) S GMRATXT(CNT)=GMRAET(J,0),CNT=CNT+1 ;20 Added blank line following comment
|
|---|
| 137 | I $D(GMRAET) S GMRATXT(CNT)="",CNT=CNT+1
|
|---|
| 138 | S GMRATXT(CNT)="Please verify with the user the intended reactant and then take the",CNT=CNT+1
|
|---|
| 139 | S GMRATXT(CNT)="appropriate action. Be sure to try alternate spellings, etc before",CNT=CNT+1
|
|---|
| 140 | S GMRATXT(CNT)="requesting new reactants through NTRT (New Term Rapid Turnaround).",CNT=CNT+1 ;23
|
|---|
| 141 | S GMRATXT(CNT)="",CNT=CNT+1
|
|---|
| 142 | S GMRATXT(CNT)="Please note, an allergy to "_TEXT_" was NOT entered for this patient!",CNT=CNT+1 ;20
|
|---|
| 143 | S XMTEXT="GMRATXT("
|
|---|
| 144 | D ^XMD
|
|---|
| 145 | Q $S($D(XMMG):"0^Mail group GMRA REQUEST NEW REACTANT has no members - contact IRM",1:1)
|
|---|
| 146 | ;
|
|---|
| 147 | MESS ;Provide help for sending email message
|
|---|
| 148 | W !,"Enter YES to send an email to the allergy coordinator(s) indicating that",!,"Reactant--> ",GMRALAR,!,"was not found when you were trying to add it for this patient.",!,"Enter NO to try entering the reactant again."
|
|---|
| 149 | Q
|
|---|
| 150 | ;
|
|---|
| 151 | GETINPUT(GMRAET) ;Allow user to add comment to message
|
|---|
| 152 | N DIC,DWLW,DWPK,DIWEPSE
|
|---|
| 153 | S ^TMP($J,"TEXT",0)=""
|
|---|
| 154 | S DIC="^TMP($J,""TEXT"","
|
|---|
| 155 | S DWLW=70,DWPK=1,DIWEPSE=""
|
|---|
| 156 | W !!,"You may now add any comments you may have to the message that",!,"is going to be sent with the request to add this reactant."
|
|---|
| 157 | W !,"You may want to add things like sign/symptoms, observed or historical, etc",!,"that may be useful to the reviewer.",!
|
|---|
| 158 | D EN^DIWE
|
|---|
| 159 | I $O(^TMP($J,"TEXT",0)) M GMRAET=^TMP($J,"TEXT")
|
|---|
| 160 | K ^TMP($J,"TEXT")
|
|---|
| 161 | Q
|
|---|
