Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHMTK1D

FHMTK1D.m

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