Routine: GMRAXPST

GMRAXPST ;HIRMFO/WAA,RM-POST INIT FOR ALLERGY/ADVERSE REACTION ; 1/15/93

 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996

EN1 ; POST INIT PROCEDURES FOR GMRA PACKAGE

 I $G(GMRAVER,3)<4 D EN1^GMRAXNKA ; Move NKA data out of file 120.8

 D MAILGRP ; update mail groups.

 ; Add mail groups to bulletins??

 D FILESEC ; Check File security for all the files

 D TITLE ; Change the title in file 121.2

TITLE ; This code will update the title in the progress note package

 N GMRACW

 S GMRACW=0 F  S GMRACW=$O(^GMR(121.2,"B","ALLERGY/ADVERSE REACTION",GMRACW)) Q:GMRACW<1  I $P($G(^GMR(121.1,$P($G(^GMR(121.2,GMRACW,0)),U,2),0)),U)="GENERAL NOTE" Q

 Q:GMRACW<1

 N DIE,DA,DR

 S DIE="^GMR(121.2,",DA=GMRACW,DR=".01///ADVERSE REACTION/ALLERGY"

 D ^DIE

 N GMRATXT

 S GMRATXT(1)="The Progress Note Title of ALLERGY/ADVERSE REACTION with a note type of"

 S GMRATXT(2)="GENERAL NOTE has been changed to ADVERSE REACTION/ALLERGY."

 D MES^XPDUTL(.GMRATXT)

MAILGRP ; Procedure to update the mail groups for ART bulletins.

 N GMRAA,GMRAB,GMRAC,GMRAD,GMRAG,GMRACNT

 S GMRAB=0 ;Make groups public

 S GMRAC=0 ;Will make postmaster

 S GMRAD=1 ;No self enrollment

 S GMRAG=1 ;Silent call

 F GMRACNT=1:1:5 D

 .N GMRAA,GMRAX,GMRAF,GMRATXT

 .S GMRAA=$P($T(TEXT+GMRACNT),";",3) ; Mail group name

 .S GMRAF(0)=$P($T(DESC+GMRACNT),";",3) ;Mail group Description

 .S GMRAX=$$MG^XMBGRP(GMRAA,GMRAB,GMRAC,GMRAD,"",.GMRAF,GMRAG)

 .I GMRAX D  ;Mail group has been added

 ..S GMRATXT(1)="The "_GMRAA_" mail group has been added."

 ..D MES^XPDUTL(.GMRATXT)

..Q

 .E  D  ;Error happened and mail group was not added

 ..S GMRATXT(1)="The "_GMRAA_" Mail Group was not added to the system"

 ..S GMRATXT(2)="Please read the ART 4.0 Installation Guide for the"

 ..S GMRATXT(3)="instruction on how to create this  Mail Group."

 ..D BMES^XPDUTL(.GMRATXT)

..Q

.Q

FILESEC ; This routine is to check the file security and make the update if

 ; different

 N GMRACNT,GMRATX

 F GMRACNT=1:1:7 S GMRATX=$T(FLSEC+GMRACNT) Q:GMRATX=""  D SEC($P(GMRATX,";",3))

SEC(FILE) ;This Function will set the security for my file

 N FILENUM,PIECE,NODE,NODE2

 S NODE="^AUDIT^DD^DEL^LAYGO^RD^WR"

 S FILENUM=$P(FILE,U)

 F PIECE=2:1:7 I $P(FILE,U,PIECE)'="" S NODE2=$P(NODE,U,PIECE) S:$G(^DIC(FILENUM,0,NODE2))'=$P(FILE,U,PIECE) ^DIC(FILENUM,0,NODE2)=$P(FILE,U,PIECE)

 S GMRATXT(1)="Updating File security on file "_FILENUM_"."

 D BMES^XPDUTL(.GMRATXT)

FLSEC ; FILE#^AUDIT^DD^DEL^LAYGO^RD^WR

 ;;120.8^@^@^@^@^^@

 ;;120.82^@^@^@^^^

 ;;120.83^@^@^@^^^

 ;;120.84^@^@^@^@^@^@

 ;;120.85^@^@^@^@^^@

 ;;120.86^@^@^@^@^@^@

 ;;120.87^@^@^@^@^^@

TEXT ; This is the mail groups that are being added

 ;;GMRA MARK CHART

 ;;GMRA VERIFY DRUG ALLERGY

 ;;GMRA VERIFY FOOD ALLERGY

 ;;GMRA VERIFY OTHER ALLERGY

 ;;GMRA P&T COMMITTEE FDA

DESC ; This is the Description for the mail groups

 ;;This is a list of users who will need to mark a patient's chart that an adverse reaction/allergy was recorded.

 ;;This is a complete list of all the verifiers who will need to be sent Drug reaction information.

 ;;This is a complete list of all the verifiers who will need to be sent Food reaction information.

 ;;This is a complete list of all the verifiers who will need to be sent Other reaction information.

 ;;This mail group contains the members of the Pharmacy and Therapeutic (P&T) committee.  Whenever an agent is signed off the committee will get a message.

GMRAXPST  ;HIRMFO/WAA,RM-POST INIT FOR ALLERGY/ADVERSE REACTION ; 1/15/93

 +1       ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996

EN1       ; POST INIT PROCEDURES FOR GMRA PACKAGE

 +1       ; Move NKA data out of file 120.8

           IF $GET(GMRAVER,3)<4

               DO EN1^GMRAXNKA

 +2       ; update mail groups.

           DO MAILGRP

 +3       ; Add mail groups to bulletins??

 +4       ; Check File security for all the files

           DO FILESEC

 +5       ; Change the title in file 121.2

           DO TITLE

 +6        QUIT

