98 lines
4.4 KiB
Mathematica
98 lines
4.4 KiB
Mathematica
|
FHNO8 ; HISC/REL - History of Supp. Fdgs. ;5/17/93 14:24
|
||
|
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
|
||
|
;patch #5 - add outpatient SFs,
|
||
|
;
|
||
|
SF K FHDFN,X,WARD,SDT,EDT,STDT,ENDT
|
||
|
S ADM="",FHALL=1 D ^FHOMDPA
|
||
|
G:'FHDFN KIL
|
||
|
I $O(^FHPT(FHDFN,"A",0))<1 W !!,"NO ADMISSIONS ON FILE!" G OSF
|
||
|
S DIC="^FHPT(FHDFN,""A"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
|
||
|
S WARD="" I $G(DFN)'="" S WARD=$G(^DPT(DFN,.1))
|
||
|
K ADM
|
||
|
SF0 W !!,"Select ADMISSION or RETURN for OUTPATIENT ",$S(WARD'="":" (or C for CURRENT)",1:""),": " R X:DTIME G:X["^" KIL D:X="c" TR^FH
|
||
|
I (X="")&'($D(^FHPT(FHDFN,"OP"))) W !!,"NO OUTPATIENT DATA ON FILE!" G SF
|
||
|
I (X="")&($D(^FHPT(FHDFN,"OP"))) G OSF
|
||
|
I WARD'="",X="C" S ADM=$G(^DPT("CN",WARD,DFN)) G CAD:ADM
|
||
|
S DIC="^FHPT(FHDFN,""A"",",DIC(0)="EQM" D ^DIC G:Y<1 SF0 S ADM=+Y
|
||
|
CAD I $G(ADM),$G(^FHPT(FHDFN,"A",ADM,0)) G IN
|
||
|
;
|
||
|
SF1 I '($D(^FHPT(FHDFN,"OP"))) W !!,"NO OUTPATIENT DATA ON FILE!" G SF
|
||
|
W !!,"Enter the Start Date and End Date for outpatient data.",!
|
||
|
D STDATE^FHOMUTL S SDT=STDT I STDT="" Q
|
||
|
S X="T+30" D ^%DT S ENDT=Y
|
||
|
D DD^%DT S FHDTDF=Y K DIR
|
||
|
S DIR("A")="Select End Date: ",DIR("B")=FHDTDF,DIR(0)="DAO^"_STDT
|
||
|
D ^DIR
|
||
|
Q:$D(DIRUT) S ENDT=Y S Y=ENDT D DD^%DT W " ",Y
|
||
|
D ADM
|
||
|
Q
|
||
|
OSF ;process outpatient SFs.
|
||
|
;
|
||
|
S FHSFLG=0
|
||
|
S FHSOOP=$O(^FHPT(FHDFN,"OP","B",DT-30))
|
||
|
I '$D(^FHPT(FHDFN,"OP"))!'$G(FHSOOP) G FHNO8
|
||
|
;W !!,"Outpatient Recurring Meals... "
|
||
|
D ASK0
|
||
|
G:'$G(ADM) SF
|
||
|
S (N1,LST)=0
|
||
|
I $G(ADM) F K=0:0 S K=$O(^FHPT(FHDFN,"OP",ADM,"SF",K)) Q:K<1 S X=^(K,0),LST=K D LIS
|
||
|
I $G(ADM),'N1 W !!,"No Supplemental Feedings for this outpatient date!",! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Exit" D ^DIR Q:'Y G OSF
|
||
|
I $G(ADM),$G(N1) G OSF0
|
||
|
G OSF
|
||
|
OSF0 R !!,"Detailed Display of which Order #? ",X:DTIME G:'$T!("^"[X) FHNO8 I X'?1N.N!(X<1)!(X>LST) W *7," Enter # of Order to List" G OSF0
|
||
|
S NO=+X,Y=$G(^FHPT(FHDFN,"OP",ADM,"SF",NO,0)) D:Y'="" L1^FHNO7
|
||
|
G SF
|
||
|
Q
|
||
|
ASK0 ;ask for Recurring Meal entry.
|
||
|
K ADM
|
||
|
W @IOF,!,"Outpatient Recurring Meals... "
|
||
|
S FHQ=0,FHSDT=DT-60
|
||
|
F FHI=FHSDT-1:0 S FHI=$O(^FHPT("RM",FHI)) Q:FHI'>0!FHQ F FHJ=0:0 S FHJ=$O(^FHPT("RM",FHI,FHDFN,FHJ)) Q:FHJ'>0!FHQ I ($P($G(^FHPT(FHDFN,"OP",FHJ,0)),U,15)'="C") D
|
||
|
.S FHDA15=$G(^FHPT(FHDFN,"OP",FHJ,0))
|
||
|
.S FHMEAL=$P(FHDA15,U,4),FHLOC=$P(FHDA15,U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL="B":"Break",FHMEAL="N":"Noon",1:"Even"),FH11=FHMEAL_" "_FHLOCN
|
||
|
.S Y=$P(FHDA15,U,1) X ^DD("DD") S DTP=Y
|
||
|
.S (FHCOFLG,FHDATL,FHSF)=0
|
||
|
.I $Y>(IOSL-5) K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Quit Listing" D ^DIR W:Y @IOF I 'Y S FHQ=1 Q
|
||
|
.W !,DTP,?12,FH11
|
||
|
.S FHDATL=$L(DTP)+13+$L(FH11)
|
||
|
.S:$D(^FHPT(FHDFN,"OP",FHJ,"SF",0)) FHSF=$P(^FHPT(FHDFN,"OP",FHJ,"SF",0),U,3)
|
||
|
.Q:'$G(FHSF)
|
||
|
.S FHDA15SF=$G(^FHPT(FHDFN,"OP",FHJ,"SF",FHSF,0))
|
||
|
.Q:$P(FHDA15SF,U,32)
|
||
|
.S FHDASFNM=$P($G(^FH(118.1,$P(FHDA15SF,U,4),0)),U,1)
|
||
|
.W ?40," (",FHDASFNM,")"
|
||
|
W !
|
||
|
K DIC S DIC(0)="AEQM"
|
||
|
S DIC("W")="S FHMEAL=$P(^(0),U,4),FHLOC=$P(^(0),U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL=""B"":""Break"",FHMEAL=""N"":""Noon"",1:""Even""),FH11=FHMEAL_"" ""_FHLOCN D EN^DDIOL(FH11,"""",""?3"")"
|
||
|
S DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-60)"
|
||
|
S DIC="^FHPT(FHDFN,""OP"","
|
||
|
S DIC("?")="Select a Date, '^' to exit"
|
||
|
S DIC("A")="Select the Outpatient Date :" D ^DIC K DIC Q:(Y'>0)!$D(DTOUT)
|
||
|
S ADM=+Y
|
||
|
S FHMEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) ;outpatient standing orders.
|
||
|
Q
|
||
|
;
|
||
|
S ALL=1 D ^FHDPA G:'DFN KIL G:'FHDFN KIL
|
||
|
I $O(^FHPT(FHDFN,"A",0))<1 W !!,"NO ADMISSIONS ON FILE!" G FHNO8
|
||
|
S DIC="^FHPT(FHDFN,""A"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
|
||
|
A0 W !!,"Select ADMISSION",$S($D(^DPT(DFN,.1)):" (or C for CURRENT)",1:""),": " R X:DTIME G:'$T!("^"[X) KIL D:X="c" TR^FH
|
||
|
;
|
||
|
IN ;D ADM G SF0:ADM'>0
|
||
|
;
|
||
|
P0 S (N1,LST)=0 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SF",K)) Q:K<1 S X=^(K,0),LST=K D LIS
|
||
|
I 'N1 W !!,"No Supplemental Feedings for this Admission!" G FHNO8
|
||
|
P1 R !!,"Detailed Display of which Order #? ",X:DTIME G:'$T!("^"[X) FHNO8 I X'?1N.N!(X<1)!(X>LST) W *7," Enter # of Order to List" G P1
|
||
|
S NO=+X,Y=$G(^FHPT(FHDFN,"A",ADM,"SF",NO,0)) D L1^FHNO7
|
||
|
G SF
|
||
|
ADM ;S WARD=$G(^DPT(DFN,.1))
|
||
|
;I WARD="" W *7,!!,"NOT CURRENTLY AN INPATIENT!",! S ADM="" Q
|
||
|
;S ADM=$G(^DPT("CN",WARD,DFN)) Q
|
||
|
;
|
||
|
LIS I 'N1 W !!,"Ord Date/Time Ordered Supplemental Feeding Menu Date/Time Cancelled",!
|
||
|
S N1=N1+1,D1=$P(X,"^",2),NM=$P(X,"^",4),D2=$P(X,"^",32)
|
||
|
S DTP=D1 D DTP^FH W !,$J(K,3)," ",DTP
|
||
|
S X=$P($G(^FH(118.1,+NM,0)),"^",1) W:X'="" ?24,X
|
||
|
I D2 S DTP=D2 D DTP^FH W ?54,DTP
|
||
|
Q
|
||
|
KIL G KILL^XUSCLEAN
|