FH55P8 ;Hines OIFO/RTK - POST-INIT FOR PATCH FH*5.5*8 ;1/18/2007
;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
;
ITEM1 ;Convert existing CLINICIAN field entries into new multiple field
D BMES^XPDUTL("Expand CLINICIAN field of NUTRITION LOCATION (#119.6)")
D MES^XPDUTL(" file to a multiple and convert existing data...")
F FHLIEN=0:0 S FHLIEN=$O(^FH(119.6,FHLIEN)) Q:FHLIEN'>0 D
.S FHCFLG=0,FHLCLN=$P($G(^FH(119.6,FHLIEN,0)),U,2)
.I FHLCLN="" Q
.F FHCMIEN=0:0 S FHCMIEN=$O(^FH(119.6,FHLIEN,2,FHCMIEN)) Q:FHCMIEN'>0 D
..S FHCMLT=$P($G(^FH(119.6,FHLIEN,2,FHCMIEN,0)),U,1)
..I FHCMLT=FHLCLN S FHCFLG=1
.I FHCFLG=1 Q ;already in CLINICIAN(S) multiple, don't add
.S X=+FHLCLN K DIC,DO S DA(1)=FHLIEN,DIC="^FH(119.6,"_DA(1)_",2,"
.S DIC(0)="L" D FILE^DICN I Y=-1 Q
ITEM2 ;Set Allergy-type Food Preferences pointers to corresponding Allergy
D BMES^XPDUTL("Map ALLERGY - TYPE entries in Food Preferences (#115.2)")
D MES^XPDUTL(" file to corresponding GMR Allergies entries...")
D MAP^FHSELA1
ITEM3 ;Update Patient FP's based on any pre-existing Patient Food-type Allergies
D BMES^XPDUTL("Updating Patient Food Preferences based on pre-existing")
D MES^XPDUTL(" Allergy data...")
S FHPST8=1 D UPDATE^FHSELA1
ITEM4 ;
K ^FH(114,"D")
;Set new AB cross-reference on Recipe (#114) file, Embedded Recipe mult
F FHINIEN=0:0 S FHINIEN=$O(^FH(114,FHINIEN)) Q:FHINIEN'>0 D
.I $O(^FH(114,FHINIEN,"R",0)) S DIK="^FH(114,FHINIEN,""R"",",DIK(1)=".01^AB",DA(1)=FHINIEN D ENALL^DIK
K DA,X,Y,FHCFLG,FHLCLN,FHLIEN,FHCMIEN,FHCMLT,FHINIEN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFH55P8 1568 printed Aug 26, 2025@22:02:02 Page 2
FH55P8 ;Hines OIFO/RTK - POST-INIT FOR PATCH FH*5.5*8 ;1/18/2007
+1 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
+2 ;
ITEM1 ;Convert existing CLINICIAN field entries into new multiple field
+1 DO BMES^XPDUTL("Expand CLINICIAN field of NUTRITION LOCATION (#119.6)")
+2 DO MES^XPDUTL(" file to a multiple and convert existing data...")
+3 FOR FHLIEN=0:0
SET FHLIEN=$ORDER(^FH(119.6,FHLIEN))
if FHLIEN'>0
QUIT
Begin DoDot:1
+4 SET FHCFLG=0
SET FHLCLN=$PIECE($GET(^FH(119.6,FHLIEN,0)),U,2)
+5 IF FHLCLN=""
QUIT
+6 FOR FHCMIEN=0:0
SET FHCMIEN=$ORDER(^FH(119.6,FHLIEN,2,FHCMIEN))
if FHCMIEN'>0
QUIT
Begin DoDot:2
+7 SET FHCMLT=$PIECE($GET(^FH(119.6,FHLIEN,2,FHCMIEN,0)),U,1)
+8 IF FHCMLT=FHLCLN
SET FHCFLG=1
End DoDot:2
+9 ;already in CLINICIAN(S) multiple, don't add
IF FHCFLG=1
QUIT
+10 SET X=+FHLCLN
KILL DIC,DO
SET DA(1)=FHLIEN
SET DIC="^FH(119.6,"_DA(1)_",2,"
+11 SET DIC(0)="L"
DO FILE^DICN
IF Y=-1
QUIT
End DoDot:1
ITEM2 ;Set Allergy-type Food Preferences pointers to corresponding Allergy
+1 DO BMES^XPDUTL("Map ALLERGY - TYPE entries in Food Preferences (#115.2)")
+2 DO MES^XPDUTL(" file to corresponding GMR Allergies entries...")
+3 DO MAP^FHSELA1
ITEM3 ;Update Patient FP's based on any pre-existing Patient Food-type Allergies
+1 DO BMES^XPDUTL("Updating Patient Food Preferences based on pre-existing")
+2 DO MES^XPDUTL(" Allergy data...")
+3 SET FHPST8=1
DO UPDATE^FHSELA1
ITEM4 ;
+1 KILL ^FH(114,"D")
+2 ;Set new AB cross-reference on Recipe (#114) file, Embedded Recipe mult
+3 FOR FHINIEN=0:0
SET FHINIEN=$ORDER(^FH(114,FHINIEN))
if FHINIEN'>0
QUIT
Begin DoDot:1
+4 IF $ORDER(^FH(114,FHINIEN,"R",0))
SET DIK="^FH(114,FHINIEN,""R"","
SET DIK(1)=".01^AB"
SET DA(1)=FHINIEN
DO ENALL^DIK
End DoDot:1
+5 KILL DA,X,Y,FHCFLG,FHLCLN,FHLIEN,FHCMIEN,FHCMLT,FHINIEN
QUIT