TITLE     ; This code will update the title in the progress note package

 +1        NEW GMRACW

 +2        SET GMRACW=0

FOR

               SET GMRACW=$ORDER(^GMR(121.2,"B","ALLERGY/ADVERSE REACTION",GMRACW))

               IF GMRACW<1

                   QUIT

               IF $PIECE($GET(^GMR(121.1,$PIECE($GET(^GMR(121.2,GMRACW,0)),U,2),0)),U)="GENERAL NOTE"

                   QUIT

 +3        IF GMRACW<1

               QUIT

 +4        NEW DIE,DA,DR

 +5        SET DIE="^GMR(121.2,"

           SET DA=GMRACW

           SET DR=".01///ADVERSE REACTION/ALLERGY"

 +6        DO ^DIE

 +7        NEW GMRATXT

 +8        SET GMRATXT(1)="The Progress Note Title of ALLERGY/ADVERSE REACTION with a note type of"

 +9        SET GMRATXT(2)="GENERAL NOTE has been changed to ADVERSE REACTION/ALLERGY."

 +10       DO MES^XPDUTL(.GMRATXT)

 +11       QUIT

MAILGRP   ; Procedure to update the mail groups for ART bulletins.

 +1        NEW GMRAA,GMRAB,GMRAC,GMRAD,GMRAG,GMRACNT

 +2       ;Make groups public

           SET GMRAB=0

 +3       ;Will make postmaster

           SET GMRAC=0

 +4       ;No self enrollment

           SET GMRAD=1

 +5       ;Silent call

           SET GMRAG=1

 +6        FOR GMRACNT=1:1:5

               Begin DoDot:1

 +7                NEW GMRAA,GMRAX,GMRAF,GMRATXT

 +8       ; Mail group name

                   SET GMRAA=$PIECE($TEXT(TEXT+GMRACNT),";",3)

 +9       ;Mail group Description

                   SET GMRAF(0)=$PIECE($TEXT(DESC+GMRACNT),";",3)

 +10               SET GMRAX=$$MG^XMBGRP(GMRAA,GMRAB,GMRAC,GMRAD,"",.GMRAF,GMRAG)

 +11      ;Mail group has been added

                   IF GMRAX

                       Begin DoDot:2

 +12                       SET GMRATXT(1)="The "_GMRAA_" mail group has been added."

 +13                       DO MES^XPDUTL(.GMRATXT)

 +14                       QUIT

                       End DoDot:2

 +15      ;Error happened and mail group was not added

                  IF '$TEST

                       Begin DoDot:2

 +16                       SET GMRATXT(1)="The "_GMRAA_" Mail Group was not added to the system"

 +17                       SET GMRATXT(2)="Please read the ART 4.0 Installation Guide for the"

 +18                       SET GMRATXT(3)="instruction on how to create this  Mail Group."

 +19                       DO BMES^XPDUTL(.GMRATXT)

 +20                       QUIT

                       End DoDot:2

 +21               QUIT

               End DoDot:1

 +22       QUIT

FILESEC   ; This routine is to check the file security and make the update if

 +1       ; different

 +2        NEW GMRACNT,GMRATX

 +3        FOR GMRACNT=1:1:7

               SET GMRATX=$TEXT(FLSEC+GMRACNT)

               IF GMRATX=""

                   QUIT

               DO SEC($PIECE(GMRATX,";",3))

 +4        QUIT

SEC(FILE) ;This Function will set the security for my file

 +1        NEW FILENUM,PIECE,NODE,NODE2

 +2        SET NODE="^AUDIT^DD^DEL^LAYGO^RD^WR"

 +3        SET FILENUM=$PIECE(FILE,U)

 +4        FOR PIECE=2:1:7

               IF $PIECE(FILE,U,PIECE)'=""

                   SET NODE2=$PIECE(NODE,U,PIECE)

                   IF $GET(^DIC(FILENUM,0,NODE2))'=$PIECE(FILE,U,PIECE)

                       SET ^DIC(FILENUM,0,NODE2)=$PIECE(FILE,U,PIECE)

 +5        SET GMRATXT(1)="Updating File security on file "_FILENUM_"."

 +6        DO BMES^XPDUTL(.GMRATXT)

 +7        QUIT

FLSEC     ; FILE#^AUDIT^DD^DEL^LAYGO^RD^WR

 +1       ;;120.8^@^@^@^@^^@

 +2       ;;120.82^@^@^@^^^

 +3       ;;120.83^@^@^@^^^

 +4       ;;120.84^@^@^@^@^@^@

 +5       ;;120.85^@^@^@^@^^@

 +6       ;;120.86^@^@^@^@^@^@

 +7       ;;120.87^@^@^@^@^^@

TEXT      ; This is the mail groups that are being added

 +1       ;;GMRA MARK CHART

 +2       ;;GMRA VERIFY DRUG ALLERGY

 +3       ;;GMRA VERIFY FOOD ALLERGY

 +4       ;;GMRA VERIFY OTHER ALLERGY

 +5       ;;GMRA P&T COMMITTEE FDA

DESC      ; This is the Description for the mail groups

 +1       ;;This is a list of users who will need to mark a patient's chart that an adverse reaction/allergy was recorded.

 +2       ;;This is a complete list of all the verifiers who will need to be sent Drug reaction information.

 +3       ;;This is a complete list of all the verifiers who will need to be sent Food reaction information.

 +4       ;;This is a complete list of all the verifiers who will need to be sent Other reaction information.

 +5       ;;This mail group contains the members of the Pharmacy and Therapeutic (P&T) committee.  Whenever an agent is signed off the committee will get a message.

GMRAXPST.m