GMRANKA.m

GMRANKA ;HIRMFO/WAA - ALLERGY/ADVERSE REACTION PATIENT NKA DRIVE ;04/13/2017  13:21

 ;;4.0;Adverse Reaction Tracking;**2,21,36,48,54,60**;Mar 29, 1996;Build 13

NKA(DFN) ;See if patient has reaction on file

 ;  Input Variables:

 ;       DFN = Patient Internal Entry Number

 ;

 ;  Output Variables:

 ;       GMA = 1 Patient has known reaction

 ;             0 Patient has No known reaction

 ;             Null Patient has never been asked about reaction

 N GMRAIEN

 S GMA="",GMRAIEN=+$O(^GMR(120.86,"B",DFN,0))

 S:GMRAIEN>0 GMA=$P($G(^GMR(120.86,GMRAIEN,0)),U,2)

 Q GMA

 ;

NKAASK(DFN,GMRAOUT) ; Ask a Patient if patient has any known allergens

 ;  Input Variables

 ;     DFN = Patient Internal entry number

 ;  GMRAOUT = Up Caret or time out flag

 ;

 ;Ask if patient has allergies

 N DIR,Y,DIROUT,DTOUT,DIRUT,DUOUT,GMAOLD,GMRAIEN

 S GMRAIEN=+$O(^GMR(120.86,"B",DFN,0))

 S GMAOLD=$S(GMRAIEN>0:$P($G(^GMR(120.86,GMRAIEN,0)),U,2),1:"")

 S DIR(0)="120.86,1^AO^I Y=0&'$$NKASCR^GMRANKA(DFN) D INFO^GMRANKA K X"

 S DIR("A")="Does this patient have any known allergies or adverse reactions? "

 S DIR("B")=$S(GMAOLD=1:"Yes",GMAOLD=0:"No",1:"") K:DIR("B")="" DIR("B")

 S DIR("?")=$S(GMAOLD=0:"You may also enter @ to delete a previous NKA assessment and return the patient to a 'not assessed' state.  Use this if the NKA assessment was previously incorrectly entered.",1:"") ;21

 D ^DIR

 I $G(X)="@" D:GMAOLD=0 CLN W:GMAOLD=0 !,"Assessment deleted." Q  ;21 Allow removal of NKA

 I $D(DTOUT)!$D(DIROUT) S GMRAOUT=1 Q  ;36

 I $D(DUOUT) S GMRAOUT=2 Q  ;36

 ; P60 update GMRAIEN,GMAOLD as record may have been added durring read

 S GMRAIEN=+$O(^GMR(120.86,"B",DFN,0))

 S GMAOLD=$S(GMRAIEN>0:$P($G(^GMR(120.86,GMRAIEN,0)),U,2),1:"")

 ; User Hits return and doesn't answer question

 I Y="",GMAOLD="" Q  ;36

 I Y'="",GMAOLD'=Y D

 . N DIE,DA,DR,DO,DIC,X,DINUM

 . I 'GMRAIEN D

 . . S DIC="^GMR(120.86,",DIC(0)="",X=DFN,DIC("DR")="1////"_Y_";2////"_DUZ_";3///NOW"

 . . S DA=DFN,DINUM=DFN

 . . D FILE^DICN

 . I GMRAIEN>0 D

 . . S DIE="^GMR(120.86,",DA=GMRAIEN,DR=$S(GMAOLD=""&($P($G(^GMR(120.86,GMRAIEN,0)),"^")'=GMRAIEN):(".01////"_DFN_";"),1:"")_"1////"_Y_";2////"_DUZ_";3///NOW" ;36,54

 . . D ^DIE

 . Q

 Q

CLN ; Clean out entries that have not been answered.

 S DIK="^GMR(120.86,",DA=$S($G(GMRAIEN)>0:GMRAIEN,1:DFN) D ^DIK K DIK,DA

 Q

INFO ; Info string

 N GMASTR

 S GMASTR(1)="Currently this patient has Causative Agents on file."

 S GMASTR(2)="You will have to answer YES to this question and then"

 S GMASTR(3)="indicate that each of the Causative Agents are incorrect."

 S GMASTR(4)="Then you will be reasked this question and will be able"

 S GMASTR(5)="to enter NO."

 D WRITE^GMRADSP8(1,0,$C(7))

 D WRITE^GMRADSP8(1,10,.GMASTR)

 Q

NKASCR(DFN) ; Is Patient NKA (No Known Allergy)

 ;   Input Variable:

 ;        DFN = Patient DFN in Patient file

 ;

 ;  Output Variable:

 ;        GMA = 1 Patient is True NKA

 ;            = 0 Patient has a reaction in file 120.8

 ;

 ; This code will screen out Entered in Error entries

 S GMA=1

 N GMAX

 S GMAX=0

 F  S GMAX=$O(^GMR(120.8,"B",DFN,GMAX)) Q:GMAX<1  D  Q:'GMA

 .I +$G(^GMR(120.8,GMAX,"ER")) Q

 .S GMA=0

 .Q

 Q GMA

 ;

DELNKA ;Remove assessment of NKA for a selected patient

 N Y,DFN,DIR,DIC

 S DIC=120.86,DIC(0)="AEMQZ",DIC("A")="Select PATIENT NAME: " D ^DIC Q:Y=-1

 S DFN=+Y

 W !

 I $$NKA^GMRANKA(DFN)'=0 W !,"This patient doesn't currently have an assessment of NKA." Q

 S DIR(0)="Y",DIR("A")="Delete NKA assessment for patient "_$G(Y(0,0)),DIR("B")="NO"

 S DIR("?")="Enter Y to delete the NKA assessment and return the patient to a 'not assessed' status.  Enter N to cancel this action."

 D ^DIR

 I Y=1 D CLN^GMRANKA W "...Done"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRANKA   3756     printed  Feb 18, 2025@23:05:58                                                                                                                                                                                                     Page 2

GMRANKA   ;HIRMFO/WAA - ALLERGY/ADVERSE REACTION PATIENT NKA DRIVE ;04/13/2017  13:21

 +1       ;;4.0;Adverse Reaction Tracking;**2,21,36,48,54,60**;Mar 29, 1996;Build 13

NKA(DFN)  ;See if patient has reaction on file

 +1       ;  Input Variables:

 +2       ;       DFN = Patient Internal Entry Number

 +3       ;

 +4       ;  Output Variables:

 +5       ;       GMA = 1 Patient has known reaction

 +6       ;             0 Patient has No known reaction

 +7       ;             Null Patient has never been asked about reaction

 +8        NEW GMRAIEN

 +9        SET GMA=""

           SET GMRAIEN=+$ORDER(^GMR(120.86,"B",DFN,0))

 +10       if GMRAIEN>0

               SET GMA=$PIECE($GET(^GMR(120.86,GMRAIEN,0)),U,2)

 +11       QUIT GMA

 +12      ;

NKAASK(DFN,GMRAOUT) ; Ask a Patient if patient has any known allergens

 +1       ;  Input Variables

 +2       ;     DFN = Patient Internal entry number

 +3       ;  GMRAOUT = Up Caret or time out flag

 +4       ;

 +5       ;Ask if patient has allergies

 +6        NEW DIR,Y,DIROUT,DTOUT,DIRUT,DUOUT,GMAOLD,GMRAIEN

 +7        SET GMRAIEN=+$ORDER(^GMR(120.86,"B",DFN,0))

 +8        SET GMAOLD=$SELECT(GMRAIEN>0:$PIECE($GET(^GMR(120.86,GMRAIEN,0)),U,2),1:"")

 +9        SET DIR(0)="120.86,1^AO^I Y=0&'$$NKASCR^GMRANKA(DFN) D INFO^GMRANKA K X"

 +10       SET DIR("A")="Does this patient have any known allergies or adverse reactions? "

 +11       SET DIR("B")=$SELECT(GMAOLD=1:"Yes",GMAOLD=0:"No",1:"")

           if DIR("B")=""

               KILL DIR("B")

 +12      ;21

           SET DIR("?")=$SELECT(GMAOLD=0:"You may also enter @ to delete a previous NKA assessment and return the patient to a 'not assessed' state.  Use this if the NKA assessment was previously incorrectly entered.",1:"")

 +13       DO ^DIR

 +14      ;21 Allow removal of NKA

           IF $GET(X)="@"

               if GMAOLD=0

                   DO CLN

               if GMAOLD=0

                   WRITE !,"Assessment deleted."

               QUIT 

 +15      ;36

           IF $DATA(DTOUT)!$DATA(DIROUT)

               SET GMRAOUT=1

               QUIT 

 +16      ;36

           IF $DATA(DUOUT)

               SET GMRAOUT=2

               QUIT 

 +17      ; P60 update GMRAIEN,GMAOLD as record may have been added durring read

 +18       SET GMRAIEN=+$ORDER(^GMR(120.86,"B",DFN,0))

 +19       SET GMAOLD=$SELECT(GMRAIEN>0:$PIECE($GET(^GMR(120.86,GMRAIEN,0)),U,2),1:"")

 +20      ; User Hits return and doesn't answer question

 +21      ;36

           IF Y=""

               IF GMAOLD=""

                   QUIT 

 +22       IF Y'=""

               IF GMAOLD'=Y

                   Begin DoDot:1

 +23                   NEW DIE,DA,DR,DO,DIC,X,DINUM

 +24                   IF 'GMRAIEN

                           Begin DoDot:2

 +25                           SET DIC="^GMR(120.86,"

                               SET DIC(0)=""

                               SET X=DFN

                               SET DIC("DR")="1////"_Y_";2////"_DUZ_";3///NOW"

 +26                           SET DA=DFN

                               SET DINUM=DFN

 +27                           DO FILE^DICN

                           End DoDot:2

 +28                   IF GMRAIEN>0

                           Begin DoDot:2

 +29      ;36,54

                               SET DIE="^GMR(120.86,"

                               SET DA=GMRAIEN

                               SET DR=$SELECT(GMAOLD=""&($PIECE($GET(^GMR(120.86,GMRAIEN,0)),"^")'=GMRAIEN):(".01////"_DFN_";"),1:"")_"1////"_Y_";2////"_DUZ_";3///NOW"

 +30                           DO ^DIE

                           End DoDot:2

 +31                   QUIT 

                   End DoDot:1

 +32       QUIT 

CLN       ; Clean out entries that have not been answered.

 +1        SET DIK="^GMR(120.86,"

           SET DA=$SELECT($GET(GMRAIEN)>0:GMRAIEN,1:DFN)

           DO ^DIK

           KILL DIK,DA

 +2        QUIT 

INFO      ; Info string

 +1        NEW GMASTR

 +2        SET GMASTR(1)="Currently this patient has Causative Agents on file."

 +3        SET GMASTR(2)="You will have to answer YES to this question and then"

 +4        SET GMASTR(3)="indicate that each of the Causative Agents are incorrect."

 +5        SET GMASTR(4)="Then you will be reasked this question and will be able"

 +6        SET GMASTR(5)="to enter NO."

 +7        DO WRITE^GMRADSP8(1,0,$CHAR(7))

 +8        DO WRITE^GMRADSP8(1,10,.GMASTR)

 +9        QUIT 

NKASCR(DFN) ; Is Patient NKA (No Known Allergy)

 +1       ;   Input Variable:

 +2       ;        DFN = Patient DFN in Patient file

 +3       ;

 +4       ;  Output Variable:

 +5       ;        GMA = 1 Patient is True NKA

 +6       ;            = 0 Patient has a reaction in file 120.8

 +7       ;

 +8       ; This code will screen out Entered in Error entries

 +9        SET GMA=1

 +10       NEW GMAX

 +11       SET GMAX=0

 +12       FOR 

               SET GMAX=$ORDER(^GMR(120.8,"B",DFN,GMAX))

               if GMAX<1

                   QUIT 

               Begin DoDot:1

 +13               IF +$GET(^GMR(120.8,GMAX,"ER"))

                       QUIT 

 +14               SET GMA=0

 +15               QUIT 

               End DoDot:1

               if 'GMA

                   QUIT 

 +16       QUIT GMA

 +17      ;

DELNKA    ;Remove assessment of NKA for a selected patient

 +1        NEW Y,DFN,DIR,DIC

 +2        SET DIC=120.86

           SET DIC(0)="AEMQZ"

           SET DIC("A")="Select PATIENT NAME: "

           DO ^DIC

           if Y=-1

               QUIT 

 +3        SET DFN=+Y

 +4        WRITE !

 +5        IF $$NKA^GMRANKA(DFN)'=0

               WRITE !,"This patient doesn't currently have an assessment of NKA."

               QUIT 

 +6        SET DIR(0)="Y"

           SET DIR("A")="Delete NKA assessment for patient "_$GET(Y(0,0))

           SET DIR("B")="NO"

 +7        SET DIR("?")="Enter Y to delete the NKA assessment and return the patient to a 'not assessed' status.  Enter N to cancel this action."

 +8        DO ^DIR

 +9        IF Y=1

               DO CLN^GMRANKA

               WRITE "...Done"

 +10       QUIT