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 ---[H[J[2J[HGMRAUTL3 1327 printed Dec 13, 2024@01:40:41 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
