- 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 Jan 18, 2025@02:40:19 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 ;