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