Routine: GMRAMCB

GMRAMCB ;HIRMFO/WAA-MARK CHART & ID BAND FIELD EDIT ;01-May-2012 14:18;DU

 ;;4.0;Adverse Reaction Tracking;**21,36,1002,1006**;Mar 29, 1996;Build 29

EN3 ;Entry for EDIT CHART & ID BAND option

 K GMRALL S GMRAOUT=0 D GETAL^GMRAMCB1 I GMRAOUT!'$D(GMRALL) L:DFN>0 -^GMR(120.8,"B",DFN) G Q3

 D EN5 D:'GMRAOUT EN7

 L -^GMR(120.8,"B",DFN)

 G Q3

EN4(GMRALL,DFN) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT

 D EN5 D:'GMRAOUT EN7 Q

EN5 ;THIS IS THE ENTRY POINT TO BY PASS THE FORMAL LIST AGAIN

 D VAD^GMRAUTL1(DFN,"",.GMRALOC,.GMRANAM,"",.GMRASSN)

 N REQ S REQ=0,GMRAPA=0 F  S GMRAPA=$O(GMRALL(GMRAPA)) Q:'+GMRAPA!(REQ)  S:'$O(^GMR(120.8,GMRAPA,14,0)) REQ=1 ;36

 S GMRATYPE="B",I=0,GMRAPA=0 W !,"This session you have CHOSEN:" F  S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1  S I=I+1 W !,?5,$P($G(^GMR(120.8,GMRAPA,0)),U,2)

 W ! D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0)),GMRAOUT=0

 F GMRAMARK="13^Chart(s)","14^ID Band" S GMRAM2=$P(GMRAMARK,"^",2),GMRAM1=$P(GMRAMARK,"^") D  Q:GMRAOUT

 .I GMRAM1=14,($P(GMRASITE(0),U,5)=0!(GMRALOC=""))!('REQ) Q  ;36

 .S GMRANULL=0 F  S %=0 D  I %!(%Y="") Q

 ..I GMRAM1=13 S %=1,%Y="Y" Q  ;21 Marked on chart set to YES automatically

 ..W !,$S(GMRAM1=14:"Has",1:"Have")," the "_GMRAM2_" been marked or unmarked for",$S(I>1:" these CAUSATIVE AGENTS",1:" this CAUSATIVE AGENT") D YN^DICN

 ..Q:%Y=""

 ..S:%<0 %=2,GMRAOUT=1 Q:%  W !?4,"ANSWER YES IF THE "_GMRAM2_" HAS BEEN MARKED, ELSE ANSWER NO."

..Q

 .I %=2!(%Y="") Q

 .S GMRAPA=0 F  S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1  D

 ..I '$D(^GMR(120.8,GMRAPA,GMRAM1,0)) S ^(0)="^120.8"_GMRAM1_"DA^^"

 ..D NOW^%DTC K DO,DD,DINUM S X=%,DIC="^GMR(120.8,"_GMRAPA_","_GMRAM1_",",DIC(0)="L",DLAYGO=120.8,DA(1)=GMRAPA,DIC("DR")="1////"_DUZ D FILE^DICN K DIC,DLAYGO

..Q

.Q

EN6(GMRALL,DFN,GMRATYPE) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT

 N GMRAOUT,%,%Y S GMRAOUT=0

 D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))

EN7 I $D(%Y),%Y="" Q

 S GMRAPA=0 F  S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1  D

 .I $O(^GMR(120.8,GMRAPA,13,0))&($P(GMRASITE(0),U,5)=0!$O(^GMR(120.8,GMRAPA,14,0))!(GMRALOC="")) Q

 .S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) D BULLT^GMRASEND

.Q

Q3 ; CLEAN UP AFTER EN3

 K GMRACB1

 D KILL^XUSCLEAN

