source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHNO8.m@ 1582

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1FHNO8 ; HISC/REL - History of Supp. Fdgs. ;5/17/93 14:24
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3 ;patch #5 - add outpatient SFs,
4 ;
5SF K FHDFN,X,WARD,SDT,EDT,STDT,ENDT
6 S ADM="",FHALL=1 D ^FHOMDPA
7 G:'FHDFN KIL
8 I $O(^FHPT(FHDFN,"A",0))<1 W !!,"NO ADMISSIONS ON FILE!" G OSF
9 S DIC="^FHPT(FHDFN,""A"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
10 S WARD="" I $G(DFN)'="" S WARD=$G(^DPT(DFN,.1))
11 K ADM
12SF0 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
13 I (X="")&'($D(^FHPT(FHDFN,"OP"))) W !!,"NO OUTPATIENT DATA ON FILE!" G SF
14 I (X="")&($D(^FHPT(FHDFN,"OP"))) G OSF
15 I WARD'="",X="C" S ADM=$G(^DPT("CN",WARD,DFN)) G CAD:ADM
16 S DIC="^FHPT(FHDFN,""A"",",DIC(0)="EQM" D ^DIC G:Y<1 SF0 S ADM=+Y
17CAD I $G(ADM),$G(^FHPT(FHDFN,"A",ADM,0)) G IN
18 ;
19SF1 I '($D(^FHPT(FHDFN,"OP"))) W !!,"NO OUTPATIENT DATA ON FILE!" G SF
20 W !!,"Enter the Start Date and End Date for outpatient data.",!
21 D STDATE^FHOMUTL S SDT=STDT I STDT="" Q
22 S X="T+30" D ^%DT S ENDT=Y
23 D DD^%DT S FHDTDF=Y K DIR
24 S DIR("A")="Select End Date: ",DIR("B")=FHDTDF,DIR(0)="DAO^"_STDT
25 D ^DIR
26 Q:$D(DIRUT) S ENDT=Y S Y=ENDT D DD^%DT W " ",Y
27 D ADM
28 Q
29OSF ;process outpatient SFs.
30 ;
31 S FHSFLG=0
32 S FHSOOP=$O(^FHPT(FHDFN,"OP","B",DT-30))
33 I '$D(^FHPT(FHDFN,"OP"))!'$G(FHSOOP) G FHNO8
34 ;W !!,"Outpatient Recurring Meals... "
35 D ASK0
36 G:'$G(ADM) SF
37 S (N1,LST)=0
38 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
39 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
40 I $G(ADM),$G(N1) G OSF0
41 G OSF
42OSF0 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
43 S NO=+X,Y=$G(^FHPT(FHDFN,"OP",ADM,"SF",NO,0)) D:Y'="" L1^FHNO7
44 G SF
45 Q
46ASK0 ;ask for Recurring Meal entry.
47 K ADM
48 W @IOF,!,"Outpatient Recurring Meals... "
49 S FHQ=0,FHSDT=DT-60
50 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
51 .S FHDA15=$G(^FHPT(FHDFN,"OP",FHJ,0))
52 .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
53 .S Y=$P(FHDA15,U,1) X ^DD("DD") S DTP=Y
54 .S (FHCOFLG,FHDATL,FHSF)=0
55 .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
56 .W !,DTP,?12,FH11
57 .S FHDATL=$L(DTP)+13+$L(FH11)
58 .S:$D(^FHPT(FHDFN,"OP",FHJ,"SF",0)) FHSF=$P(^FHPT(FHDFN,"OP",FHJ,"SF",0),U,3)
59 .Q:'$G(FHSF)
60 .S FHDA15SF=$G(^FHPT(FHDFN,"OP",FHJ,"SF",FHSF,0))
61 .Q:$P(FHDA15SF,U,32)
62 .S FHDASFNM=$P($G(^FH(118.1,$P(FHDA15SF,U,4),0)),U,1)
63 .W ?40," (",FHDASFNM,")"
64 W !
65 K DIC S DIC(0)="AEQM"
66 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"")"
67 S DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-60)"
68 S DIC="^FHPT(FHDFN,""OP"","
69 S DIC("?")="Select a Date, '^' to exit"
70 S DIC("A")="Select the Outpatient Date :" D ^DIC K DIC Q:(Y'>0)!$D(DTOUT)
71 S ADM=+Y
72 S FHMEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) ;outpatient standing orders.
73 Q
74 ;
75 S ALL=1 D ^FHDPA G:'DFN KIL G:'FHDFN KIL
76 I $O(^FHPT(FHDFN,"A",0))<1 W !!,"NO ADMISSIONS ON FILE!" G FHNO8
77 S DIC="^FHPT(FHDFN,""A"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
78A0 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
79 ;
80IN ;D ADM G SF0:ADM'>0
81 ;
82P0 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
83 I 'N1 W !!,"No Supplemental Feedings for this Admission!" G FHNO8
84P1 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
85 S NO=+X,Y=$G(^FHPT(FHDFN,"A",ADM,"SF",NO,0)) D L1^FHNO7
86 G SF
87ADM ;S WARD=$G(^DPT(DFN,.1))
88 ;I WARD="" W *7,!!,"NOT CURRENTLY AN INPATIENT!",! S ADM="" Q
89 ;S ADM=$G(^DPT("CN",WARD,DFN)) Q
90 ;
91LIS I 'N1 W !!,"Ord Date/Time Ordered Supplemental Feeding Menu Date/Time Cancelled",!
92 S N1=N1+1,D1=$P(X,"^",2),NM=$P(X,"^",4),D2=$P(X,"^",32)
93 S DTP=D1 D DTP^FH W !,$J(K,3)," ",DTP
94 S X=$P($G(^FH(118.1,+NM,0)),"^",1) W:X'="" ?24,X
95 I D2 S DTP=D2 D DTP^FH W ?54,DTP
96 Q
97KIL G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.