- 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 Feb 18, 2025@23:21:51 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