HELP ;THIS ROUTINE WILL LIST ALL THE SELECTED ALLERGIES AND ALL THE

 ;CURRENT SELECTED ALLERGIES

 S GMRAPA=0 I '$D(GMRALL) W !,"No CAUSATIVE AGENTS have been selected for this patient."

 E  W !,"You have selected the following CAUSATIVE AGENTS:",! S GMRAPA=0 F  S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1  W !,?5,$P($G(^GMR(120.8,GMRAPA,0)),U,2)

 K GMRAPA

 D HANGT^GMRAPEH0

HLP1 ;LIST ALL ALLERGIES

 W !,"You may choose CAUSATIVE AGENTS from the following list for this patient:"

 N DIC

 I '$D(^GMR(120.8,"B",DFN)) W !?4,"There are no reactions on file for this patient." Q

 D HLP12085^GMRAU851(DFN,"'+$G(^GMR(120.8,+GMRAX,""ER""))")

 D HANGT^GMRAPEH0

GMRAMCB   ;HIRMFO/WAA-MARK CHART & ID BAND FIELD EDIT ;01-May-2012 14:18;DU

 +1       ;;4.0;Adverse Reaction Tracking;**21,36,1002,1006**;Mar 29, 1996;Build 29

EN3       ;Entry for EDIT CHART & ID BAND option

 +1        KILL GMRALL

           SET GMRAOUT=0

           DO GETAL^GMRAMCB1

           IF GMRAOUT!'$DATA(GMRALL)

               IF DFN>0

                   LOCK -^GMR(120.8,"B",DFN)

               GOTO Q3

 +2        DO EN5

           IF 'GMRAOUT

               DO EN7

 +3        LOCK -^GMR(120.8,"B",DFN)

 +4        GOTO Q3

EN4(GMRALL,DFN) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT

 +1        DO EN5

           IF 'GMRAOUT

               DO EN7

           QUIT

EN5       ;THIS IS THE ENTRY POINT TO BY PASS THE FORMAL LIST AGAIN

 +1        DO VAD^GMRAUTL1(DFN,"",.GMRALOC,.GMRANAM,"",.GMRASSN)

 +2       ;36

           NEW REQ

           SET REQ=0

           SET GMRAPA=0

FOR

               SET GMRAPA=$ORDER(GMRALL(GMRAPA))

               IF '+GMRAPA!(REQ)

                   QUIT

               IF '$ORDER(^GMR(120.8,GMRAPA,14,0))

                   SET REQ=1

 +3        SET GMRATYPE="B"

           SET I=0

           SET GMRAPA=0

           WRITE !,"This session you have CHOSEN:"

