- FHMTK1A ; HISC/REL/NCA - Build Tray Tickets ;4/21/95 08:21
- ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
- B1 ; Store wards
- K ^TMP($J),DP,N,P,TP,T1 S ALL=0,MFLG=0 D Q1^FHMTK1B D NOW^%DTC S (DTP,TIM)=% D DTP^FH S HD=DTP
- S DTP=D1 D DTP^FH S MDT=DTP S:MEAL="A" MFLG=1
- I 'FHP,'W1,'DFN S ALL=1
- S FHBOT=$P($G(^FH(119.9,1,4)),"^",1)
- I $G(FHOMF)=1 D ^FHOMTK1 Q
- I DFN D Q
- .S ADM=+$G(^DPT(DFN,.105)),W1=+$P($G(^FHPT(FHDFN,"A",+ADM,0)),"^",8)
- .S K1=$G(^FH(119.6,+W1,0)),WRDN=$P(K1,"^",1),SP=$P(K1,"^",5),SP1=$P(K1,"^",6),FHPAR=$P(K1,"^",24),RM=$G(^DPT(DFN,.101))
- .I 'SP Q:FHPAR'="Y" S SP=SP1 Q:'SP
- .K MM,PP,S S NBR=0 I MEAL'="A" D BLD^FHMTK11 D:NBR UPD,PRT^FHMTK1C Q
- .F MEAL="B","N","E" D BLD^FHMTK11
- .D UPD
- .D:NBR PRT^FHMTK1C Q
- I W1 S ^TMP($J,"W","01"_$P($G(^FH(119.6,+W1,0)),"^",1))=W1_"^"_$P($G(^FH(119.6,+W1,0)),"^",5,6)_"^"_$P($G(^FH(119.6,+W1,0)),"^",24)
- E F W1=0:0 S W1=$O(^FH(119.6,W1)) Q:W1<1 D
- .S P0=$G(^FH(119.6,W1,0)),WRDN=$P(P0,"^",1),SP=$P(P0,"^",5,6),D2=$P(P0,"^",8),FHPAR=$P(P0,"^",24),P0=$P(P0,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0)
- .I FHP,D2'=FHP Q
- .S ^TMP($J,"W",P0_WRDN)=W1_"^"_SP_"^"_FHPAR Q
- S NX="" F S NX=$O(^TMP($J,"W",NX)) Q:NX="" S X1=$G(^(NX)),W1=+X1,FHS=$P(X1,"^",2),SP1=$P(X1,"^",3),FHPAR=$P(X1,"^",4),WRDN=$E(NX,3,99) S:'FHS&(FHPAR="Y") FHS=SP1 I FHS K ^TMP($J,"D") D
- .F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",W1,FHDFN)) Q:FHDFN<1 D
- ..D PATNAME^FHOMUTL I DFN="" Q
- ..S ADM=$G(^FHPT("AW",W1,FHDFN))
- ..I SRT="A" S RM=$P($G(^DPT(DFN,0)),"^",1),R0=0,RMB=$G(^DPT(DFN,.101)) S:RMB="" RMB="***"
- ..E S RI=$G(^DPT(DFN,.108)),RM=$G(^DPT(DFN,.101)) S:RM="" RM="***" S RE=$S(RI:$O(^FH(119.6,"AR",+RI,W1,0)),1:""),R0=$S(RE:$P($G(^FH(119.6,W1,"R",+RE,0)),"^",2),1:""),RMB=""
- ..S R0=$S(R0<1:99,R0<10:"0"_R0,1:R0)
- ..S ^TMP($J,"D",R0_"~"_RM_"~"_$S(SRT="R":FHDFN,1:RMB))=FHDFN_"^"_ADM Q
- .K MM,PP,S S X9="",NBR=0 F S X9=$O(^TMP($J,"D",X9)) Q:X9="" S FHDFN=$P(^(X9),"^",1),ADM=$P(^(X9),"^",2),RM=$S(SRT="R":$P(X9,"~",2),1:$P(X9,"~",3)) S SP=FHS D
- ..D PATNAME^FHOMUTL I DFN="" Q
- ..I 'MFLG D BLD^FHMTK11,UPD Q
- ..F MEAL="B","N","E" D BLD^FHMTK11
- ..D UPD
- ..Q
- .I NBR D PRT^FHMTK1C
- .Q
- OMTT ;Display outpatient tray tickets
- K MM,PP,S D ^FHOMTK1
- TAB ;Display tabulated recipe list
- D LIST^FHMTK1C
- Q
- UPD ; Update the Date/Time Tray Ticket was Printed
- I $G(TABREC)="YES" QUIT
- S $P(^FHPT(FHDFN,"A",ADM,0),"^",15)=TIM Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHMTK1A 2391 printed Feb 18, 2025@23:14:29 Page 2
- FHMTK1A ; HISC/REL/NCA - Build Tray Tickets ;4/21/95 08:21
- +1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
- B1 ; Store wards
- +1 KILL ^TMP($JOB),DP,N,P,TP,T1
- SET ALL=0
- SET MFLG=0
- DO Q1^FHMTK1B
- DO NOW^%DTC
- SET (DTP,TIM)=%
- DO DTP^FH
- SET HD=DTP
- +2 SET DTP=D1
- DO DTP^FH
- SET MDT=DTP
- if MEAL="A"
- SET MFLG=1
- +3 IF 'FHP
- IF 'W1
- IF 'DFN
- SET ALL=1
- +4 SET FHBOT=$PIECE($GET(^FH(119.9,1,4)),"^",1)
- +5 IF $GET(FHOMF)=1
- DO ^FHOMTK1
- QUIT
- +6 IF DFN
- Begin DoDot:1
- +7 SET ADM=+$GET(^DPT(DFN,.105))
- SET W1=+$PIECE($GET(^FHPT(FHDFN,"A",+ADM,0)),"^",8)
- +8 SET K1=$GET(^FH(119.6,+W1,0))
- SET WRDN=$PIECE(K1,"^",1)
- SET SP=$PIECE(K1,"^",5)
- SET SP1=$PIECE(K1,"^",6)
- SET FHPAR=$PIECE(K1,"^",24)
- SET RM=$GET(^DPT(DFN,.101))
- +9 IF 'SP
- if FHPAR'="Y"
- QUIT
- SET SP=SP1
- if 'SP
- QUIT
- +10 KILL MM,PP,S
- SET NBR=0
- IF MEAL'="A"
- DO BLD^FHMTK11
- if NBR
- DO UPD
- DO PRT^FHMTK1C
- QUIT
- +11 FOR MEAL="B","N","E"
- DO BLD^FHMTK11
- +12 DO UPD
- +13 if NBR
- DO PRT^FHMTK1C
- QUIT
- End DoDot:1
- QUIT
- +14 IF W1
- SET ^TMP($JOB,"W","01"_$PIECE($GET(^FH(119.6,+W1,0)),"^",1))=W1_"^"_$PIECE($GET(^FH(119.6,+W1,0)),"^",5,6)_"^"_$PIECE($GET(^FH(119.6,+W1,0)),"^",24)
- +15 IF '$TEST
- FOR W1=0:0
- SET W1=$ORDER(^FH(119.6,W1))
- if W1<1
- QUIT
- Begin DoDot:1
- +16 SET P0=$GET(^FH(119.6,W1,0))
- SET WRDN=$PIECE(P0,"^",1)
- SET SP=$PIECE(P0,"^",5,6)
- SET D2=$PIECE(P0,"^",8)
- SET FHPAR=$PIECE(P0,"^",24)
- SET P0=$PIECE(P0,"^",4)
- SET P0=$SELECT(P0<1:99,P0<10:"0"_P0,1:P0)
- +17 IF FHP
- IF D2'=FHP
- QUIT
- +18 SET ^TMP($JOB,"W",P0_WRDN)=W1_"^"_SP_"^"_FHPAR
- QUIT
- End DoDot:1
- +19 SET NX=""
- FOR
- SET NX=$ORDER(^TMP($JOB,"W",NX))
- if NX=""
- QUIT
- SET X1=$GET(^(NX))
- SET W1=+X1
- SET FHS=$PIECE(X1,"^",2)
- SET SP1=$PIECE(X1,"^",3)
- SET FHPAR=$PIECE(X1,"^",4)
- SET WRDN=$EXTRACT(NX,3,99)
- if 'FHS&(FHPAR="Y")
- SET FHS=SP1
- IF FHS
- KILL ^TMP($JOB,"D")
- Begin DoDot:1
- +20 FOR FHDFN=0:0
- SET FHDFN=$ORDER(^FHPT("AW",W1,FHDFN))
- if FHDFN<1
- QUIT
- Begin DoDot:2
- +21 DO PATNAME^FHOMUTL
- IF DFN=""
- QUIT
- +22 SET ADM=$GET(^FHPT("AW",W1,FHDFN))
- +23 IF SRT="A"
- SET RM=$PIECE($GET(^DPT(DFN,0)),"^",1)
- SET R0=0
- SET RMB=$GET(^DPT(DFN,.101))
- if RMB=""
- SET RMB="***"
- +24 IF '$TEST
- SET RI=$GET(^DPT(DFN,.108))
- SET RM=$GET(^DPT(DFN,.101))
- if RM=""
- SET RM="***"
- SET RE=$SELECT(RI:$ORDER(^FH(119.6,"AR",+RI,W1,0)),1:"")
- SET R0=$SELECT(RE:$PIECE($GET(^FH(119.6,W1,"R",+RE,0)),"^",2),1:"")
- SET RMB=""
- +25 SET R0=$SELECT(R0<1:99,R0<10:"0"_R0,1:R0)
- +26 SET ^TMP($JOB,"D",R0_"~"_RM_"~"_$SELECT(SRT="R":FHDFN,1:RMB))=FHDFN_"^"_ADM
- QUIT
- End DoDot:2
- +27 KILL MM,PP,S
- SET X9=""
- SET NBR=0
- FOR
- SET X9=$ORDER(^TMP($JOB,"D",X9))
- if X9=""
- QUIT
- SET FHDFN=$PIECE(^(X9),"^",1)
- SET ADM=$PIECE(^(X9),"^",2)
- SET RM=$SELECT(SRT="R":$PIECE(X9,"~",2),1:$PIECE(X9,"~",3))
- SET SP=FHS
- Begin DoDot:2
- +28 DO PATNAME^FHOMUTL
- IF DFN=""
- QUIT
- +29 IF 'MFLG
- DO BLD^FHMTK11
- DO UPD
- QUIT
- +30 FOR MEAL="B","N","E"
- DO BLD^FHMTK11
- +31 DO UPD
- +32 QUIT
- End DoDot:2
- +33 IF NBR
- DO PRT^FHMTK1C
- +34 QUIT
- End DoDot:1
- OMTT ;Display outpatient tray tickets
- +1 KILL MM,PP,S
- DO ^FHOMTK1
- TAB ;Display tabulated recipe list
- +1 DO LIST^FHMTK1C
- +2 QUIT
- UPD ; Update the Date/Time Tray Ticket was Printed
- +1 IF $GET(TABREC)="YES"
- QUIT
- +2 SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",15)=TIM
- QUIT