- FHOMDPA ;Hines OIFO/RTK OUTPATIENT LOOK-UP ;12/3/02 09:46
- ;;5.5;DIETETICS;**5,17**;Jan 28, 2005;Build 9
- 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)
- 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
- 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
- FHOMDPA ;Hines OIFO/RTK OUTPATIENT LOOK-UP ;12/3/02 09:46
- +1 ;;5.5;DIETETICS;**5,17**;Jan 28, 2005;Build 9
- 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)
- +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 IF DFN>0
- DO VER
- IF Y="^"
- DO NOP
- QUIT
- +3 IF Y=0
- IF XRESP=" "
- DO F1
- QUIT
- +4 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
