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

FHOMDPA.m

Go to the documentation of this file.
  1. FHOMDPA ;Hines OIFO/RTK OUTPATIENT LOOK-UP ;12/3/02 09:46
  1. ;;5.5;DIETETICS;**5,17,24,31**;Jan 28, 2005;Build 1
  1. F1 ;
  1. ; FHALL=1 - Lookup INPATIENTS or OUTPATIENTS
  1. ; FHALL=0 - Lookup OUTPATIENTS only (to lookup INPATS only, use FHDPA)
  1. ; FHDFN=IEN in file #115, FHZ115=.01 in file #115 (ie P27 or N1866)
  1. ; DFN=IEN in file #2 (or NULL), IEN200=IEN in file #200 (or NULL)
  1. ;
  1. S (FHZ115,FHDFN,IEN200)="",FHALL=$G(FHALL),FHMSG1=$G(FHMSG1)
  1. R !!,"Select Patient (Name or SSN): ",X:DTIME I '$T!(U[X) D NOP Q
  1. S XRESP=X
  1. I XRESP=" " S FHDFN=$G(^DISV(DUZ,"^FHPT(")) I FHDFN'="" D PATNAME^FHOMUTL W FHPTNM K:DFN="" FHALL Q:DFN="" S Y=DFN D FX1 K FHALL Q
  1. K DIC S DIC=2,DIC(0)="EZM" D ^DIC K DIC I U[X D NOP Q
  1. S FHYIEN=+Y,DFN=FHYIEN
  1. FX1 I FHALL=1,$D(^DPT(DFN,.1)) D ENOM^FHDPA K FHALL Q
  1. I $D(^DPT(DFN,.1)) D MSG K FHALL Q
  1. ;Added FH*5.5*24,Revised FH*5.5*31
  1. D DEAD I FHDFN=0 S FHDFN="" Q
  1. I DFN>0 D VER I Y="^" D NOP Q
  1. I Y=0,XRESP=" " D F1 Q
  1. I Y=1 S FHZ115="P"_DFN D ADD K FHALL Q
  1. FF11 ;
  1. W !!,"LOOKING IN THE NEW PERSON FILE, FILE # 200.",!!
  1. S X=XRESP K DIC S DIC=200,DIC(0)="EQZM" D ^DIC K DIC I U[X D NOP Q
  1. S FHYIEN=+Y,IEN200=FHYIEN
  1. I IEN200>0 D VER I Y="^"!(Y=0) K FHALL Q
  1. I IEN200<1 W !!,"NOT FOUND IN 2 OR 200" D F1 K FHALL Q
  1. S FHZ115="N"_IEN200 D ADD
  1. K FHALL Q
  1. VER ;
  1. W ! S DIR(0)="YA",DIR("A")="Correct? ",DIR("B")="Y" D ^DIR
  1. Q
  1. ADD ; ADD ENTRY IF NOT ALREADY IN FILE 115
  1. D CHECK I FLAG=1 Q
  1. K DD,DO S DIC="^FHPT(",DIC(0)="L",X=FHZ115 D FILE^DICN
  1. S FHDFN=$O(^FHPT("B",FHZ115,"")) I FHDFN="" Q
  1. S ^DISV(DUZ,"^FHPT(")=FHDFN ;save SPACEBAR/RETURN value
  1. S FHPTTYP=$E(FHZ115,1),FHPTR=$E(FHZ115,2,99)
  1. I FHPTTYP="P" D
  1. .K DIE S DA=FHDFN,DIE="^FHPT(",DR="14////^S X=FHPTR;15///@" D ^DIE
  1. I FHPTTYP="N" D
  1. .K DIE S DA=FHDFN,DIE="^FHPT(",DR="15////^S X=FHPTR;14///@" D ^DIE
  1. Q
  1. CHECK ; CHECK IF ALREADY IN FILE 115
  1. S FLAG=0,FHDFN=""
  1. I $D(^FHPT("B",FHZ115)) D
  1. .S FLAG=1,FHDFN=$O(^FHPT("B",FHZ115,""))
  1. .S ^DISV(DUZ,"^FHPT(")=FHDFN ;save SPACEBAR/RETURN value
  1. .I $E(FHZ115,1)="P" S DFN=$E(FHZ115,2,99),IEN200=""
  1. .I $E(FHZ115,1)="N" S IEN200=$E(FHZ115,2,99),DFN=""
  1. Q
  1. MSG ;
  1. W !!,"Currently admitted as an Inpatient." D NOP
  1. Q
  1. NOP ;
  1. S FHDFN=0,DFN=0,Y=-1 K FHALL Q
  1. Q
  1. DEAD ;PATIENT IS DEAD
  1. ;Added patch FH*5.5*24, Revised FH*5.5*31
  1. ;If no date of death quit
  1. I $P($G(^DPT(DFN,.35)),U)="" Q
  1. ;Get patient's date of death
  1. S PTDOD=$$FMTE^XLFDT($P($G(^DPT(DFN,.35)),U),"D")
  1. ;Get patient's name
  1. S PTNAME=$P($G(^DPT(DFN,0)),U)
  1. ;Display patient is dead message
  1. W !!?5,"This patient, ",PTNAME,", died on ",PTDOD,"."
  1. ;If ordering Outpatient meal
  1. I FHMSG1'="" D
  1. . ;Set quit condition for outpatient meal ordering
  1. . D NOP
  1. . ;Display outpatient can't be ordered for dead patient message
  1. . D TYPE^FHOMUTL
  1. . W !?5,FHMSGML," cannot be ordered for this patient."
  1. W !
  1. K PTDOD,PTNAME
  1. Q