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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFH55P5 5584 printed Dec 13, 2024@01:46:16 Page 2
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
