- FHWORI ; HISC/NCA - Initial Master File Population ;10/1/96 13:12
- ;;5.5;DIETETICS;;Jan 28, 2005
- DO ; Code Diet Order
- S PKG=$O(^DIC(9.4,"C","FH",0)) Q:'PKG
- S VER=$P($G(^DIC(9.4,PKG,22,0)),"^",3) Q:'VER
- S VER=+$G(^DIC(9.4,PKG,22,VER,0))
- K ^TMP($J,"FHUPD"),MSG
- S FILE="111",FILNM=$P($G(^FH(111,0)),"^",1),EVENT="REP",ACT="MAD"
- F IEN=0:0 S IEN=$O(^FH(111,IEN)) Q:IEN<1 S X=$G(^(IEN,0)) S:$G(^("I"))="Y" ^TMP($J,"FHUPD",IEN)="" D CODE,D1
- K ACT,EVENT,FHK,FILE,FILNM,IEN,IEN1,NAM,N1,N2,PREC,SYN,SYN1,X
- TF ; Code Tubefeeding
- K ^TMP($J,"FHUPT")
- S FILE="118.2",FILNM=$P($G(^FH(118.2,0)),"^",1),EVENT="REP",ACT="MAD" D CODE
- F IEN=0:0 S IEN=$O(^FH(118.2,IEN)) Q:IEN<1 S X=$G(^(IEN,0)) S:$G(^("I"))="Y" ^TMP($J,"FHUPT",IEN)="" D CODE,T1
- K ACT,EVENT,FILE,FILNM,IEN,IEN1,NAM,N1,N2,PKG,SYN,VER,X
- INACTD ; Code Update Inactive Diet Orders
- G:'$D(^TMP($J,"FHUPD")) INACTT
- S FILE="111",FILNM=$P($G(^FH(111,0)),"^",1),EVENT="UPD",ACT="MDC" D CODE
- F IEN=0:0 S IEN=$O(^TMP($J,"FHUPD",IEN)) Q:IEN<1 S X=$G(^FH(111,IEN,0)) D CODE,D1
- K ^TMP($J,"FHUPD"),ACT,EVENT,FILE,FILNM,IEN,NAM,N1,N2,PREC,SYN,X
- INACTT ; Code Update Inactive Tubefeedings
- Q:'$D(^TMP($J,"FHUPT"))
- S FILE="118.2",FILNM=$P($G(^FH(118.2,0)),"^",1),EVENT="UPD",ACT="MDC" D CODE
- F IEN=0:0 S IEN=$O(^TMP($J,"FHUPT",IEN)) Q:IEN<1 S X=$G(^FH(118.2,IEN,0)) D CODE,T1
- K ^TMP($J,"FHUPT"),ACT,EVENT,FILE,FILNM,IEN,IEN1,NAM,N1,N2,SYN,X
- Q
- CODE ; Code MSH for Orderable Items
- S N1=1
- S MSG(N1)="MSH|^~\&|DIETETICS|"_^DD("SITE",1)_"|||||MFN"
- ; code MFI
- S N1=N1+1
- S MSG(N1)="MFI|"_FILE_"^"_FILNM_"^99DD||"_EVENT_"|||NE"
- Q
- D1 ; Code MFE, ZFH, and ZSY for Diet Orders
- S NAM=$P(X,"^",1) Q:NAM="" S PREC=$P(X,"^",4) Q:'PREC
- S SYN=$P(X,"^",2),N1=N1+1
- S MSG(N1)="MFE|"_ACT_"|||^^^"_IEN_"^"_NAM_"^99FHD"
- S N1=N1+1,MSG(N1)="ZFH|D|"_PREC_"||"_$P(X,"^",3)
- 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) Q:SYN1="" S N1=N1+1
- .S MSG(N1)="ZSY|"_IEN1_"|"_SYN1 Q
- I SYN'="" S N1=N1+1,MSG(N1)="ZSY|"_(FHK+1)_"|"_SYN
- D SEND
- Q
- T1 ; Code MFE, ZFH, and ZSY for Tubefeedings
- S NAM=$P(X,"^",1) Q:NAM="" S N1=N1+1
- S MSG(N1)="MFE|"_ACT_"|||^^^"_IEN_"^"_NAM_"^99FHT"
- S N1=N1+1,MSG(N1)="ZFH|T"
- 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
- D SEND
- Q
- SEND ; Send Message to OE/RR
- D MSG^XQOR("FH ORDERABLE ITEM UPDATE",.MSG)
- K MSG Q
- FHWORI ; HISC/NCA - Initial Master File Population ;10/1/96 13:12
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- DO ; Code Diet Order
- +1 SET PKG=$ORDER(^DIC(9.4,"C","FH",0))
- IF 'PKG
- QUIT
- +2 SET VER=$PIECE($GET(^DIC(9.4,PKG,22,0)),"^",3)
- IF 'VER
- QUIT
- +3 SET VER=+$GET(^DIC(9.4,PKG,22,VER,0))
- +4 KILL ^TMP($JOB,"FHUPD"),MSG
- +5 SET FILE="111"
- SET FILNM=$PIECE($GET(^FH(111,0)),"^",1)
- SET EVENT="REP"
- SET ACT="MAD"
- +6 FOR IEN=0:0
- SET IEN=$ORDER(^FH(111,IEN))
- IF IEN<1
- QUIT
- SET X=$GET(^(IEN,0))
- IF $GET(^("I"))="Y"
- SET ^TMP($JOB,"FHUPD",IEN)=""
- DO CODE
- DO D1
- +7 KILL ACT,EVENT,FHK,FILE,FILNM,IEN,IEN1,NAM,N1,N2,PREC,SYN,SYN1,X
- TF ; Code Tubefeeding
- +1 KILL ^TMP($JOB,"FHUPT")
- +2 SET FILE="118.2"
- SET FILNM=$PIECE($GET(^FH(118.2,0)),"^",1)
- SET EVENT="REP"
- SET ACT="MAD"
- DO CODE
- +3 FOR IEN=0:0
- SET IEN=$ORDER(^FH(118.2,IEN))
- IF IEN<1
- QUIT
- SET X=$GET(^(IEN,0))
- IF $GET(^("I"))="Y"
- SET ^TMP($JOB,"FHUPT",IEN)=""
- DO CODE
- DO T1
- +4 KILL ACT,EVENT,FILE,FILNM,IEN,IEN1,NAM,N1,N2,PKG,SYN,VER,X
- INACTD ; Code Update Inactive Diet Orders
- +1 IF '$DATA(^TMP($JOB,"FHUPD"))
- GOTO INACTT
- +2 SET FILE="111"
- SET FILNM=$PIECE($GET(^FH(111,0)),"^",1)
- SET EVENT="UPD"
- SET ACT="MDC"
- DO CODE
- +3 FOR IEN=0:0
- SET IEN=$ORDER(^TMP($JOB,"FHUPD",IEN))
- IF IEN<1
- QUIT
- SET X=$GET(^FH(111,IEN,0))
- DO CODE
- DO D1
- +4 KILL ^TMP($JOB,"FHUPD"),ACT,EVENT,FILE,FILNM,IEN,NAM,N1,N2,PREC,SYN,X
- INACTT ; Code Update Inactive Tubefeedings
- +1 IF '$DATA(^TMP($JOB,"FHUPT"))
- QUIT
- +2 SET FILE="118.2"
- SET FILNM=$PIECE($GET(^FH(118.2,0)),"^",1)
- SET EVENT="UPD"
- SET ACT="MDC"
- DO CODE
- +3 FOR IEN=0:0
- SET IEN=$ORDER(^TMP($JOB,"FHUPT",IEN))
- IF IEN<1
- QUIT
- SET X=$GET(^FH(118.2,IEN,0))
- DO CODE
- DO T1
- +4 KILL ^TMP($JOB,"FHUPT"),ACT,EVENT,FILE,FILNM,IEN,IEN1,NAM,N1,N2,SYN,X
- +5 QUIT
- CODE ; Code MSH for Orderable Items
- +1 SET N1=1
- +2 SET MSG(N1)="MSH|^~\&|DIETETICS|"_^DD("SITE",1)_"|||||MFN"
- +3 ; code MFI
- +4 SET N1=N1+1
- +5 SET MSG(N1)="MFI|"_FILE_"^"_FILNM_"^99DD||"_EVENT_"|||NE"
- +6 QUIT
- D1 ; Code MFE, ZFH, and ZSY for Diet Orders
- +1 SET NAM=$PIECE(X,"^",1)
- IF NAM=""
- QUIT
- SET PREC=$PIECE(X,"^",4)
- IF 'PREC
- QUIT
- +2 SET SYN=$PIECE(X,"^",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(X,"^",3)
- +5 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
- +6 SET FHK=IEN1
- SET SYN1=$PIECE(SYN1,"^",1)
- IF SYN1=""
- QUIT
- SET N1=N1+1
- +7 SET MSG(N1)="ZSY|"_IEN1_"|"_SYN1
- QUIT
- End DoDot:1
- +8 IF SYN'=""
- SET N1=N1+1
- SET MSG(N1)="ZSY|"_(FHK+1)_"|"_SYN
- +9 DO SEND
- +10 QUIT
- T1 ; Code MFE, ZFH, and ZSY for Tubefeedings
- +1 SET NAM=$PIECE(X,"^",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 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
- +5 SET SYN=$PIECE(SYN,"^",1)
- IF SYN=""
- QUIT
- SET N1=N1+1
- +6 SET MSG(N1)="ZSY|"_IEN1_"|"_SYN
- QUIT
- End DoDot:1
- +7 DO SEND
- +8 QUIT
- SEND ; Send Message to OE/RR
- +1 DO MSG^XQOR("FH ORDERABLE ITEM UPDATE",.MSG)
- +2 KILL MSG
- QUIT