GMRAUTL3.m

GMRAUTL3 ;SLC/DAN - New style index utilities continued ;1/7/08  09:36

 ;;4.0;Adverse Reaction Tracking;**41**;Mar 29, 1996;Build 8

 ;DBIA Section

 ;PSN50P41 - 4531

 ;PSN50P65 - 4543

 ;XLFDT    - 10103

 ;

ADDCOM ;Add comment to updated allergy indicating changes

 Q  ;Not currently in use

 N TYPE,ROOT,SUB2,DICR,DIEL,DL,DP,DM,DK,DIK,DC,DE,GLOB,DH,D,DQ,DR,DIC,DIE,DIA,DI,DG,DDH,DDER,DA,D0,D1

 K ^TMP($J,"GMRAINFO") ;41 Clear out storage space

 F GLOB="ING(""A"")","ING(""D"")","CLASS(""A"")","CLASS(""D"")" I $D(@GLOB) D

 .S TYPE=$S(GLOB="ING(""A"")":1,GLOB="ING(""D"")":2,GLOB="CLASS(""A"")":3,1:4) ;Determines if we're adding or deleting ingredients or classes

 .S COM="The following "_$S(TYPE=1!(TYPE=2):"ingredients",1:"drug classes")_" were "_$S(TYPE=2!(TYPE=4):"deleted",1:"added")_": "

 .S ROOT=$S(TYPE=1:"ING(""A"")",TYPE=2:"ING(""D"")",TYPE=3:"CLASS(""A"")",1:"CLASS(""D"")")

 .S SUB2=0 F  S SUB2=$O(@ROOT@(SUB2)) Q:'+SUB2  I @ROOT@(SUB2) S COM=COM D  ;41 Split code, added dot structure

 ..I TYPE=1!(TYPE=2) D ZERO^PSN50P41(SUB2,,$$DT^XLFDT,"GMRAINFO") ;41 ingredient call

 ..I TYPE=3!(TYPE=4) D C^PSN50P65(SUB2,,"GMRAINFO") ;41 drug class call

 ..S COM=COM_$G(^TMP($J,"GMRAINFO",SUB2,.01)) ;41 adds data

 .I $P(COM,": ",2)'="" L +^GMR(120.8,SUB) D ADCOM^GMRAFX(SUB,"O",COM) L -^GMR(120.8,SUB)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRAUTL3   1327     printed  Apr 09, 2024@20:44:21                                                                                                                                                                                                    Page 2

GMRAUTL3  ;SLC/DAN - New style index utilities continued ;1/7/08  09:36

 +1       ;;4.0;Adverse Reaction Tracking;**41**;Mar 29, 1996;Build 8

 +2       ;DBIA Section

 +3       ;PSN50P41 - 4531

 +4       ;PSN50P65 - 4543

 +5       ;XLFDT    - 10103

 +6       ;

ADDCOM    ;Add comment to updated allergy indicating changes

 +1       ;Not currently in use

           QUIT 

 +2        NEW TYPE,ROOT,SUB2,DICR,DIEL,DL,DP,DM,DK,DIK,DC,DE,GLOB,DH,D,DQ,DR,DIC,DIE,DIA,DI,DG,DDH,DDER,DA,D0,D1

 +3       ;41 Clear out storage space

           KILL ^TMP($JOB,"GMRAINFO")

 +4        FOR GLOB="ING(""A"")","ING(""D"")","CLASS(""A"")","CLASS(""D"")"

               IF $DATA(@GLOB)

                   Begin DoDot:1

 +5       ;Determines if we're adding or deleting ingredients or classes

                       SET TYPE=$SELECT(GLOB="ING(""A"")":1,GLOB="ING(""D"")":2,GLOB="CLASS(""A"")":3,1:4)

 +6                    SET COM="The following "_$SELECT(TYPE=1!(TYPE=2):"ingredients",1:"drug classes")_" were "_$SELECT(TYPE=2!(TYPE=4):"deleted",1:"added")_": "

 +7                    SET ROOT=$SELECT(TYPE=1:"ING(""A"")",TYPE=2:"ING(""D"")",TYPE=3:"CLASS(""A"")",1:"CLASS(""D"")")

 +8       ;41 Split code, added dot structure

                       SET SUB2=0

                       FOR 

                           SET SUB2=$ORDER(@ROOT@(SUB2))

                           if '+SUB2

                               QUIT 

                           IF @ROOT@(SUB2)

                               SET COM=COM

                               Begin DoDot:2

 +9       ;41 ingredient call

                                   IF TYPE=1!(TYPE=2)

                                       DO ZERO^PSN50P41(SUB2,,$$DT^XLFDT,"GMRAINFO")

 +10      ;41 drug class call

                                   IF TYPE=3!(TYPE=4)

                                       DO C^PSN50P65(SUB2,,"GMRAINFO")

 +11      ;41 adds data

                                   SET COM=COM_$GET(^TMP($JOB,"GMRAINFO",SUB2,.01))

                               End DoDot:2

 +12                   IF $PIECE(COM,": ",2)'=""

                           LOCK +^GMR(120.8,SUB)

                           DO ADCOM^GMRAFX(SUB,"O",COM)

                           LOCK -^GMR(120.8,SUB)

                   End DoDot:1

 +13       QUIT