FH55P5.m

FH55P5 ;ALB/TDP - POST-INIT FOR PATCH FH*5.5*5 ;12/13/2005

 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53

 Q

POST ;

 D BMES^XPDUTL("Searching for DIETS (#111) file entries which are out of sync with the")

 D MES^XPDUTL("   corresponding entry in the ORDERABLE ITEM (#101.43) file...")

 D DIET

 D BMES^XPDUTL("Searching for TUBEFEEDING (#118.2) file entries which are out of sync with")

 D MES^XPDUTL("   the corresponding entry in the ORDERABLE ITEM (#101.43) file...")

 D TF

 D BMES^XPDUTL("Searching for DIET PATTERN (#111.1) names which are out of sync with")

 D MES^XPDUTL("   corresponding DIET ABBREVIATED LABELS...")

 D UPDPAT

 D BMES^XPDUTL("Post-init complete.")

 Q

 ;

DIET ;

 N DIFF,FH0,FHACT,FHFILE,FHFLNM,FHIEN,FHIEN1,FHINACT

 N FHNM,FHORIEN,FHSYN,FHTYP

 K ^TMP($J,"FH55P5_nutrition"),^TMP($J,"FH55P5_order")

 S FHTYP="D"

 S FHFILE="111",FHFLNM=$P($G(^FH(111,0)),"^",1)

 S FHNM=""

 F  S FHNM=$O(^FH(111,"B",FHNM)) Q:FHNM=""  D

 . S FHIEN=""

 . F  S FHIEN=$O(^FH(111,"B",FHNM,FHIEN)) Q:FHIEN=""  D

 .. S DIFF=0

 .. S FHINACT=$G(^FH(111,+FHIEN,"I")) I FHINACT="N" S FHINACT=""

 .. S FH0=$G(^FH(111,+FHIEN,0))

 .. S FHNM=$P(FH0,U,1) I FHNM="" Q

 .. S ^TMP($J,"FH55P5_nutrition",FHNM)=FHINACT

 .. F FHIEN1=0:0 S FHIEN1=$O(^FH(111,+FHIEN,"AN",FHIEN1)) Q:FHIEN1<1  D

 ... S FHSYN=$G(^FH(111,+FHIEN,"AN",FHIEN1,0))

 ... S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""

 .. S FHSYN=$P(FH0,U,2)

 .. I FHSYN'="" S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""

 .. D ORDER

 .. D COMPARE

 .. I DIFF D UPDATE

 .. K ^TMP($J,"FH55P5_nutrition"),^TMP($J,"FH55P5_order")

 Q

TF ;

 N DIFF,FH0,FHACT,FHFILE,FHFLNM,FHIEN,FHIEN1,FHINACT

 N FHNM,FHORIEN,FHSYN,FHTYP

 K ^TMP($J,"FH55P5_nutrition"),^TMP($J,"FH55P5_order")

 S FHTYP="T"

 S FHFILE="118.2",FHFLNM=$P($G(^FH(118.2,0)),"^",1)

 S FHNM=""

 F  S FHNM=$O(^FH(118.2,"B",FHNM)) Q:FHNM=""  D

 . S FHIEN=""

 . F  S FHIEN=$O(^FH(118.2,"B",FHNM,FHIEN)) Q:FHIEN=""  D

 .. S DIFF=0

 .. S FHINACT=$G(^FH(118.2,+FHIEN,"I")) I FHINACT="N" S FHINACT=""

 .. S FH0=$G(^FH(118.2,+FHIEN,0))

 .. S FHNM=$P(FH0,U,1) I FHNM="" Q

 .. S ^TMP($J,"FH55P5_nutrition",FHNM)=FHINACT

 .. F FHIEN1=0:0 S FHIEN1=$O(^FH(118.2,+FHIEN,1,FHIEN1)) Q:FHIEN1<1  D

 ... S FHSYN=$G(^FH(118.2,+FHIEN,1,FHIEN1,0))

 ... S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""

 .. ;S FHSYN=$P(FH0,U,2)

 .. ;I FHSYN'="" S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""

 .. D ORDER

 .. D COMPARE

 .. I DIFF D UPDATE

 .. K ^TMP($J,"FH55P5_nutrition"),^TMP($J,"FH55P5_order")

 Q

