source: FOIAVistA/trunk/r/DIETETICS-FH/FHOMDPA.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1FHOMDPA ;Hines OIFO/RTK OUTPATIENT LOOK-UP ;12/3/02 09:46
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3F1 ;
4 ; FHALL=1 - Lookup INPATIENTS or OUTPATIENTS
5 ; FHALL=0 - Lookup OUTPATIENTS only (to lookup INPATS only, use FHDPA)
6 ; FHDFN=IEN in file #115, FHZ115=.01 in file #115 (ie P27 or N1866)
7 ; DFN=IEN in file #2 (or NULL), IEN200=IEN in file #200 (or NULL)
8 ;
9 S (FHZ115,FHDFN,IEN200)="",FHALL=$G(FHALL)
10 R !!,"Select Patient (Name or SSN): ",X:DTIME I '$T!(U[X) D NOP Q
11 S XRESP=X
12 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
13 K DIC S DIC=2,DIC(0)="EZM" D ^DIC K DIC I U[X D NOP Q
14 S FHYIEN=+Y,DFN=FHYIEN
15FX1 I FHALL=1,$D(^DPT(DFN,.1)) D ENOM^FHDPA K FHALL Q
16 I $D(^DPT(DFN,.1)) D MSG K FHALL Q
17 I DFN>0 D VER I Y="^" D NOP Q
18 I Y=0,XRESP=" " D F1 Q
19 I Y=1 S FHZ115="P"_DFN D ADD K FHALL Q
20FF11 ;
21 S X=XRESP K DIC S DIC=200,DIC(0)="EQZM" D ^DIC K DIC I U[X D NOP Q
22 S FHYIEN=+Y,IEN200=FHYIEN
23 I IEN200>0 D VER I Y="^"!(Y=0) K FHALL Q
24 I IEN200<1 W !!,"NOT FOUND IN 2 OR 200" D F1 K FHALL Q
25 S FHZ115="N"_IEN200 D ADD
26 K FHALL Q
27VER ;
28 W ! S DIR(0)="YA",DIR("A")="Correct? ",DIR("B")="Y" D ^DIR
29 Q
30ADD ; ADD ENTRY IF NOT ALREADY IN FILE 115
31 D CHECK I FLAG=1 Q
32 K DD,DO S DIC="^FHPT(",DIC(0)="L",X=FHZ115 D FILE^DICN
33 S FHDFN=$O(^FHPT("B",FHZ115,"")) I FHDFN="" Q
34 S ^DISV(DUZ,"^FHPT(")=FHDFN ;save SPACEBAR/RETURN value
35 S FHPTTYP=$E(FHZ115,1),FHPTR=$E(FHZ115,2,99)
36 I FHPTTYP="P" D
37 .K DIE S DA=FHDFN,DIE="^FHPT(",DR="14////^S X=FHPTR;15///@" D ^DIE
38 I FHPTTYP="N" D
39 .K DIE S DA=FHDFN,DIE="^FHPT(",DR="15////^S X=FHPTR;14///@" D ^DIE
40 Q
41CHECK ; CHECK IF ALREADY IN FILE 115
42 S FLAG=0,FHDFN=""
43 I $D(^FHPT("B",FHZ115)) D
44 .S FLAG=1,FHDFN=$O(^FHPT("B",FHZ115,""))
45 .S ^DISV(DUZ,"^FHPT(")=FHDFN ;save SPACEBAR/RETURN value
46 .I $E(FHZ115,1)="P" S DFN=$E(FHZ115,2,99),IEN200=""
47 .I $E(FHZ115,1)="N" S IEN200=$E(FHZ115,2,99),DFN=""
48 Q
49MSG ;
50 W !!,"Currently admitted as an Inpatient." D NOP
51 Q
52NOP ;
53 S FHDFN=0,DFN=0,Y=-1 K FHALL Q
54 Q
Note: See TracBrowser for help on using the repository browser.