GMRAFA1 ;ISP/RFR - CORRECT ASSESSMENTS DETAIL;04/11/2013 07:13
;;4.0;Adverse Reaction Tracking;**48**;Mar 29, 1996;Build 13
EN ; -- main entry point for GMRA ASSESS FIX DETAIL
Q
;
HDR ; -- header code
Q:'+$G(DFN)
N VADM,VAIN,ASSESS,IEN
D DEM^VADPT,INP^VADPT
S VALMHDR(1)=$$LJ^XLFSTR("Patient: "_VADM(1)_" ("_$P(VADM(2),"-",3)_")",$S(+$G(IOM)>0:IOM,1:80)-10," ")_$S($D(VAIN):" Inpatient",1:"Outpatient")
S IEN=+$O(^GMR(120.86,"B",DFN,0))
S:IEN>0 ASSESS=$P($G(^GMR(120.86,IEN,0)),U,2)
S VALMHDR(2)="Assessment: "_$S(IEN=0:"None on file",ASSESS=0:"No known reactions",ASSESS=1:"Has known reactions",1:"<ENTRY NOT FOUND>")
S VALMHDR(3)="Allergy Listing"
Q
;
INIT ; -- init variables and list array
Q:'+$G(DFN)
D CLEAN^VALM10
N IEN,TEXT
S VALMCNT=0
S IEN=0 F S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:'IEN D
.S VALMCNT=VALMCNT+1
.S TEXT="",TEXT=$$SETFLD^VALM1(VALMCNT_".",TEXT,"LINENO")
.S TEXT=$$SETFLD^VALM1($P($G(^GMR(120.8,IEN,0)),U,2),TEXT,"REACTANT")
.S TEXT=$$SETFLD^VALM1($$EIE(IEN),TEXT,"ERROR")
.D SET^VALM10(VALMCNT,TEXT,IEN)
S:VALMCNT=0 VALMSG="No reactions found"
Q
;
EIE(IEN) ; -- return 'Entered in Error' text
N RETURN
S RETURN=$$GET1^DIQ(120.8,IEN_",",22)
S RETURN=$S(RETURN'="":RETURN,1:"NO")
Q RETURN
;
HELP ; -- help code
D FULL^VALM1
W !!,"Use MA to reassess the patient for adverse reactions. The patient's current",!
W "assessment appears in the upper-left corner of the screen.",!
W !!,"Use RR to view a single reaction. After the reaction is displayed, the system",!
W "will ask if you want to mark the reaction as 'Entered in Error'.",!
W !!,"Use EE to mark all displayed reactions as 'Entered in Error'. Use extreme",!
W "caution when performing a mass update. It is better to first view the reaction",!
W "and then mark it as 'Entered in Error'.",!
D WAIT^GMRAFX3
S VALMBCK="R"
Q
;
EXIT ; -- exit code
D FULL^VALM1
Q
;
EXPND ; -- expand code
Q
;
RR ; -- review reaction
Q:$$NOLOCK
N DIC,DA,DIQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,GMRAPA,STATUS,GMRAITM
D SELECT(.GMRAITM,"reactions")
I 'GMRAITM S VALMSG="No reactions found" Q
Q:GMRAITM<0
S DA=+$O(@VALMAR@("IDX",GMRAITM,"")),DIC="^GMR(120.8,",DIQ(0)="CR"
W ! D EN^DIQ
S STATUS=$$EIE(DA)
I STATUS="NO" D
.S DIR(0)="YA"_U,DIR("A")="Would you like to mark this allergy as 'Entered in Error'? "
.S DIR("B")="NO"
.D ^DIR
.I +$G(Y)>0 D
..S GMRAPA=DA
..D MEIE
I STATUS'="NO" D WAIT^GMRAFX3
K VALMSG
Q
;
UASSESS ; -- update assessment
Q:$$NOLOCK
D FULL^VALM1
D NKAASK^GMRANKA(DFN)
K VALMHDR,VALMSG
D RE^VALM4
Q
;
ALLEE ; -- mark all allergies as entered in error
Q:$$NOLOCK
I VALMCNT=0 D Q
.W !,"There are no reactions to mark."
.S VALMSG="No reactions found"
.D WAIT^GMRAFX3
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="YA"_U,DIR("A",1)="You are about to mark all of this patient's allergies as 'Entered in Error'."
S DIR("A")="Do you want to continue? ",DIR("B")="NO"
D ^DIR
Q:$D(DIRUT)!($G(Y)<1)
N GMRAPA,GMRAITM
S GMRAITM=0 F S GMRAITM=$O(@VALMAR@("IDX",GMRAITM)) Q:'$G(GMRAITM) D
.S GMRAPA=+$O(@VALMAR@("IDX",GMRAITM,""))
.I '$P($G(^GMR(120.8,GMRAPA,"ER")),U) D
..S GMRAPA=+$O(@VALMAR@("IDX",GMRAITM,""))
..W !,"Marking "_$P($G(^GMR(120.8,GMRAPA,0)),U,2)_" as 'Entered in Error'...",!
..D MEIE
Q
MEIE ; -- mark allergy as entered in error
D EIE^GMRAFX3
D FLDTEXT^VALM10(GMRAITM,"ERROR",$$EIE(GMRAPA))
K VALMHDR,VALMSG
D WRITE^VALM10(GMRAITM)
Q
;
NOLOCK() ; -- determines if the user has a lock on the current patient
N RETURN
S RETURN=0
I '$D(^XTMP("GMRAFA",DFN,DUZ)) S RETURN=1
I $G(^XTMP("GMRAFA",DFN,DUZ))'=$J S RETURN=1
I RETURN D
.W !,"You no longer have a lock on this patient's records in this session.",!
.W !,"Please reselect the patient."
.S VALMBCK="Q"
.D WAIT^GMRAFX3
Q RETURN
SELECT(RETURN,ENTITIES) ; -- select an item from the list
S RETURN=-1
I VALMCNT=0 D Q
.W !,"There are no "_ENTITIES_" to select."
.D WAIT^GMRAFX3
.S RETURN=0
N DIR,X,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="N^1:"_VALMCNT_":0"
D ^DIR
Q:$D(DIRUT)!($D(DIROUT))
D FULL^VALM1
S RETURN=Y
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAFA1 4198 printed Dec 13, 2024@01:39:05 Page 2
GMRAFA1 ;ISP/RFR - CORRECT ASSESSMENTS DETAIL;04/11/2013 07:13
+1 ;;4.0;Adverse Reaction Tracking;**48**;Mar 29, 1996;Build 13
EN ; -- main entry point for GMRA ASSESS FIX DETAIL
+1 QUIT
+2 ;
HDR ; -- header code
+1 if '+$GET(DFN)
QUIT
+2 NEW VADM,VAIN,ASSESS,IEN
+3 DO DEM^VADPT
DO INP^VADPT
+4 SET VALMHDR(1)=$$LJ^XLFSTR("Patient: "_VADM(1)_" ("_$PIECE(VADM(2),"-",3)_")",$SELECT(+$GET(IOM)>0:IOM,1:80)-10," ")_$SELECT($DATA(VAIN):" Inpatient",1:"Outpatient")
+5 SET IEN=+$ORDER(^GMR(120.86,"B",DFN,0))
+6 if IEN>0
SET ASSESS=$PIECE($GET(^GMR(120.86,IEN,0)),U,2)
+7 SET VALMHDR(2)="Assessment: "_$SELECT(IEN=0:"None on file",ASSESS=0:"No known reactions",ASSESS=1:"Has known reactions",1:"<ENTRY NOT FOUND>")
+8 SET VALMHDR(3)="Allergy Listing"
+9 QUIT
+10 ;
INIT ; -- init variables and list array
+1 if '+$GET(DFN)
QUIT
+2 DO CLEAN^VALM10
+3 NEW IEN,TEXT
+4 SET VALMCNT=0
+5 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.8,"B",DFN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 SET VALMCNT=VALMCNT+1
+7 SET TEXT=""
SET TEXT=$$SETFLD^VALM1(VALMCNT_".",TEXT,"LINENO")
+8 SET TEXT=$$SETFLD^VALM1($PIECE($GET(^GMR(120.8,IEN,0)),U,2),TEXT,"REACTANT")
+9 SET TEXT=$$SETFLD^VALM1($$EIE(IEN),TEXT,"ERROR")
+10 DO SET^VALM10(VALMCNT,TEXT,IEN)
End DoDot:1
+11 if VALMCNT=0
SET VALMSG="No reactions found"
+12 QUIT
+13 ;
EIE(IEN) ; -- return 'Entered in Error' text
+1 NEW RETURN
+2 SET RETURN=$$GET1^DIQ(120.8,IEN_",",22)
+3 SET RETURN=$SELECT(RETURN'="":RETURN,1:"NO")
+4 QUIT RETURN
+5 ;
HELP ; -- help code
+1 DO FULL^VALM1
+2 WRITE !!,"Use MA to reassess the patient for adverse reactions. The patient's current",!
+3 WRITE "assessment appears in the upper-left corner of the screen.",!
+4 WRITE !!,"Use RR to view a single reaction. After the reaction is displayed, the system",!
+5 WRITE "will ask if you want to mark the reaction as 'Entered in Error'.",!
+6 WRITE !!,"Use EE to mark all displayed reactions as 'Entered in Error'. Use extreme",!
+7 WRITE "caution when performing a mass update. It is better to first view the reaction",!
+8 WRITE "and then mark it as 'Entered in Error'.",!
+9 DO WAIT^GMRAFX3
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
EXIT ; -- exit code
+1 DO FULL^VALM1
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
RR ; -- review reaction
+1 if $$NOLOCK
QUIT
+2 NEW DIC,DA,DIQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,GMRAPA,STATUS,GMRAITM
+3 DO SELECT(.GMRAITM,"reactions")
+4 IF 'GMRAITM
SET VALMSG="No reactions found"
QUIT
+5 if GMRAITM<0
QUIT
+6 SET DA=+$ORDER(@VALMAR@("IDX",GMRAITM,""))
SET DIC="^GMR(120.8,"
SET DIQ(0)="CR"
+7 WRITE !
DO EN^DIQ
+8 SET STATUS=$$EIE(DA)
+9 IF STATUS="NO"
Begin DoDot:1
+10 SET DIR(0)="YA"_U
SET DIR("A")="Would you like to mark this allergy as 'Entered in Error'? "
+11 SET DIR("B")="NO"
+12 DO ^DIR
+13 IF +$GET(Y)>0
Begin DoDot:2
+14 SET GMRAPA=DA
+15 DO MEIE
End DoDot:2
End DoDot:1
+16 IF STATUS'="NO"
DO WAIT^GMRAFX3
+17 KILL VALMSG
+18 QUIT
+19 ;
UASSESS ; -- update assessment
+1 if $$NOLOCK
QUIT
+2 DO FULL^VALM1
+3 DO NKAASK^GMRANKA(DFN)
+4 KILL VALMHDR,VALMSG
+5 DO RE^VALM4
+6 QUIT
+7 ;
ALLEE ; -- mark all allergies as entered in error
+1 if $$NOLOCK
QUIT
+2 IF VALMCNT=0
Begin DoDot:1
+3 WRITE !,"There are no reactions to mark."
+4 SET VALMSG="No reactions found"
+5 DO WAIT^GMRAFX3
End DoDot:1
QUIT
+6 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+7 SET DIR(0)="YA"_U
SET DIR("A",1)="You are about to mark all of this patient's allergies as 'Entered in Error'."
+8 SET DIR("A")="Do you want to continue? "
SET DIR("B")="NO"
+9 DO ^DIR
+10 if $DATA(DIRUT)!($GET(Y)<1)
QUIT
+11 NEW GMRAPA,GMRAITM
+12 SET GMRAITM=0
FOR
SET GMRAITM=$ORDER(@VALMAR@("IDX",GMRAITM))
if '$GET(GMRAITM)
QUIT
Begin DoDot:1
+13 SET GMRAPA=+$ORDER(@VALMAR@("IDX",GMRAITM,""))
+14 IF '$PIECE($GET(^GMR(120.8,GMRAPA,"ER")),U)
Begin DoDot:2
+15 SET GMRAPA=+$ORDER(@VALMAR@("IDX",GMRAITM,""))
+16 WRITE !,"Marking "_$PIECE($GET(^GMR(120.8,GMRAPA,0)),U,2)_" as 'Entered in Error'...",!
+17 DO MEIE
End DoDot:2
End DoDot:1
+18 QUIT
MEIE ; -- mark allergy as entered in error
+1 DO EIE^GMRAFX3
+2 DO FLDTEXT^VALM10(GMRAITM,"ERROR",$$EIE(GMRAPA))
+3 KILL VALMHDR,VALMSG
+4 DO WRITE^VALM10(GMRAITM)
+5 QUIT
+6 ;
NOLOCK() ; -- determines if the user has a lock on the current patient
+1 NEW RETURN
+2 SET RETURN=0
+3 IF '$DATA(^XTMP("GMRAFA",DFN,DUZ))
SET RETURN=1
+4 IF $GET(^XTMP("GMRAFA",DFN,DUZ))'=$JOB
SET RETURN=1
+5 IF RETURN
Begin DoDot:1
+6 WRITE !,"You no longer have a lock on this patient's records in this session.",!
+7 WRITE !,"Please reselect the patient."
+8 SET VALMBCK="Q"
+9 DO WAIT^GMRAFX3
End DoDot:1
+10 QUIT RETURN
SELECT(RETURN,ENTITIES) ; -- select an item from the list
+1 SET RETURN=-1
+2 IF VALMCNT=0
Begin DoDot:1
+3 WRITE !,"There are no "_ENTITIES_" to select."
+4 DO WAIT^GMRAFX3
+5 SET RETURN=0
End DoDot:1
QUIT
+6 NEW DIR,X,DTOUT,DUOUT,DIRUT,DIROUT
+7 SET DIR(0)="N^1:"_VALMCNT_":0"
+8 DO ^DIR
+9 if $DATA(DIRUT)!($DATA(DIROUT))
QUIT
+10 DO FULL^VALM1
+11 SET RETURN=Y
+12 QUIT
+13 ;
