- 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 Jan 18, 2025@02:53:57 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