- 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 Feb 18, 2025@23:12:40 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