FOR

               SET GMRAPA=$ORDER(GMRALL(GMRAPA))

               IF GMRAPA<1

                   QUIT

               SET I=I+1

               WRITE !,?5,$PIECE($GET(^GMR(120.8,GMRAPA,0)),U,2)

 +4        WRITE !

           DO SITE^GMRAUTL

           SET GMRASITE(0)=$GET(^GMRD(120.84,+GMRASITE,0))

           SET GMRAOUT=0

 +5        FOR GMRAMARK="13^Chart(s)","14^ID Band"

               SET GMRAM2=$PIECE(GMRAMARK,"^",2)

               SET GMRAM1=$PIECE(GMRAMARK,"^")

               Begin DoDot:1

 +6       ;36

                   IF GMRAM1=14

                       IF ($PIECE(GMRASITE(0),U,5)=0!(GMRALOC=""))!('REQ)

                           QUIT

 +7                SET GMRANULL=0

FOR

                       SET %=0

                       Begin DoDot:2

 +8       ;21 Marked on chart set to YES automatically

                           IF GMRAM1=13

                               SET %=1

                               SET %Y="Y"

                               QUIT

 +9                        WRITE !,$SELECT(GMRAM1=14:"Has",1:"Have")," the "_GMRAM2_" been marked or unmarked for",$SELECT(I>1:" these CAUSATIVE AGENTS",1:" this CAUSATIVE AGENT")

                           DO YN^DICN

 +10                       IF %Y=""

                               QUIT

 +11                       IF %<0

                               SET %=2

                               SET GMRAOUT=1

                           IF %

                               QUIT

                           WRITE !?4,"ANSWER YES IF THE "_GMRAM2_" HAS BEEN MARKED, ELSE ANSWER NO."

 +12                       QUIT

                       End DoDot:2

                       IF %!(%Y="")

                           QUIT

 +13               IF %=2!(%Y="")

                       QUIT

 +14               SET GMRAPA=0

FOR

                       SET GMRAPA=$ORDER(GMRALL(GMRAPA))

                       IF GMRAPA<1

                           QUIT

                       Begin DoDot:2

 +15                       IF '$DATA(^GMR(120.8,GMRAPA,GMRAM1,0))

                               SET ^(0)="^120.8"_GMRAM1_"DA^^"

 +16                       DO NOW^%DTC

                           KILL DO,DD,DINUM

                           SET X=%

                           SET DIC="^GMR(120.8,"_GMRAPA_","_GMRAM1_","

                           SET DIC(0)="L"

                           SET DLAYGO=120.8

                           SET DA(1)=GMRAPA

                           SET DIC("DR")="1////"_DUZ

                           DO FILE^DICN

                           KILL DIC,DLAYGO

 +17                       QUIT

                       End DoDot:2

 +18               QUIT

               End DoDot:1

               IF GMRAOUT

                   QUIT

 +19       QUIT

EN6(GMRALL,DFN,GMRATYPE) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT

 +1        NEW GMRAOUT,%,%Y

           SET GMRAOUT=0

 +2        DO SITE^GMRAUTL

           SET GMRASITE(0)=$GET(^GMRD(120.84,+GMRASITE,0))

EN7        IF $DATA(%Y)

               IF %Y=""

                   QUIT

 +1        SET GMRAPA=0

FOR

               SET GMRAPA=$ORDER(GMRALL(GMRAPA))

               IF GMRAPA<1

                   QUIT

               Begin DoDot:1

 +2                IF $ORDER(^GMR(120.8,GMRAPA,13,0))&($PIECE(GMRASITE(0),U,5)=0!$ORDER(^GMR(120.8,GMRAPA,14,0))!(GMRALOC=""))

                       QUIT

 +3                SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))

                   DO BULLT^GMRASEND

 +4                QUIT

               End DoDot:1

 +5        QUIT

Q3        ; CLEAN UP AFTER EN3

 +1        KILL GMRACB1

 +2        DO KILL^XUSCLEAN

 +3        QUIT

HELP      ;THIS ROUTINE WILL LIST ALL THE SELECTED ALLERGIES AND ALL THE

 +1       ;CURRENT SELECTED ALLERGIES

 +2        SET GMRAPA=0

           IF '$DATA(GMRALL)

               WRITE !,"No CAUSATIVE AGENTS have been selected for this patient."

 +3       IF '$TEST

               WRITE !,"You have selected the following CAUSATIVE AGENTS:",!

               SET GMRAPA=0

FOR

                   SET GMRAPA=$ORDER(GMRALL(GMRAPA))

                   IF GMRAPA<1

                       QUIT

                   WRITE !,?5,$PIECE($GET(^GMR(120.8,GMRAPA,0)),U,2)

 +4        KILL GMRAPA

 +5        DO HANGT^GMRAPEH0

HLP1      ;LIST ALL ALLERGIES

 +1        WRITE !,"You may choose CAUSATIVE AGENTS from the following list for this patient:"

 +2        NEW DIC

 +3        IF '$DATA(^GMR(120.8,"B",DFN))

               WRITE !?4,"There are no reactions on file for this patient."

               QUIT

 +4        DO HLP12085^GMRAU851(DFN,"'+$G(^GMR(120.8,+GMRAX,""ER""))")

 +5        DO HANGT^GMRAPEH0

 +6        QUIT

GMRAMCB.m