- 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 ---[H[J[2J[HFHCLN 948 printed Feb 18, 2025@23:13:38 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)