ORDER ;COMPILE ORD(101.43 DATA RELATED TO DIET ORDER/TF PRODUCT

 N FHORIN,FHORNM,FHORSYN

 S FHORIEN=$O(^ORD(101.43,"ID",+FHIEN_";99FH"_FHTYP,0))

 I +FHORIEN<1 Q

 S FHORIN=$G(^ORD(101.43,FHORIEN,.1))

 I FHORIN'="" S FHORIN="Y"

 S FHORNM=$P($G(^ORD(101.43,FHORIEN,0)),U,1) I FHORNM="" S FHORNM="UNKNOWN NAME (FH55P5)"

 S ^TMP($J,"FH55P5_order",FHORNM)=FHORIN

 S FHORSYN=""

 F  S FHORSYN=$O(^ORD(101.43,FHORIEN,2,"B",FHORSYN)) Q:FHORSYN=""  D

 . S:'$D(^TMP($J,"FH55P5_order",FHORNM,FHORSYN)) ^TMP($J,"FH55P5_order",FHORNM,FHORSYN)=""

 Q

COMPARE ;COMPARE ORD(101.43 ENTRY TO FH(111 OR FH(118.2 ENTRY

 N FHINACT,FHNM,FHORIN,FHORNM,FHORSYN,FHSYN

 I '$D(^TMP($J,"FH55P5_order")) Q

 S (FHACT,FHNM,FHORNM,FHORSYN,FHSYN)=""

 S FHNM=$O(^TMP($J,"FH55P5_nutrition",FHNM))

 S FHORNM=$O(^TMP($J,"FH55P5_order",FHORNM))

 I FHNM'=FHORNM S DIFF=1

 S FHINACT=$G(^TMP($J,"FH55P5_nutrition",FHNM))

 S FHORIN=$G(^TMP($J,"FH55P5_order",FHORNM))

 I FHINACT'=FHORIN S DIFF=1 D

 . I FHINACT="Y" S FHACT=$$FMTHL7^XLFDT($$NOW^XLFDT)

 . I FHINACT'="Y" S FHACT=""

 I FHINACT=FHORIN,FHINACT="Y" D

 . S FHACT=$O(^ORD(101.43,"ID",FHIEN_";99FH"_FHTYP,0))

 . S FHACT=$G(^ORD(101.43,FHACT,.1))

 . S FHACT=$$FMTHL7^XLFDT(FHACT)

CLOOP S FHSYN=$O(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN))

 S FHORSYN=$O(^TMP($J,"FH55P5_order",FHORNM,FHORSYN))

 I FHSYN'="",FHSYN=FHORSYN G CLOOP

 I FHSYN'=FHORSYN S DIFF=1

 Q

UPDATE ;FORMAT AND SEND UPDATE MESSAGE

 N CNT,FHNAM,MSG

 S CNT=1

 S MSG(CNT)="MSH|^~\&|DIETETICS|"_^DD("SITE",1)_"|||||MFN"

 ; code MFI

 S CNT=CNT+1

 S MSG(CNT)="MFI|"_FHFILE_"^"_FHFLNM_"^99DD||UPD|||NE"

 S FHNAM=""

 F  S FHNAM=$O(^TMP($J,"FH55P5_nutrition",FHNAM)) Q:FHNAM=""  D

 . S CNT=CNT+1

 . S MSG(CNT)="MFE|MUP||"_FHACT_"|^^^"_FHIEN_"^"_FHNAM_"^99FH"_FHTYP

 . S CNT=CNT+1

 . I FHTYP="D" S MSG(CNT)="ZFH|D|"_$P(FH0,U,4)_"||"_$P(FH0,U,3)

 . I FHTYP="T" S MSG(CNT)="ZFH|T|"

 . S FHSYN=""

 . F  S FHSYN=$O(^TMP($J,"FH55P5_nutrition",FHNAM,FHSYN)) Q:FHSYN=""  D

 .. S CNT=CNT+1,MSG(CNT)="ZSY|"_CNT_"|"_FHSYN

 I $D(MSG) D SEND

 Q

SEND ; Send Message to OE/RR

 D MSG^XQOR("FH ORDERABLE ITEM UPDATE",.MSG)

 D BMES^XPDUTL("   Updated ORDERABLE ITEM (#101.43) file entry #"_FHORIEN_" with data")

 D MES^XPDUTL("      for "_FHNM_" from the "_$S($G(FHTYP)="D":"DIETS (#111) file",1:"TUBEFEEDING (#118.2) file"))

 K MSG

 Q

UPDPAT ; Update Diet Pattern names

 S FLG=0 F FHDPIEN=0:0 S FHDPIEN=$O(^FH(111.1,FHDPIEN)) Q:FHDPIEN'>0  D

 .S FHFND=0,FHOLDNM=$P($G(^FH(111.1,FHDPIEN,0)),U,1),FHNEWNM=""

 .S FHDPDTS=$P($G(^FH(111.1,FHDPIEN,0)),U,2,6)

 .F FHPCE=1:1:5 D

 ..S FHDTPTR=$P(FHDPDTS,U,FHPCE) Q:FHDTPTR=""

 ..S FHNEWNM=FHNEWNM_$S(FHNEWNM="":"",1:", ")

 ..S FHNEWNM=FHNEWNM_$P($G(^FH(111,FHDTPTR,0)),U,7)

 .I FHOLDNM=FHNEWNM Q

 .S FLG=1 D BMES^XPDUTL("   Updated "_FHOLDNM_" to  "_FHNEWNM)

 .K DIE S DIE="^FH(111.1,",DA=FHDPIEN,DR=".01////^S X=FHNEWNM" D ^DIE

 Q

FH55P5    ;ALB/TDP - POST-INIT FOR PATCH FH*5.5*5 ;12/13/2005

 +1       ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53

 +2        QUIT 

POST      ;

 +1        DO BMES^XPDUTL("Searching for DIETS (#111) file entries which are out of sync with the")

 +2        DO MES^XPDUTL("   corresponding entry in the ORDERABLE ITEM (#101.43) file...")

 +3        DO DIET

 +4        DO BMES^XPDUTL("Searching for TUBEFEEDING (#118.2) file entries which are out of sync with")

 +5        DO MES^XPDUTL("   the corresponding entry in the ORDERABLE ITEM (#101.43) file...")

 +6        DO TF

 +7        DO BMES^XPDUTL("Searching for DIET PATTERN (#111.1) names which are out of sync with")

 +8        DO MES^XPDUTL("   corresponding DIET ABBREVIATED LABELS...")

 +9        DO UPDPAT

 +10       DO BMES^XPDUTL("Post-init complete.")

 +11       QUIT 

 +12      ;

DIET      ;

 +1        NEW DIFF,FH0,FHACT,FHFILE,FHFLNM,FHIEN,FHIEN1,FHINACT

 +2        NEW FHNM,FHORIEN,FHSYN,FHTYP

 +3        KILL ^TMP($JOB,"FH55P5_nutrition"),^TMP($JOB,"FH55P5_order")

 +4        SET FHTYP="D"

 +5        SET FHFILE="111"

           SET FHFLNM=$PIECE($GET(^FH(111,0)),"^",1)

 +6        SET FHNM=""

 +7        FOR 

               SET FHNM=$ORDER(^FH(111,"B",FHNM))

               IF FHNM=""

                   QUIT 

               Begin DoDot:1

 +8                SET FHIEN=""

 +9                FOR 

                       SET FHIEN=$ORDER(^FH(111,"B",FHNM,FHIEN))

                       IF FHIEN=""

                           QUIT 

                       Begin DoDot:2

 +10                       SET DIFF=0

 +11                       SET FHINACT=$GET(^FH(111,+FHIEN,"I"))

                           IF FHINACT="N"

                               SET FHINACT=""

 +12                       SET FH0=$GET(^FH(111,+FHIEN,0))

 +13                       SET FHNM=$PIECE(FH0,U,1)

                           IF FHNM=""

                               QUIT 

 +14                       SET ^TMP($JOB,"FH55P5_nutrition",FHNM)=FHINACT

 +15                       FOR FHIEN1=0:0

                               SET FHIEN1=$ORDER(^FH(111,+FHIEN,"AN",FHIEN1))

                               IF FHIEN1<1

                                   QUIT 

                               Begin DoDot:3

 +16                               SET FHSYN=$GET(^FH(111,+FHIEN,"AN",FHIEN1,0))

 +17                               IF '$DATA(^TMP($JOB,"FH55P5_nutrition",FHNM,FHSYN))

                                       SET ^TMP($JOB,"FH55P5_nutrition",FHNM,FHSYN)=""

                               End DoDot:3

 +18                       SET FHSYN=$PIECE(FH0,U,2)

 +19                       IF FHSYN'=""

                               IF '$DATA(^TMP($JOB,"FH55P5_nutrition",FHNM,FHSYN))

                                   SET ^TMP($JOB,"FH55P5_nutrition",FHNM,FHSYN)=""

 +20                       DO ORDER

 +21                       DO COMPARE

 +22                       IF DIFF

                               DO UPDATE

 +23                       KILL ^TMP($JOB,"FH55P5_nutrition"),^TMP($JOB,"FH55P5_order")

                       End DoDot:2

               End DoDot:1

 +24       QUIT 

TF        ;

 +1        NEW DIFF,FH0,FHACT,FHFILE,FHFLNM,FHIEN,FHIEN1,FHINACT

 +2        NEW FHNM,FHORIEN,FHSYN,FHTYP

 +3        KILL ^TMP($JOB,"FH55P5_nutrition"),^TMP($JOB,"FH55P5_order")

 +4        SET FHTYP="T"

 +5        SET FHFILE="118.2"

           SET FHFLNM=$PIECE($GET(^FH(118.2,0)),"^",1)

 +6        SET FHNM=""

 +7        FOR 

               SET FHNM=$ORDER(^FH(118.2,"B",FHNM))

               IF FHNM=""

                   QUIT 

               Begin DoDot:1

 +8                SET FHIEN=""

 +9                FOR 

                       SET FHIEN=$ORDER(^FH(118.2,"B",FHNM,FHIEN))

                       IF FHIEN=""

                           QUIT 

                       Begin DoDot:2

 +10                       SET DIFF=0

 +11                       SET FHINACT=$GET(^FH(118.2,+FHIEN,"I"))

                           IF FHINACT="N"

                               SET FHINACT=""

 +12                       SET FH0=$GET(^FH(118.2,+FHIEN,0))

 +13                       SET FHNM=$PIECE(FH0,U,1)

                           IF FHNM=""

                               QUIT 

 +14                       SET ^TMP($JOB,"FH55P5_nutrition",FHNM)=FHINACT

 +15                       FOR FHIEN1=0:0

                               SET FHIEN1=$ORDER(^FH(118.2,+FHIEN,1,FHIEN1))

                               IF FHIEN1<1

                                   QUIT 

                               Begin DoDot:3

 +16                               SET FHSYN=$GET(^FH(118.2,+FHIEN,1,FHIEN1,0))

 +17                               IF '$DATA(^TMP($JOB,"FH55P5_nutrition",FHNM,FHSYN))

                                       SET ^TMP($JOB,"FH55P5_nutrition",FHNM,FHSYN)=""

                               End DoDot:3

 +18      ;S FHSYN=$P(FH0,U,2)

 +19      ;I FHSYN'="" S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""

 +20                       DO ORDER

 +21                       DO COMPARE

 +22                       IF DIFF

                               DO UPDATE

 +23                       KILL ^TMP($JOB,"FH55P5_nutrition"),^TMP($JOB,"FH55P5_order")

                       End DoDot:2

               End DoDot:1

 +24       QUIT 

ORDER     ;COMPILE ORD(101.43 DATA RELATED TO DIET ORDER/TF PRODUCT

 +1        NEW FHORIN,FHORNM,FHORSYN

 +2        SET FHORIEN=$ORDER(^ORD(101.43,"ID",+FHIEN_";99FH"_FHTYP,0))

 +3        IF +FHORIEN<1

               QUIT 

 +4        SET FHORIN=$GET(^ORD(101.43,FHORIEN,.1))

 +5        IF FHORIN'=""

               SET FHORIN="Y"

 +6        SET FHORNM=$PIECE($GET(^ORD(101.43,FHORIEN,0)),U,1)

           IF FHORNM=""

               SET FHORNM="UNKNOWN NAME (FH55P5)"

 +7        SET ^TMP($JOB,"FH55P5_order",FHORNM)=FHORIN

 +8        SET FHORSYN=""

 +9        FOR 

               SET FHORSYN=$ORDER(^ORD(101.43,FHORIEN,2,"B",FHORSYN))

               IF FHORSYN=""

                   QUIT 

               Begin DoDot:1

 +10               IF '$DATA(^TMP($JOB,"FH55P5_order",FHORNM,FHORSYN))

                       SET ^TMP($JOB,"FH55P5_order",FHORNM,FHORSYN)=""

               End DoDot:1

 +11       QUIT 

COMPARE   ;COMPARE ORD(101.43 ENTRY TO FH(111 OR FH(118.2 ENTRY

 +1        NEW FHINACT,FHNM,FHORIN,FHORNM,FHORSYN,FHSYN

 +2        IF '$DATA(^TMP($JOB,"FH55P5_order"))

               QUIT 

 +3        SET (FHACT,FHNM,FHORNM,FHORSYN,FHSYN)=""

 +4        SET FHNM=$ORDER(^TMP($JOB,"FH55P5_nutrition",FHNM))

 +5        SET FHORNM=$ORDER(^TMP($JOB,"FH55P5_order",FHORNM))

 +6        IF FHNM'=FHORNM

               SET DIFF=1

 +7        SET FHINACT=$GET(^TMP($JOB,"FH55P5_nutrition",FHNM))

 +8        SET FHORIN=$GET(^TMP($JOB,"FH55P5_order",FHORNM))

 +9        IF FHINACT'=FHORIN

               SET DIFF=1

               Begin DoDot:1

 +10               IF FHINACT="Y"

                       SET FHACT=$$FMTHL7^XLFDT($$NOW^XLFDT)

 +11               IF FHINACT'="Y"

                       SET FHACT=""

               End DoDot:1

 +12       IF FHINACT=FHORIN

               IF FHINACT="Y"

                   Begin DoDot:1

 +13                   SET FHACT=$ORDER(^ORD(101.43,"ID",FHIEN_";99FH"_FHTYP,0))

 +14                   SET FHACT=$GET(^ORD(101.43,FHACT,.1))

 +15                   SET FHACT=$$FMTHL7^XLFDT(FHACT)

                   End DoDot:1

CLOOP      SET FHSYN=$ORDER(^TMP($JOB,"FH55P5_nutrition",FHNM,FHSYN))

 +1        SET FHORSYN=$ORDER(^TMP($JOB,"FH55P5_order",FHORNM,FHORSYN))

 +2        IF FHSYN'=""

               IF FHSYN=FHORSYN

                   GOTO CLOOP

 +3        IF FHSYN'=FHORSYN

               SET DIFF=1

 +4        QUIT 

UPDATE    ;FORMAT AND SEND UPDATE MESSAGE

 +1        NEW CNT,FHNAM,MSG

 +2        SET CNT=1

 +3        SET MSG(CNT)="MSH|^~\&|DIETETICS|"_^DD("SITE",1)_"|||||MFN"

 +4       ; code MFI

 +5        SET CNT=CNT+1

 +6        SET MSG(CNT)="MFI|"_FHFILE_"^"_FHFLNM_"^99DD||UPD|||NE"

 +7        SET FHNAM=""

 +8        FOR 

               SET FHNAM=$ORDER(^TMP($JOB,"FH55P5_nutrition",FHNAM))

               IF FHNAM=""

                   QUIT 

               Begin DoDot:1

 +9                SET CNT=CNT+1

 +10               SET MSG(CNT)="MFE|MUP||"_FHACT_"|^^^"_FHIEN_"^"_FHNAM_"^99FH"_FHTYP

 +11               SET CNT=CNT+1

 +12               IF FHTYP="D"

                       SET MSG(CNT)="ZFH|D|"_$PIECE(FH0,U,4)_"||"_$PIECE(FH0,U,3)

 +13               IF FHTYP="T"

                       SET MSG(CNT)="ZFH|T|"

 +14               SET FHSYN=""

 +15               FOR 

                       SET FHSYN=$ORDER(^TMP($JOB,"FH55P5_nutrition",FHNAM,FHSYN))

                       IF FHSYN=""

                           QUIT 

                       Begin DoDot:2

 +16                       SET CNT=CNT+1

                           SET MSG(CNT)="ZSY|"_CNT_"|"_FHSYN

                       End DoDot:2

               End DoDot:1

 +17       IF $DATA(MSG)

               DO SEND

 +18       QUIT 

SEND      ; Send Message to OE/RR

 +1        DO MSG^XQOR("FH ORDERABLE ITEM UPDATE",.MSG)

 +2        DO BMES^XPDUTL("   Updated ORDERABLE ITEM (#101.43) file entry #"_FHORIEN_" with data")

 +3        DO MES^XPDUTL("      for "_FHNM_" from the "_$SELECT($GET(FHTYP)="D":"DIETS (#111) file",1:"TUBEFEEDING (#118.2) file"))

 +4        KILL MSG

 +5        QUIT 

UPDPAT    ; Update Diet Pattern names

 +1        SET FLG=0

           FOR FHDPIEN=0:0

               SET FHDPIEN=$ORDER(^FH(111.1,FHDPIEN))

               IF FHDPIEN'>0

                   QUIT 

               Begin DoDot:1

 +2                SET FHFND=0

                   SET FHOLDNM=$PIECE($GET(^FH(111.1,FHDPIEN,0)),U,1)

                   SET FHNEWNM=""

 +3                SET FHDPDTS=$PIECE($GET(^FH(111.1,FHDPIEN,0)),U,2,6)

 +4                FOR FHPCE=1:1:5

                       Begin DoDot:2

 +5                        SET FHDTPTR=$PIECE(FHDPDTS,U,FHPCE)

                           IF FHDTPTR=""

                               QUIT 

 +6                        SET FHNEWNM=FHNEWNM_$SELECT(FHNEWNM="":"",1:", ")

 +7                        SET FHNEWNM=FHNEWNM_$PIECE($GET(^FH(111,FHDTPTR,0)),U,7)

                       End DoDot:2

 +8                IF FHOLDNM=FHNEWNM

                       QUIT 

 +9                SET FLG=1

                   DO BMES^XPDUTL("   Updated "_FHOLDNM_" to  "_FHNEWNM)

 +10               KILL DIE

                   SET DIE="^FH(111.1,"

                   SET DA=FHDPIEN

                   SET DR=".01////^S X=FHNEWNM"

                   DO ^DIE

               End DoDot:1

 +11       QUIT