FHDPA.m

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 ---FHDPA   1086     printed  Apr 09, 2024@20:53:11                                                                                                                                                                                                       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