Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHUD112

FHUD112.m

Go to the documentation of this file.
  1. FHUD112 ;SLC/GDU - UPDATE FILE #112 TO CURRENT USDA NUTRITIONAL DATABASE
  1. ;;5.5;DIETETICS;**26**;Jan 28, 2005;Build 17
  1. ;
  1. ;USDA National Nutrient Database for Standard Reference, Release 23
  1. ;Data to update the FOOD NUTRIENTS FILE, #112
  1. ;Routine is not intended to be called by name alone.
  1. Q
  1. EN ;Entry point of this routine
  1. N ADDREC,FC,FHFNC,FHFNCN,FHIEN,FHERR,FHLST,FHMSG,FHPGM,FHREC,FLAG,FLDCNT,FLDNUM,FLDVAL
  1. N LC,LPSRT,LPEND,NEWNV,NVN,NVNL,OLDNV,RL,RL1,RL2,RL3,RL4,RL5,RLP,RTN,TAG,UDREC,X,X0,X1,X2,Y
  1. S FHMSG(1)="Nutrition and Food Service patch FH*5.5*26"
  1. S FHMSG(2)="Updating the FOOD NUTRIENTS file (#112) to USDA Standard Release 23"
  1. S FHMSG(3)=""
  1. S FHMSG(4)="Back up of file #112 to ^XTMP starting"
  1. S FHMSG(1,"F")="#",(FHMSG(2,"F"),FHMSG(3,"F"))="!",FHMSG(4,"F")="!!?5"
  1. D EN^DDIOL(.FHMSG) H 2 K FHMSG
  1. ;Backup of file #112 to ^XTMP starts here.
  1. D NOW^%DTC ;Getting the system's current date/time
  1. ;Creating the Extended temporary globals, setting life span to 180 days after run date
  1. S ^XTMP("FHNU23",0)=$$FMADD^XLFDT($P(%,"."),180)_U_$P(%,".")_U_"File #112 backup, Update to USDA Standard Release 23, FH*5.5*26"
  1. S ^XTMP("FHAR23",0)=$$FMADD^XLFDT($P(%,"."),180)_U_$P(%,".")_U_"Records added by update to USDA Standard Release 23, FH*5.5*26"
  1. S ^XTMP("FHUD23",0)=$$FMADD^XLFDT($P(%,"."),180)_U_$P(%,".")_U_"Records updated by update to USDA Standard Release 23, FH*5.5*26"
  1. S (^XTMP("FHAR23",1),^XTMP("FHUD23",1))=0
  1. K %
  1. M ^XTMP("FHNU23",112)=^FHNU ;file #112 is backed up.
  1. D EN^DDIOL("Back up of file #112 to ^XTMP is complete","","!?5") H 2
  1. ;The updating of file #112 starts here.
  1. D EN^DDIOL("Update of file #112 is running.","","!?5") H 2
  1. D EN^DDIOL(" ","","!")
  1. ;Processing the FHNDB* routines
  1. S LC=0,X0="000",(X1,X2)=""
  1. F X1=1:1:255 D
  1. . S RTN="FHNDB"_$E(X0,1,$L(X0)-$L(X1))_X1
  1. . D EN^DDIOL(".","","?1"),INC
  1. . I LC>80 D EN^DDIOL("","","!") S LC=1
  1. . ;Processing the current FHNDB routine
  1. . F TAG=1:1:30 D
  1. . . ;Pullinig the embedded data from the current FHNDB routine
  1. . . S RL0=TAG_U_RTN,RL0=$P($T(@RL0),";",3)
  1. . . I RL0="" Q
  1. . . S RL1=TAG_"+1"_U_RTN,RL1=$P($T(@RL1),";",3)
  1. . . S RL2=TAG_"+2"_U_RTN,RL2=$P($T(@RL2),";",3)
  1. . . S RL3=TAG_"+3"_U_RTN,RL3=$P($T(@RL3),";",3)
  1. . . S RL4=TAG_"+4"_U_RTN,RL4=$P($T(@RL4),";",3)
  1. . . ;Setting the work variables
  1. . . S FHFNC=$P(RL0,U,2)
  1. . . S FHFNCN=$P(RL0,U)
  1. . . S (ADDREC,FHIEN,UDREC)=0
  1. . . ;Finding the matching Food Nutrient in file #112
  1. . . K FHERR,FHFDA,FHMSG,FHREC,X
  1. . . S FHIEN=$O(^FHNU("C",FHFNC,FHIEN))
  1. . . I FHIEN="" D
  1. . . . S FHIEN="+1,",FLAG="",X=4,ADDREC=1
  1. . . . S ^XTMP("FHAR23",1)=^XTMP("FHAR23",1)+1
  1. . . . S ^XTMP("FHAR23",2,FHFNC)=FHFNCN_U_RTN_U_TAG
  1. . . E D
  1. . . . S FHIEN=FHIEN_",",FLAG="R",X=5,ADDREC=0
  1. . . . D GETS^DIQ(112,FHIEN,"*","I","FHREC","FHERR")
  1. . . I ADDREC D ZERONODE
  1. . . S RL=RL1,NVNL=$P($T(1),";",3),LPSRT=1,LPEND=20,FLDCNT=10 D WORKNODE
  1. . . S RL=RL2,NVNL=$P($T(2),";",3),LPSRT=1,LPEND=18,FLDCNT=30 D WORKNODE
  1. . . S RL=RL3,NVNL=$P($T(3),";",3),LPSRT=1,LPEND=18,FLDCNT=50 D WORKNODE
  1. . . S RL=RL4,NVNL=$P($T(4),";",3),LPSRT=1,LPEND=10,FLDCNT=70 D WORKNODE
  1. . . I ADDREC D
  1. . . . S FLDNUM=98,FLDVAL="USDA Std. Reference, Release 23" D BLDFDA
  1. . . . D UPDATE^DIE("","FHFDA","","FHERR")
  1. . . I UDREC D
  1. . . . D FILE^DIE("","FHFDA","FHERR")
  1. . . . S ^XTMP("FHUD23",1)=^XTMP("FHUD23",1)+1
  1. . . . S ^XTMP("FHUD23",2,FHFNC)=FHREC(112,FHIEN,.01,"I")
  1. D EN^DDIOL("Update of file #112 is complete.","","!?5")
  1. D RPTUPDT
  1. D RPTADD
  1. Q
  1. ZERONODE ;If adding a record create zero node FDA nodes
  1. S RL=RL0,NVNL=$P($T(0),";",3),LPSRT=1,LPEND=7
  1. F RLP=LPSRT:1:LPEND D
  1. . I $P(RL,U,RLP)="" Q
  1. . S FLDNUM=$P($P(NVNL,U,RLP),"|",2)
  1. . S FLDVAL=$P(RL,U,RLP)
  1. . D BLDFDA
  1. Q
  1. WORKNODE ;Process the data nodes for the current nutrient
  1. F RLP=LPSRT:1:LPEND D
  1. . I $P(RL,U,RLP)="" Q ;If no data in the current field, quit to next field
  1. . S FLDNUM=FLDCNT+RLP ;Compute field number
  1. . S FLDVAL=$P(RL,U,RLP) ;Pull field data value
  1. . ;If adding a new record add the field data value to FDA array and quit to next field
  1. . I ADDREC D BLDFDA Q
  1. . ;If no old value, quit to next field.
  1. . ;This is to filter out nutrients that maybe in the release but not used in file #112
  1. . I '$D(FHREC(112,FHIEN,FLDNUM,"I")) Q
  1. . ;If old value and new values match, quit to next field
  1. . I FHREC(112,FHIEN,FLDNUM,"I")=FLDVAL Q
  1. . D BLDFDA ;Add new field data value to FDA array
  1. . ;Update temporary global to report the update
  1. . S UDREC=1
  1. . S ^XTMP("FHUD23",2,FHFNC,FLDNUM)=$P(NVNL,U,RLP)_U_FHREC(112,FHIEN,FLDNUM,"I")_U_FLDVAL
  1. Q
  1. BLDFDA ;Building the FDA arrary
  1. D FDA^DILF(112,FHIEN,FLDNUM,FLAG,FLDVAL,"FHFDA","FHERR")
  1. Q
  1. RPTADD ;Report the added records
  1. N DIFROM,FHMSG,LC,LPEND,NVNL,RL0,RL1,RL2,RL3,RL4,RLP,RTN,TAG,X,X0,XMDUZ,XMSUB,XMY
  1. D EN^DDIOL(^XTMP("FHAR23",1)_" records were added to file #112 by patch FH*5.5*26","","!?5")
  1. D EN^DDIOL("Creating report of added records.","","!?5")
  1. S (X,X0)=""
  1. K ^TMP($J,"FHMSG")
  1. S ^TMP($J,"FHMSG",1,0)="Update of FOOD NUTRIENTS file (#112) to USDA Standard Release 23."
  1. S ^TMP($J,"FHMSG",2,0)="Records added by patch FH*5.5*26"
  1. S ^TMP($J,"FHMSG",3,0)=$$REPEAT^XLFSTR("-",79)
  1. S LC=4
  1. F S X0=$O(^XTMP("FHAR23",2,X0)) Q:X0="" D
  1. . K FHMSG
  1. . S (RL0,RL1,RL2,RL3,RL4)=""
  1. . S RTN=$P(^XTMP("FHAR23",2,X0),U,2)
  1. . S TAG=$P(^XTMP("FHAR23",2,X0),U,3)
  1. . S RL0=TAG_U_RTN,RL0=$P($T(@RL0),";",3)
  1. . I RL0="" Q
  1. . S RL1=TAG_"+1"_U_RTN,RL1=$P($T(@RL1),";",3)
  1. . S RL2=TAG_"+2"_U_RTN,RL2=$P($T(@RL2),";",3)
  1. . S RL3=TAG_"+3"_U_RTN,RL3=$P($T(@RL3),";",3)
  1. . S RL4=TAG_"+4"_U_RTN,RL4=$P($T(@RL4),";",3)
  1. . S NVNL=$P($T(0),";",3)
  1. . D INC
  1. . S ^TMP($J,"FHMSG",LC,0)=$P($P(NVNL,U),"|")_": "_$P(RL0,U)
  1. . F RLP=3:2:7 D
  1. . . S FHMSG=$P($P(NVNL,U,RLP-1),"|")_": "_$P(RL0,U,RLP-1)
  1. . . S X=$$REPEAT^XLFSTR(" ",40-$L(FHMSG))
  1. . . S FHMSG=FHMSG_X_$P($P(NVNL,U,RLP),"|")_": "_$P(RL0,U,RLP)
  1. . . D INC
  1. . . S ^TMP($J,"FHMSG",LC,0)=FHMSG,(FHMSG,X)=""
  1. . S NVNL=$P($T(1),";",3),RL=RL1,LPEND=20 D RPTADD0
  1. . S NVNL=$P($T(2),";",3),RL=RL2,LPEND=18 D RPTADD0
  1. . S NVNL=$P($T(3),";",3),RL=RL3,LPEND=18 D RPTADD0
  1. . S NVNL=$P($T(4),";",3),RL=RL4,LPEND=10 D RPTADD0
  1. . D INC
  1. . S ^TMP($J,"FHMSG",LC,0)=""
  1. D EN^DDIOL("Sending report by MailMan.","","!?5")
  1. S XMDUZ=.5
  1. S XMSUB="RECORDS ADDED BY PATCH FH*5.5*26"
  1. S XMY(DUZ)=""
  1. S XMTEXT="^TMP($J,""FHMSG"","
  1. D ^XMD
  1. I '$D(XXMG) D EN^DDIOL("Report successfully sent.","","!?5")
  1. K ^TMP($J,"FHMSG")
  1. Q
  1. RPTADD0 ;Print the nutrients of the added record
  1. F RLP=2:2:LPEND D
  1. . S FHMSG=$P(NVNL,U,RLP-1)_": "_$P(RL1,U,RLP-1)
  1. . S X=$$REPEAT^XLFSTR(" ",40-$L(FHMSG))
  1. . S FHMSG=FHMSG_X_$P(NVNL,U,RLP)_": "_$P(RL1,U,RLP)
  1. . D INC
  1. . S ^TMP($J,"FHMSG",LC,0)=FHMSG,(FHMSG,X)=""
  1. Q
  1. RPTUPDT ;Report the updated records
  1. N DIFROM,FHMSG,LC,X,X0,X1,XMDUZ,XMSUB,XMTEXT,XMY
  1. D EN^DDIOL(^XTMP("FHUD23",1)_" records in file #112 were updated by patch FH*5.5*26.","","!?5")
  1. D EN^DDIOL("Creating report of updated records.","","!?5")
  1. K ^TMP($J,"FHMSG")
  1. S ^TMP($J,"FHMSG",1,0)="Update of FOOD NUTRIENTS file (#112) to USDA Standard Release 23"
  1. S ^TMP($J,"FHMSG",2,0)="Records updated by patch FH*5.5*26"
  1. S ^TMP($J,"FHMSG",3,0)=$$REPEAT^XLFSTR("-",79)
  1. S LC=4,(X0,X1)=""
  1. F S X0=$O(^XTMP("FHUD23",2,X0)) Q:X0="" D
  1. . K FHMSG
  1. . D INC
  1. . S ^TMP($J,"FHMSG",LC,0)="FOOD: "_X0_" - "_^XTMP("FHUD23",2,X0)
  1. . S FHMSG="Nutrient"
  1. . S X=$$REPEAT^XLFSTR(" ",40-$L(FHMSG)),FHMSG=FHMSG_X_"Old value",X=""
  1. . S X=$$REPEAT^XLFSTR(" ",60-$L(FHMSG)),FHMSG=FHMSG_X_"New value",X=""
  1. . D INC S ^TMP($J,"FHMSG",LC,0)=FHMSG,FHMSG=""
  1. . D INC S ^TMP($J,"FHMSG",LC,0)=$$REPEAT^XLFSTR("-",79)
  1. . F S X1=$O(^XTMP("FHUD23",2,X0,X1)) Q:X1="" D
  1. . . S FHMSG=$P(^XTMP("FHUD23",2,X0,X1),U)
  1. . . S X=$$REPEAT^XLFSTR(" ",40-$L(FHMSG))
  1. . . S FHMSG=FHMSG_X_$P(^XTMP("FHUD23",2,X0,X1),U,2)
  1. . . S X=$$REPEAT^XLFSTR(" ",60-$L(FHMSG))
  1. . . S FHMSG=FHMSG_X_$P(^XTMP("FHUD23",2,X0,X1),U,3)
  1. . . D INC S ^TMP($J,"FHMSG",LC,0)=FHMSG,FHMSG=""
  1. . D INC S ^TMP($J,"FHMSG",LC,0)=""
  1. D EN^DDIOL("Sending report by MailMan.","","!?5")
  1. S XMDUZ=.5
  1. S XMSUB="RECORDS UPDATED BY PATCH FH*5.5*26"
  1. S XMY(DUZ)=""
  1. S XMTEXT="^TMP($J,""FHMSG"","
  1. D ^XMD
  1. I '$D(XMMG) D EN^DDIOL("Report successfully sent.","","!?5")
  1. K ^TMP($J,"FHMSG")
  1. Q
  1. INC ;Increment line counter variable LC
  1. S LC=LC+1 Q
  1. ;Field names for the user message display
  1. 0 ;;NAME|.01^CODE|1^COMMON UNITS|2^GRAMS/COMMON UNIT|3^% AS PURCHASED|5^EDITABLE?|6^TYPE|7
  1. 1 ;;PROTEIN^LIPIDS^CARBOHYDRATE^FOOD ENERGY^WATER^^^CALCIUM^IRON^MAGNESIUM^PHOSPHORUS^POTASSIUM^SODIUM^ZINC^COPPER^MANGANESE^ALPHA TOCOPHEROL^VITAMIN A^ASCORBIC ACID^THIAMIN
  1. 2 ;;RIBOFLAVIN^NIACIN^PANTOTHENIC ACID^VITAMIN B6^FOLATE^VITAMIN B12^LINOLEIC ACID^LINOLENIC ACID^CHOLESTEROL^SATURATED FAT^MONOUNSATURATED FAT^POLYUNSATURATED FAT^VITAMIN A^ASH^ALCOHOL^CAFFEINE^TOTAL DIETARY FIBER^TOTAL TOCOPHEROL
  1. 3 ;;TRYPTOPHAN^THREONINE^ISOLEUCINE^LEUCINE^LYSINE^METHIONINE^CYSTINE^PHENYLALANINE^TYROSINE^VALINE^ARGININE^HISTIDINE^ALANINE^ASPARTIC ACID^GLUTAMIC ACID^GLYCINE^PROLINE^SERINE^
  1. 4 ;;CAPRIC ACID^LAURIC ACID^MYRISTIC ACID^PALMITIC ACID^PALMITOLEIC ACID^STEARIC ACID^OLEIC ACID^ARACHIDONIC ACID^VITAMIN K^SELENIUM
  1. 5 ;;SOURCE OF DATA