- FHDPA ; HISC/REL - Patient Look-Up ;2/1/95 09:46 ;
- ;;5.5;DIETETICS;;Jan 28, 2005;
- ; ALL=0 - only inpatients
- F1 R !!,"Select Patient (Name or SSN): ",X:DTIME G NOP:'$T!(U[X)!(X="*")
- K DIC S DIC="^DPT(",DIC(0)="EQZM" S:'ALL DIC("S")="I $D(^DPT(Y,.1))" D ^DIC K DIC G NOP:U[X,F1:X["?" I Y<1 W !,$S('ALL:"Inp",1:"P"),"atient Not Selected" G F1
- ENOM ;OUTPATIENT MEALS (^FHOMDPA) ENTRY POINT
- S (DA,DFN)=+Y,FHWF=$S($D(^ORD(101)):1,1:0),FHPV=DUZ
- S FHZ115="P"_DFN D ADD^FHOMDPA I FHDFN="" Q
- F2 S WARD=$G(^DPT(DFN,.1)) D PID
- I WARD="" Q:ALL W *7,!!,"NOT CURRENTLY AN INPATIENT!",! G NOP
- S ADM=$G(^DPT("CN",WARD,DFN)) G:ADM<1 NOP
- Q:$D(^FHPT(FHDFN,"A",ADM,0)) G:'$D(^DGPM(ADM,0)) NOP
- D ^FHWADM S FHPV=DUZ Q
- NOP S (DFN,DFNF2,FHDFN)=0,Y=-1 Q
- PID ; Get patient variables
- D PID^VADPT6 S PID=$G(VA("PID")),BID=$G(VA("BID")) K VA Q
- DID ; Get dietetic ward
- S (FHWRD,FHRMB)="" S WARD=$G(^DPT(DFN,.1)) Q:WARD="" S FHRMB=$G(^DPT(DFN,.108))
- I FHRMB S FHWRD=$O(^FH(119.6,"AR",+FHRMB,0)) Q:FHWRD
- N W1 S W1=$O(^DIC(42,"B",WARD,0)) Q:W1="" S FHWRD=$O(^FH(119.6,"AW",W1,0)) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHDPA 1086 printed Jan 18, 2025@02:48:51 Page 2
- FHDPA ; HISC/REL - Patient Look-Up ;2/1/95 09:46 ;
- +1 ;;5.5;DIETETICS;;Jan 28, 2005;
- +2 ; ALL=0 - only inpatients
- F1 READ !!,"Select Patient (Name or SSN): ",X:DTIME
- if '$TEST!(U[X)!(X="*")
- GOTO NOP
- +1 KILL DIC
- SET DIC="^DPT("
- SET DIC(0)="EQZM"
- if 'ALL
- SET DIC("S")="I $D(^DPT(Y,.1))"
- DO ^DIC
- KILL DIC
- if U[X
- GOTO NOP
- if X["?"
- GOTO F1
- IF Y<1
- WRITE !,$SELECT('ALL:"Inp",1:"P"),"atient Not Selected"
- GOTO F1
- ENOM ;OUTPATIENT MEALS (^FHOMDPA) ENTRY POINT
- +1 SET (DA,DFN)=+Y
- SET FHWF=$SELECT($DATA(^ORD(101)):1,1:0)
- SET FHPV=DUZ
- +2 SET FHZ115="P"_DFN
- DO ADD^FHOMDPA
- IF FHDFN=""
- QUIT
- F2 SET WARD=$GET(^DPT(DFN,.1))
- DO PID
- +1 IF WARD=""
- if ALL
- QUIT
- WRITE *7,!!,"NOT CURRENTLY AN INPATIENT!",!
- GOTO NOP
- +2 SET ADM=$GET(^DPT("CN",WARD,DFN))
- if ADM<1
- GOTO NOP
- +3 if $DATA(^FHPT(FHDFN,"A",ADM,0))
- QUIT
- if '$DATA(^DGPM(ADM,0))
- GOTO NOP
- +4 DO ^FHWADM
- SET FHPV=DUZ
- QUIT
- NOP SET (DFN,DFNF2,FHDFN)=0
- SET Y=-1
- QUIT
- PID ; Get patient variables
- +1 DO PID^VADPT6
- SET PID=$GET(VA("PID"))
- SET BID=$GET(VA("BID"))
- KILL VA
- QUIT
- DID ; Get dietetic ward
- +1 SET (FHWRD,FHRMB)=""
- SET WARD=$GET(^DPT(DFN,.1))
- if WARD=""
- QUIT
- SET FHRMB=$GET(^DPT(DFN,.108))
- +2 IF FHRMB
- SET FHWRD=$ORDER(^FH(119.6,"AR",+FHRMB,0))
- if FHWRD
- QUIT
- +3 NEW W1
- SET W1=$ORDER(^DIC(42,"B",WARD,0))
- if W1=""
- QUIT
- SET FHWRD=$ORDER(^FH(119.6,"AW",W1,0))
- QUIT