FHCLN.m

FHCLN ; HISC/REL - Clinical Dietetics ; 2/13/19 11:54am

 ;;5.5;DIETETICS;**8,49**;Jan 28, 2005;Build 2

 ; Reference IA# 10099 [Supported] GMRADPT call

 ;

 ;2/13/2019 FH*5.5*49 INC3431411 Missing IA, Revised API Call

 ;2/13/2019 FH*5.5*49 INC3519667 Allergy API call not returning

 ;                               all Food Allergies

 ;

ALG ; Get Allergies

 K ^TMP($J,"FHGMRAL") I $G(DFN)="" S ALG="" Q

 S ALG="",GMRA="0^0^111" D EN2^GMRADPT

 G:$O(GMRAL(0))<1 A1 F DA=0:0 S DA=$O(GMRAL(DA)) Q:DA<1  D A4 I FHOK D A3 S:ALG'="" ALG=ALG_", " S GMRA=$P(GMRAL(DA),"^",2) G:$L(ALG)+$L(GMRA)>250 A2 S ALG=ALG_GMRA

A1 K GMRA,GMRAL,FHGMNUM,FHGMIEN,FHREACT,FHOK Q

A2 S:$L(ALG)<246 ALG=ALG_"OTHERS" G A1

A3 S FHGMNUM=$P(GMRAL(DA),"^",9) I $P(FHGMNUM,";",2)'="GMRD(120.82," Q

 S FHGMIEN=$P(FHGMNUM,";",1),^TMP($J,"FHGMRAL",FHGMIEN)=""

A4 S FHREACT=$P(GMRAL(DA),"^",7)

 S FHOK=$S(FHREACT="DF":1,FHREACT="DFO":1,FHREACT="F":1,FHREACT="FO":1,1:0)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHCLN   948     printed  Apr 09, 2024@20:53:53                                                                                                                                                                                                        Page 2

FHCLN     ; HISC/REL - Clinical Dietetics ; 2/13/19 11:54am

 +1       ;;5.5;DIETETICS;**8,49**;Jan 28, 2005;Build 2

 +2       ; Reference IA# 10099 [Supported] GMRADPT call

 +3       ;

 +4       ;2/13/2019 FH*5.5*49 INC3431411 Missing IA, Revised API Call

 +5       ;2/13/2019 FH*5.5*49 INC3519667 Allergy API call not returning

 +6       ;                               all Food Allergies

 +7       ;

ALG       ; Get Allergies

 +1        KILL ^TMP($JOB,"FHGMRAL")

           IF $GET(DFN)=""

               SET ALG=""

               QUIT 

 +2        SET ALG=""

           SET GMRA="0^0^111"

           DO EN2^GMRADPT

 +3        if $ORDER(GMRAL(0))<1

               GOTO A1

           FOR DA=0:0

               SET DA=$ORDER(GMRAL(DA))

               if DA<1

                   QUIT 

               DO A4

               IF FHOK

                   DO A3

                   if ALG'=""

                       SET ALG=ALG_", "

                   SET GMRA=$PIECE(GMRAL(DA),"^",2)

                   if $LENGTH(ALG)+$LENGTH(GMRA)>250

                       GOTO A2

                   SET ALG=ALG_GMRA

A1         KILL GMRA,GMRAL,FHGMNUM,FHGMIEN,FHREACT,FHOK

           QUIT 

A2         if $LENGTH(ALG)<246

               SET ALG=ALG_"OTHERS"

           GOTO A1

A3         SET FHGMNUM=$PIECE(GMRAL(DA),"^",9)

           IF $PIECE(FHGMNUM,";",2)'="GMRD(120.82,"

               QUIT 

 +1        SET FHGMIEN=$PIECE(FHGMNUM,";",1)

           SET ^TMP($JOB,"FHGMRAL",FHGMIEN)=""

A4         SET FHREACT=$PIECE(GMRAL(DA),"^",7)

 +1        SET FHOK=$SELECT(FHREACT="DF":1,FHREACT="DFO":1,FHREACT="F":1,FHREACT="FO":1,1:0)