FHMTK1D ;SFVAMC/APC - MEAL TICKET UTILITIES ; 5/29/2017 12:10
;;5.5;DIETETICS;**43**;Jan 28, 2005;Build 66
;
;ICR# Type Description
;----- ---- --------------------------------------
;10006 Sup ^DIC
;10018 Sup ^DIE
;10026 Sup ^DIR
; 2051 Sup FIND^DIC
; 2051 Sup FIND1^DIC
;10035 Sup File #2
;
DRV(DATA,PART,MFLG,MEAL) ;
S MESS=$$NOTE(DATA,PART,$G(MFLG),$G(MEAL))
W !,MESS
Q
;
NOTE(MTID,PART,MFLG,MEAL) ;Called from HEAD^FHMTK1C
N FHWARD,PATNM,ARHCDFN,BID,FOUND,MSG,X
S MSG=""
S FHWARD=$P(MTID,U,2),X=$P(MTID,"("),X=$E(X,1,$L(X)-1)
I FHWARD="GA(L)" D NOTE2(X,FHWARD) S:MSG="" MSG="PPAPER ISOL/PLASTW"
I $E(FHWARD,1,3)="CLC" D NOTE2(X,FHWARD)
Q MSG
;
NOTE2(X,FHWARD) ;
N FHNODE,FHP,FHIENP,FHTMP,FHIEN,FLDS,FLG,FHERR,DIERR
S FLDS="@;.1"
S FLG="PQ"
D FIND^DIC(2,,FLDS,FLG,X,,"B","I $E($G(^(.1)),1,3)=""CLC""",,"FHTMP","FHERR")
S FHIENP=0 F S FHIENP=$O(FHTMP("DILIST",FHIENP)) Q:FHIENP="" D
.S FHIEN=$P($G(FHTMP("DILIST",FHIENP,0)),U)
.S FHNODE=$G(^FHPT($$IEN(FHIEN),22))
.I 'MFLG S MSG=$S(MEAL="B":$P(FHNODE,U,1),MEAL="N":$P(FHNODE,U,2),1:$P(FHNODE,U,3)) Q
.S MSG=$S(PART=1:$P(FHNODE,U,1),PART=2:$P(FHNODE,U,2),1:$P(FHNODE,U,3))
Q
;
TTFLAG ;Edit tray ticket flag
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
K DIR S DIR(0)="S^P:PATIENT;W:WARD",DIR("A")="Select by (P)atient or (W)ard",DIR("B")="P" D ^DIR
Q:$D(DIRUT)
I Y="P" D TTFP Q
I Y="W" D TTFW Q
Q
;
TTFP ;Edit tray ticket flag by patient
N FHCDFN,FHCFDFN,DIE,DA,DIC,DR,DTOUT,DUOUT
F K DIC S DIC="^DPT(",DIC(0)="AZEMQ" D ^DIC Q:Y'>0 D
.S FHCDFN=+Y
.S FHCFDFN=$$IEN(FHCDFN)
.I $$GET1^DIQ(2,FHCDFN,.1)'["CLC" W !!,?7,"Patient is not a CLC patient" Q
.I '$D(^FHPT(FHCFDFN,0)) W !!,*7,$$GET1^DIQ(2,FHCFDFN,.01)," is not in the Dietetics Patient file." Q
.S DIE="^FHPT(",DA=FHCFDFN,DR="22;22.1;22.2" D ^DIE
.W !
Q
;
TTFW ;Edit tray ticket flag by ward
N FHCDFN,FHCFDFN,FHWARD,EXIT,FHTMP,FHERR,FLDS,FLG,FHIEN,FHPTIEN,DIE,DTOUT,DUOUT,Y
S FHCDFN=0,EXIT=0
S FLDS="@;.01"
S FLG="PQ"
D FIND^DIC(2,,FLDS,FLG,"CLC",,"CN",,,"FHTMP","FHERR")
F S FHCDFN=$O(FHTMP("DILIST",FHCDFN)) Q:'FHCDFN D Q:EXIT
.N DA,DIE,DR,DTOUT,DUOUT
.S FHCFDFN=FHTMP("DILIST",FHCDFN,0),FHIEN=+FHCFDFN
.S FHPTIEN=$$IEN(FHIEN) ;Get the FH file IEN
.I '$D(^FHPT(FHPTIEN)) W !,*7,$P(FHTMP("DILIST",FHCDFN,0),U,2)," is not in the Dietetics Patient file." Q
.W !!,?5,$$GET1^DIQ(2,FHIEN,.01)," ",$$GET1^DIQ(2,FHIEN,.1)," ",$$GET1^DIQ(2,FHIEN,.101)
.S DIE="^FHPT(",DA=FHPTIEN,DR="22;22.1;22.2" D ^DIE
.I $D(DTOUT)!$D(Y) S EXIT=1
Q
;
IEN(FHD0,FHDFILE) ;
; ;
; Get pointer to NUTRITION PERSON (#115) given
; the PATIENT (#2) or NEW PERSON (#200) pointer
; Input
; FHD0 = PATIENT (#2) or NEW PERSON (#200) pointer (Req)
; FHDFILE = PATIENT (#2) or NEW PERSON (#200) file # (Opt, Dflt=2)
; Output
; $$IEN() = Pointer to NUTRITION PERSON (#115)
N DFN,FOUND,LN,MFLG,MM,MSG,N1,NBR,NM,PART,PG,S1,SL,TL,X,Y,Z,DIERR,FHERR
Q +$$FIND1^DIC(115,"","X",$S($G(FHDFILE,2)=200:"N",1:"P")_FHD0,"B")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHMTK1D 3092 printed Dec 13, 2024@01:48:09 Page 2
FHMTK1D ;SFVAMC/APC - MEAL TICKET UTILITIES ; 5/29/2017 12:10
+1 ;;5.5;DIETETICS;**43**;Jan 28, 2005;Build 66
+2 ;
+3 ;ICR# Type Description
+4 ;----- ---- --------------------------------------
+5 ;10006 Sup ^DIC
+6 ;10018 Sup ^DIE
+7 ;10026 Sup ^DIR
+8 ; 2051 Sup FIND^DIC
+9 ; 2051 Sup FIND1^DIC
+10 ;10035 Sup File #2
+11 ;
DRV(DATA,PART,MFLG,MEAL) ;
+1 SET MESS=$$NOTE(DATA,PART,$GET(MFLG),$GET(MEAL))
+2 WRITE !,MESS
+3 QUIT
+4 ;
NOTE(MTID,PART,MFLG,MEAL) ;Called from HEAD^FHMTK1C
+1 NEW FHWARD,PATNM,ARHCDFN,BID,FOUND,MSG,X
+2 SET MSG=""
+3 SET FHWARD=$PIECE(MTID,U,2)
SET X=$PIECE(MTID,"(")
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+4 IF FHWARD="GA(L)"
DO NOTE2(X,FHWARD)
if MSG=""
SET MSG="PPAPER ISOL/PLASTW"
+5 IF $EXTRACT(FHWARD,1,3)="CLC"
DO NOTE2(X,FHWARD)
+6 QUIT MSG
+7 ;
NOTE2(X,FHWARD) ;
+1 NEW FHNODE,FHP,FHIENP,FHTMP,FHIEN,FLDS,FLG,FHERR,DIERR
+2 SET FLDS="@;.1"
+3 SET FLG="PQ"
+4 DO FIND^DIC(2,,FLDS,FLG,X,,"B","I $E($G(^(.1)),1,3)=""CLC""",,"FHTMP","FHERR")
+5 SET FHIENP=0
FOR
SET FHIENP=$ORDER(FHTMP("DILIST",FHIENP))
if FHIENP=""
QUIT
Begin DoDot:1
+6 SET FHIEN=$PIECE($GET(FHTMP("DILIST",FHIENP,0)),U)
+7 SET FHNODE=$GET(^FHPT($$IEN(FHIEN),22))
+8 IF 'MFLG
SET MSG=$SELECT(MEAL="B":$PIECE(FHNODE,U,1),MEAL="N":$PIECE(FHNODE,U,2),1:$PIECE(FHNODE,U,3))
QUIT
+9 SET MSG=$SELECT(PART=1:$PIECE(FHNODE,U,1),PART=2:$PIECE(FHNODE,U,2),1:$PIECE(FHNODE,U,3))
End DoDot:1
+10 QUIT
+11 ;
TTFLAG ;Edit tray ticket flag
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+2 KILL DIR
SET DIR(0)="S^P:PATIENT;W:WARD"
SET DIR("A")="Select by (P)atient or (W)ard"
SET DIR("B")="P"
DO ^DIR
+3 if $DATA(DIRUT)
QUIT
+4 IF Y="P"
DO TTFP
QUIT
+5 IF Y="W"
DO TTFW
QUIT
+6 QUIT
+7 ;
TTFP ;Edit tray ticket flag by patient
+1 NEW FHCDFN,FHCFDFN,DIE,DA,DIC,DR,DTOUT,DUOUT
+2 FOR
KILL DIC
SET DIC="^DPT("
SET DIC(0)="AZEMQ"
DO ^DIC
if Y'>0
QUIT
Begin DoDot:1
+3 SET FHCDFN=+Y
+4 SET FHCFDFN=$$IEN(FHCDFN)
+5 IF $$GET1^DIQ(2,FHCDFN,.1)'["CLC"
WRITE !!,?7,"Patient is not a CLC patient"
QUIT
+6 IF '$DATA(^FHPT(FHCFDFN,0))
WRITE !!,*7,$$GET1^DIQ(2,FHCFDFN,.01)," is not in the Dietetics Patient file."
QUIT
+7 SET DIE="^FHPT("
SET DA=FHCFDFN
SET DR="22;22.1;22.2"
DO ^DIE
+8 WRITE !
End DoDot:1
+9 QUIT
+10 ;
TTFW ;Edit tray ticket flag by ward
+1 NEW FHCDFN,FHCFDFN,FHWARD,EXIT,FHTMP,FHERR,FLDS,FLG,FHIEN,FHPTIEN,DIE,DTOUT,DUOUT,Y
+2 SET FHCDFN=0
SET EXIT=0
+3 SET FLDS="@;.01"
+4 SET FLG="PQ"
+5 DO FIND^DIC(2,,FLDS,FLG,"CLC",,"CN",,,"FHTMP","FHERR")
+6 FOR
SET FHCDFN=$ORDER(FHTMP("DILIST",FHCDFN))
if 'FHCDFN
QUIT
Begin DoDot:1
+7 NEW DA,DIE,DR,DTOUT,DUOUT
+8 SET FHCFDFN=FHTMP("DILIST",FHCDFN,0)
SET FHIEN=+FHCFDFN
+9 ;Get the FH file IEN
SET FHPTIEN=$$IEN(FHIEN)
+10 IF '$DATA(^FHPT(FHPTIEN))
WRITE !,*7,$PIECE(FHTMP("DILIST",FHCDFN,0),U,2)," is not in the Dietetics Patient file."
QUIT
+11 WRITE !!,?5,$$GET1^DIQ(2,FHIEN,.01)," ",$$GET1^DIQ(2,FHIEN,.1)," ",$$GET1^DIQ(2,FHIEN,.101)
+12 SET DIE="^FHPT("
SET DA=FHPTIEN
SET DR="22;22.1;22.2"
DO ^DIE
+13 IF $DATA(DTOUT)!$DATA(Y)
SET EXIT=1
End DoDot:1
if EXIT
QUIT
+14 QUIT
+15 ;
IEN(FHD0,FHDFILE) ;
+1 ; ;
+2 ; Get pointer to NUTRITION PERSON (#115) given
+3 ; the PATIENT (#2) or NEW PERSON (#200) pointer
+4 ; Input
+5 ; FHD0 = PATIENT (#2) or NEW PERSON (#200) pointer (Req)
+6 ; FHDFILE = PATIENT (#2) or NEW PERSON (#200) file # (Opt, Dflt=2)
+7 ; Output
+8 ; $$IEN() = Pointer to NUTRITION PERSON (#115)
+9 NEW DFN,FOUND,LN,MFLG,MM,MSG,N1,NBR,NM,PART,PG,S1,SL,TL,X,Y,Z,DIERR,FHERR
+10 QUIT +$$FIND1^DIC(115,"","X",$SELECT($GET(FHDFILE,2)=200:"N",1:"P")_FHD0,"B")
