FHWOR6 ; HISC/NCA - Update Orderable Items For Master File ;5/2/00 10:07
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
UPDATE ; Update Diet Orders and Tubefeedings
K MSG
I TYP="D" D CHKD
I TYP="T" D CHKT
K ACT,FILE,FILNM,K,NAM,N1,N2,PREC,STR,STR1,SYN,Z1
I $D(MSG) D SEND
Q
CHKD ; Check which Diet Order transactions
S FILE="111",FILNM=$P($G(^FH(111,0)),"^",1)
I $P(IEN,"^",3) S CHK=1,IEN=+IEN D PROCD S CHK=0 D CHKI Q
S IEN=+IEN
I $G(^FH(111,IEN,0))="" S CHK=2 D PROCD Q
I NOD1'=$P($G(^FH(111,IEN,0)),"^",1,4) S CHK=3 D PROCD S CHK=0
S STR="" F IEN1=0:0 S IEN1=$O(^FH(111,IEN,"AN",IEN1)) Q:IEN1<1 S:STR'="" STR=STR_"," S STR=STR_IEN1
S STR1="" F IEN1=0:0 S IEN1=$O(^TMP($J,"FHNOD3",IEN1)) Q:IEN1<1 S:STR1'="" STR1=STR1_"," S STR1=STR1_IEN1
I $L(STR,",")'=$L(STR1,",") S CHK=3 D PROCD S CHK=0 D CHKI Q
I STR'=STR1 S CHK=3 D PROCD S CHK=0 D CHKI Q
F K=1:1 Q:$P(STR1,",",K)="" S IEN1=$P(STR,",",K) D CHKD1
CHKI I NOD2'="Y",$G(^FH(111,IEN,"I"))="Y" S CHK=4 D PROCD Q
I NOD2="Y",$G(^FH(111,IEN,"I"))'="Y" S CHK=5 D PROCD Q
Q
CHKD1 I 'IEN1 S CHK=3 D PROCD S CHK=0 Q
I $G(^FH(111,IEN,"AN",IEN1,0))'=$G(^TMP($J,"FHNOD3",($P(STR1,",",K)))) S CHK=3 D PROCD S CHK=0
Q
PROCD ; Process Diet Order Msg.
Q:'CHK
I REC D CODE^FHWORI S REC=0,N1=2
S Z1=$S($G(^FH(111,IEN,0))'="":$G(^FH(111,IEN,0)),1:$P(NOD1,"^",1,4))
G ADD:CHK=1,DLD:CHK=2,UPD:CHK=3,DCD:CHK=4,ACD:CHK=5
Q
CHKT ; Check which Tubefeeding Transactions
S FILE="118.2",FILNM=$P($G(^FH(118.2,0)),"^",1)
I $P(IEN,"^",3) S CHK=1 S IEN=+IEN D PROCT S CHK=0 D CHKIN Q
S IEN=+IEN
I $G(^FH(118.2,IEN,0))="" S CHK=2 D PROCT Q
I NOD1'=$P($G(^FH(118.2,IEN,0)),"^",1) S CHK=3 D PROCT S CHK=0 D CHKIN Q
S STR="" F IEN1=0:0 S IEN1=$O(^FH(118.2,IEN,1,IEN1)) Q:IEN1<1 S:STR'="" STR=STR_"," S STR=STR_IEN1
S STR1="" F IEN1=0:0 S IEN1=$O(^TMP($J,"FHNOD2",IEN1)) Q:IEN1<1 S:STR1'="" STR1=STR1_"," S STR1=STR1_IEN1
I $L(STR,",")'=$L(STR1,",") S CHK=3 D PROCT S CHK=0 D CHKIN Q
I STR'=STR1 S CHK=3 D PROCT S CHK=0 D CHKIN Q
F K=1:1 Q:$P(STR1,",",K)="" S IEN1=$P(STR,",",K) D CHKT1
CHKIN ; Check if more than one transaction
I NOD3'="Y",$G(^FH(118.2,IEN,"I"))="Y" S CHK=4 D PROCT Q
I NOD3="Y",$G(^FH(118.2,IEN,"I"))'="Y" S CHK=5 D PROCT Q
Q
CHKT1 I 'IEN1 S CHK=3 D PROCT S CHK=0 Q
I $G(^FH(118.2,IEN,1,IEN1,0))'=$G(^TMP($J,"FHNOD2",($P(STR1,",",K)))) S CHK=3 D PROCT S CHK=0
Q
PROCT ; Process Tubefeeding Msg.
Q:'CHK
I REC D CODE^FHWORI S REC=0,N1=2
S Z1=$S($G(^FH(118.2,IEN,0))'="":$G(^FH(118.2,IEN,0)),1:NOD1)
G ADT:CHK=1,DLT:CHK=2,UPT:CHK=3,DCT:CHK=4,ACT:CHK=5
Q
ADD ; Code Add Diet Order
S ACT="MAD" G DO
DLD ; Code Delete Diet Order
S ACT="MDL" G DO
UPD ; Code Update Diet Order
S ACT="MUP" G DO
DCD ; Code Deactivate Diet Order
S ACT="MDC" G DO
ACD ; Code Reactivate Deactivated Diet Order
S ACT="MAC" G DO
ADT ; Code Add Tubefeeding
S ACT="MAD" G TF
DLT ; Code Delete Tubefeeding
S ACT="MDL" G TF
UPT ; Code Update Tubefeeding
S ACT="MUP" G TF
DCT ; Code Deactive Tubefeeding
S ACT="MDC" G TF
ACT ; Code Reactivate Deactivated Tubefeeding
S ACT="MAC" G TF
DO ; Code Diet Order MFE, ZFH, and ZSY
S NAM=$P(Z1,"^",1) Q:NAM="" S PREC=$P(Z1,"^",4) Q:'PREC
S SYN=$P(Z1,"^",2),N1=N1+1
S MSG(N1)="MFE|"_ACT_"|||^^^"_IEN_"^"_NAM_"^99FHD"
S N1=N1+1,MSG(N1)="ZFH|D|"_PREC_"||"_$P(Z1,"^",3)
I $G(^FH(111,IEN,0))="" S FHK=0 D Q
.F IEN1=0:0 S IEN1=$O(^TMP($J,"FHNOD3",IEN1)) Q:IEN1<1 S FHK=IEN1 D
..S SYN1=$G(^TMP($J,"FHNOD3",IEN1)) I SYN1'="" S N1=N1+1,MSG(N1)="ZSY|"_IEN1_"|"_SYN1 Q
.I SYN'="" S N1=N1+1,MSG(N1)="ZSY|"_(FHK+1)_"|"_SYN
.Q
S FHK=0 F IEN1=0:0 S IEN1=$O(^FH(111,IEN,"AN",IEN1)) Q:IEN1<1 S SYN1=$G(^(IEN1,0)) D
.S FHK=IEN1,SYN1=$P(SYN1,"^",1) I SYN1'="" S N1=N1+1,MSG(N1)="ZSY|"_IEN1_"|"_SYN1 Q
I SYN'="" S N1=N1+1,MSG(N1)="ZSY|"_(FHK+1)_"|"_SYN
Q
TF ; Code Tubefeeding MFE, ZFH, and ZSY
S NAM=$P(Z1,"^",1) Q:NAM="" S N1=N1+1
S MSG(N1)="MFE|"_ACT_"|||^^^"_IEN_"^"_NAM_"^99FHT"
S N1=N1+1,MSG(N1)="ZFH|T|"
I $G(^FH(118.2,IEN,0))="" D Q
.F IEN1=0:0 S IEN1=$O(^TMP($J,"FHNOD2",IEN1)) Q:IEN1<1 D
..S SYN=$G(^TMP($J,"FHNOD2",IEN1)) I SYN'="" D
..S N1=N1+1
..S MSG(N1)="ZSY|"_IEN1_"|"_SYN Q
.Q
F IEN1=0:0 S IEN1=$O(^FH(118.2,IEN,1,IEN1)) Q:IEN1<1 S SYN=$G(^(IEN1,0)) D
.S SYN=$P(SYN,"^",1) Q:SYN="" S N1=N1+1
.S MSG(N1)="ZSY|"_IEN1_"|"_SYN Q
Q
SEND ; Send Message to OE/RR
D MSG^XQOR("FH ORDERABLE ITEM UPDATE",.MSG)
K MSG Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR6 4452 printed Dec 13, 2024@01:55:29 Page 2
FHWOR6 ; HISC/NCA - Update Orderable Items For Master File ;5/2/00 10:07
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
UPDATE ; Update Diet Orders and Tubefeedings
+1 KILL MSG
+2 IF TYP="D"
DO CHKD
+3 IF TYP="T"
DO CHKT
+4 KILL ACT,FILE,FILNM,K,NAM,N1,N2,PREC,STR,STR1,SYN,Z1
+5 IF $DATA(MSG)
DO SEND
+6 QUIT
CHKD ; Check which Diet Order transactions
+1 SET FILE="111"
SET FILNM=$PIECE($GET(^FH(111,0)),"^",1)
+2 IF $PIECE(IEN,"^",3)
SET CHK=1
SET IEN=+IEN
DO PROCD
SET CHK=0
DO CHKI
QUIT
+3 SET IEN=+IEN
+4 IF $GET(^FH(111,IEN,0))=""
SET CHK=2
DO PROCD
QUIT
+5 IF NOD1'=$PIECE($GET(^FH(111,IEN,0)),"^",1,4)
SET CHK=3
DO PROCD
SET CHK=0
+6 SET STR=""
FOR IEN1=0:0
SET IEN1=$ORDER(^FH(111,IEN,"AN",IEN1))
if IEN1<1
QUIT
if STR'=""
SET STR=STR_","
SET STR=STR_IEN1
+7 SET STR1=""
FOR IEN1=0:0
SET IEN1=$ORDER(^TMP($JOB,"FHNOD3",IEN1))
if IEN1<1
QUIT
if STR1'=""
SET STR1=STR1_","
SET STR1=STR1_IEN1
+8 IF $LENGTH(STR,",")'=$LENGTH(STR1,",")
SET CHK=3
DO PROCD
SET CHK=0
DO CHKI
QUIT
+9 IF STR'=STR1
SET CHK=3
DO PROCD
SET CHK=0
DO CHKI
QUIT
+10 FOR K=1:1
if $PIECE(STR1,",",K)=""
QUIT
SET IEN1=$PIECE(STR,",",K)
DO CHKD1
CHKI IF NOD2'="Y"
IF $GET(^FH(111,IEN,"I"))="Y"
SET CHK=4
DO PROCD
QUIT
+1 IF NOD2="Y"
IF $GET(^FH(111,IEN,"I"))'="Y"
SET CHK=5
DO PROCD
QUIT
+2 QUIT
CHKD1 IF 'IEN1
SET CHK=3
DO PROCD
SET CHK=0
QUIT
+1 IF $GET(^FH(111,IEN,"AN",IEN1,0))'=$GET(^TMP($JOB,"FHNOD3",($PIECE(STR1,",",K))))
SET CHK=3
DO PROCD
SET CHK=0
+2 QUIT
PROCD ; Process Diet Order Msg.
+1 if 'CHK
QUIT
+2 IF REC
DO CODE^FHWORI
SET REC=0
SET N1=2
+3 SET Z1=$SELECT($GET(^FH(111,IEN,0))'="":$GET(^FH(111,IEN,0)),1:$PIECE(NOD1,"^",1,4))
+4 if CHK=1
GOTO ADD
if CHK=2
GOTO DLD
if CHK=3
GOTO UPD
if CHK=4
GOTO DCD
if CHK=5
GOTO ACD
+5 QUIT
CHKT ; Check which Tubefeeding Transactions
+1 SET FILE="118.2"
SET FILNM=$PIECE($GET(^FH(118.2,0)),"^",1)
+2 IF $PIECE(IEN,"^",3)
SET CHK=1
SET IEN=+IEN
DO PROCT
SET CHK=0
DO CHKIN
QUIT
+3 SET IEN=+IEN
+4 IF $GET(^FH(118.2,IEN,0))=""
SET CHK=2
DO PROCT
QUIT
+5 IF NOD1'=$PIECE($GET(^FH(118.2,IEN,0)),"^",1)
SET CHK=3
DO PROCT
SET CHK=0
DO CHKIN
QUIT
+6 SET STR=""
FOR IEN1=0:0
SET IEN1=$ORDER(^FH(118.2,IEN,1,IEN1))
if IEN1<1
QUIT
if STR'=""
SET STR=STR_","
SET STR=STR_IEN1
+7 SET STR1=""
FOR IEN1=0:0
SET IEN1=$ORDER(^TMP($JOB,"FHNOD2",IEN1))
if IEN1<1
QUIT
if STR1'=""
SET STR1=STR1_","
SET STR1=STR1_IEN1
+8 IF $LENGTH(STR,",")'=$LENGTH(STR1,",")
SET CHK=3
DO PROCT
SET CHK=0
DO CHKIN
QUIT
+9 IF STR'=STR1
SET CHK=3
DO PROCT
SET CHK=0
DO CHKIN
QUIT
+10 FOR K=1:1
if $PIECE(STR1,",",K)=""
QUIT
SET IEN1=$PIECE(STR,",",K)
DO CHKT1
CHKIN ; Check if more than one transaction
+1 IF NOD3'="Y"
IF $GET(^FH(118.2,IEN,"I"))="Y"
SET CHK=4
DO PROCT
QUIT
+2 IF NOD3="Y"
IF $GET(^FH(118.2,IEN,"I"))'="Y"
SET CHK=5
DO PROCT
QUIT
+3 QUIT
CHKT1 IF 'IEN1
SET CHK=3
DO PROCT
SET CHK=0
QUIT
+1 IF $GET(^FH(118.2,IEN,1,IEN1,0))'=$GET(^TMP($JOB,"FHNOD2",($PIECE(STR1,",",K))))
SET CHK=3
DO PROCT
SET CHK=0
+2 QUIT
PROCT ; Process Tubefeeding Msg.
+1 if 'CHK
QUIT
+2 IF REC
DO CODE^FHWORI
SET REC=0
SET N1=2
+3 SET Z1=$SELECT($GET(^FH(118.2,IEN,0))'="":$GET(^FH(118.2,IEN,0)),1:NOD1)
+4 if CHK=1
GOTO ADT
if CHK=2
GOTO DLT
if CHK=3
GOTO UPT
if CHK=4
GOTO DCT
if CHK=5
GOTO ACT
+5 QUIT
ADD ; Code Add Diet Order
+1 SET ACT="MAD"
GOTO DO
DLD ; Code Delete Diet Order
+1 SET ACT="MDL"
GOTO DO
UPD ; Code Update Diet Order
+1 SET ACT="MUP"
GOTO DO
DCD ; Code Deactivate Diet Order
+1 SET ACT="MDC"
GOTO DO
ACD ; Code Reactivate Deactivated Diet Order
+1 SET ACT="MAC"
GOTO DO
ADT ; Code Add Tubefeeding
+1 SET ACT="MAD"
GOTO TF
DLT ; Code Delete Tubefeeding
+1 SET ACT="MDL"
GOTO TF
UPT ; Code Update Tubefeeding
+1 SET ACT="MUP"
GOTO TF
DCT ; Code Deactive Tubefeeding
+1 SET ACT="MDC"
GOTO TF
ACT ; Code Reactivate Deactivated Tubefeeding
+1 SET ACT="MAC"
GOTO TF
DO ; Code Diet Order MFE, ZFH, and ZSY
+1 SET NAM=$PIECE(Z1,"^",1)
if NAM=""
QUIT
SET PREC=$PIECE(Z1,"^",4)
if 'PREC
QUIT
+2 SET SYN=$PIECE(Z1,"^",2)
SET N1=N1+1
+3 SET MSG(N1)="MFE|"_ACT_"|||^^^"_IEN_"^"_NAM_"^99FHD"
+4 SET N1=N1+1
SET MSG(N1)="ZFH|D|"_PREC_"||"_$PIECE(Z1,"^",3)
+5 IF $GET(^FH(111,IEN,0))=""
SET FHK=0
Begin DoDot:1
+6 FOR IEN1=0:0
SET IEN1=$ORDER(^TMP($JOB,"FHNOD3",IEN1))
if IEN1<1
QUIT
SET FHK=IEN1
Begin DoDot:2
+7 SET SYN1=$GET(^TMP($JOB,"FHNOD3",IEN1))
IF SYN1'=""
SET N1=N1+1
SET MSG(N1)="ZSY|"_IEN1_"|"_SYN1
QUIT
End DoDot:2
+8 IF SYN'=""
SET N1=N1+1
SET MSG(N1)="ZSY|"_(FHK+1)_"|"_SYN
+9 QUIT
End DoDot:1
QUIT
+10 SET FHK=0
FOR IEN1=0:0
SET IEN1=$ORDER(^FH(111,IEN,"AN",IEN1))
if IEN1<1
QUIT
SET SYN1=$GET(^(IEN1,0))
Begin DoDot:1
+11 SET FHK=IEN1
SET SYN1=$PIECE(SYN1,"^",1)
IF SYN1'=""
SET N1=N1+1
SET MSG(N1)="ZSY|"_IEN1_"|"_SYN1
QUIT
End DoDot:1
+12 IF SYN'=""
SET N1=N1+1
SET MSG(N1)="ZSY|"_(FHK+1)_"|"_SYN
+13 QUIT
TF ; Code Tubefeeding MFE, ZFH, and ZSY
+1 SET NAM=$PIECE(Z1,"^",1)
if NAM=""
QUIT
SET N1=N1+1
+2 SET MSG(N1)="MFE|"_ACT_"|||^^^"_IEN_"^"_NAM_"^99FHT"
+3 SET N1=N1+1
SET MSG(N1)="ZFH|T|"
+4 IF $GET(^FH(118.2,IEN,0))=""
Begin DoDot:1
+5 FOR IEN1=0:0
SET IEN1=$ORDER(^TMP($JOB,"FHNOD2",IEN1))
if IEN1<1
QUIT
Begin DoDot:2
+6 SET SYN=$GET(^TMP($JOB,"FHNOD2",IEN1))
IF SYN'=""
Begin DoDot:3
End DoDot:3
+7 SET N1=N1+1
+8 SET MSG(N1)="ZSY|"_IEN1_"|"_SYN
QUIT
End DoDot:2
+9 QUIT
End DoDot:1
QUIT
+10 FOR IEN1=0:0
SET IEN1=$ORDER(^FH(118.2,IEN,1,IEN1))
if IEN1<1
QUIT
SET SYN=$GET(^(IEN1,0))
Begin DoDot:1
+11 SET SYN=$PIECE(SYN,"^",1)
if SYN=""
QUIT
SET N1=N1+1
+12 SET MSG(N1)="ZSY|"_IEN1_"|"_SYN
QUIT
End DoDot:1
+13 QUIT
SEND ; Send Message to OE/RR
+1 DO MSG^XQOR("FH ORDERABLE ITEM UPDATE",.MSG)
+2 KILL MSG
QUIT
