GMRADGMV.m

GMRADGMV ;HIRMFO/RM-ALLERGY PT. MOVEMENT EVENTS ; 7/24/91

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

EN1 ; CALLED FROM GMRADGPM MARK CHART PROTOCOL

 Q:DGPMP'=""!($P(DGPMA,"^",2)'=1)!'$O(^GMR(120.8,"B",DFN,0))

 S ZTDTH=$H,ZTDESC="Fire Bulletin to Mark Patient Allergy DFN="_DFN,ZTRTN="EN2^GMRADGMV",ZTIO="",ZTSAVE("DFN")="",ZTSAVE("DGPMA")="" D ^%ZTLOAD K ZTSK

 Q

EN2 ; FIRE BULLETINS FOR ACTIVE PATIENT ALLERGIES

 S GMRANAM=$P($G(^DPT(DFN,0)),"^"),GMRALOC=$P($G(^(.1)),"^"),GMRAMOV=+$G(^(.102)),GMRAWLOC=$P($G(^DGPM(+GMRAMOV,0)),"^",6),GMRAHLOC=+$G(^DIC(42,+GMRAWLOC,44)) G:'GMRAHLOC Q2

 D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA

 S (GMRAPA,GMRAPA2)=0 F  S GMRAPA=$O(^GMR(120.8,"B",DFN,GMRAPA)) Q:GMRAPA'>0  D

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

 .I $P(GMRAPA(0),"^",12),'+$G(^GMR(120.8,GMRAPA,"ER")),'$O(^GMR(120.8,GMRAPA,13,"B",+DGPMA-.0001)) D

 ..S GMRAPA2=GMRAPA2+1,GMRAPA2(GMRAPA2)=$P(GMRAPA(0),U,2)

 ..S GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_U_$S($P(GMRAPA(0),U,14)="A":"Allergy",$P(GMRAPA(0),U,14)="P":"Adverse Reaction",$P(GMRAPA(0),U,14)="U":"Unknown",1:"")

 ..Q

 .Q

 ;This routine is to send one message with all of the patient's allergies

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

 I GMRAPA2,$P(GMRASITE(0),U,10) D BULLT^GMRASEN2

Q2 K DFN,DGPMA,GMRAHLOC,GMRALOC,GMRAMOV,GMRANAM,GMRAPA,GMRAPA2,GMRAWLOC,GMRASITE S ZTREQ="@"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRADGMV   1387     printed  Apr 09, 2024@20:45:26                                                                                                                                                                                                    Page 2

GMRADGMV  ;HIRMFO/RM-ALLERGY PT. MOVEMENT EVENTS ; 7/24/91

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

EN1       ; CALLED FROM GMRADGPM MARK CHART PROTOCOL

 +1        if DGPMP'=""!($PIECE(DGPMA,"^",2)'=1)!'$ORDER(^GMR(120.8,"B",DFN,0))

               QUIT 

 +2        SET ZTDTH=$HOROLOG

           SET ZTDESC="Fire Bulletin to Mark Patient Allergy DFN="_DFN

           SET ZTRTN="EN2^GMRADGMV"

           SET ZTIO=""

           SET ZTSAVE("DFN")=""

           SET ZTSAVE("DGPMA")=""

           DO ^%ZTLOAD

           KILL ZTSK

 +3        QUIT 

EN2       ; FIRE BULLETINS FOR ACTIVE PATIENT ALLERGIES

 +1        SET GMRANAM=$PIECE($GET(^DPT(DFN,0)),"^")

           SET GMRALOC=$PIECE($GET(^(.1)),"^")

           SET GMRAMOV=+$GET(^(.102))

           SET GMRAWLOC=$PIECE($GET(^DGPM(+GMRAMOV,0)),"^",6)

           SET GMRAHLOC=+$GET(^DIC(42,+GMRAWLOC,44))

           if 'GMRAHLOC

               GOTO Q2

 +2        DO PID^VADPT6

           SET GMRAVIP=VA("PID")

           DO KVAR^VADPT

           KILL VA

 +3        SET (GMRAPA,GMRAPA2)=0

           FOR 

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

               if GMRAPA'>0

                   QUIT 

               Begin DoDot:1

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

 +5                IF $PIECE(GMRAPA(0),"^",12)

                       IF '+$GET(^GMR(120.8,GMRAPA,"ER"))

                           IF '$ORDER(^GMR(120.8,GMRAPA,13,"B",+DGPMA-.0001))

                               Begin DoDot:2

 +6                                SET GMRAPA2=GMRAPA2+1

                                   SET GMRAPA2(GMRAPA2)=$PIECE(GMRAPA(0),U,2)

 +7                                SET GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_U_$SELECT($PIECE(GMRAPA(0),U,14)="A":"Allergy",$PIECE(GMRAPA(0),U,14)="P":"Adverse Reaction",$PIECE(GMRAPA(0),U,14)="U":"Unknown",1:"")

 +8                                QUIT 

                               End DoDot:2

 +9                QUIT 

               End DoDot:1

 +10      ;This routine is to send one message with all of the patient's allergies

 +11       DO SITE^GMRAUTL

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

 +12       IF GMRAPA2

               IF $PIECE(GMRASITE(0),U,10)

                   DO BULLT^GMRASEN2

Q2         KILL DFN,DGPMA,GMRAHLOC,GMRALOC,GMRAMOV,GMRANAM,GMRAPA,GMRAPA2,GMRAWLOC,GMRASITE

           SET ZTREQ="@"

 +1        QUIT