close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/DIETETICS-FH/FHORX1A.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHORX1A.m@ 789

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
1FHORX1A ; HISC/REL/NCA/RVD - Diet Activity Report (cont) ;3/17/95 10:06
2 ;;5.5;DIETETICS;**1,5,8**;Jan 28, 2005;Build 28
3 ;
4 ;process inpatient data.
5 S PG=0 S FHPIO="** INPATIENT **" D HDR
6 S P0="",NN=0 F S P0=$O(^TMP($J,"I",P0)) Q:P0="" D LST
7 ;
8 ;process outpatient data.
9 S FHPIO="** OUTPATIENT **" D HDR
10 S (FHUSERNM,P0)="",(FHNMSV,NN)=0 F S P0=$O(^TMP($J,"O",P0)) Q:P0="" S (FHBRK,FHNON,FHEVE)=0 D LST1
11 S:$G(FHP) $P(^FH(119.73,FHP,0),"^",2)=NOW
12 I '$G(FHP) F FHII=0:0 S FHII=$O(^FH(119.73,FHII)) Q:FHII'>0 S $P(^FH(119.73,FHII,0),"^",2)=NOW
13 Q
14 ;
15LST K PP S NP=0 F DA=0:0 S DA=$O(^TMP($J,"I",P0,DA)) Q:DA<1 S Z=^(DA) D L1
16 D L2 Q
17 ;
18LST1 K PP S NP=0 F DA=0:0 S DA=$O(^TMP($J,"O",P0,DA)) Q:DA'>0 D T1
19 Q
20 ;
21L1 ; Process event
22 S ADM=$P(Z,"^",1),TYP=$P(Z,"^",2),ACT=$P(Z,"^",3),FHORD=$P(Z,"^",4),TXT=$P(Z,"^",5),CLK=$P(Z,"^",6)
23 I 'FHORD S NN=NN+1,FHORD=NN
24 I "DIT"[TYP D
25 .I TYP="D",FHORD=1 S NP=1
26 .I $D(PP(TYP,ADM_"~"_FHORD)),ACT="C" K PP(TYP,ADM_"~"_FHORD) Q
27 .K PP(TYP) S PP(TYP,ADM_"~"_FHORD)=ACT_"^"_TXT_"^"_CLK Q
28 I "OPSF"[TYP D
29 .I $D(PP(TYP,ADM_"~"_FHORD)),ACT="C" K PP(TYP,ADM_"~"_FHORD) Q
30 .S PP(TYP,ADM_"~"_FHORD)=ACT_"^"_TXT_"^"_CLK Q
31 I "LM"[TYP S PP(TYP,ADM_"~"_FHORD)=ACT_"^"_TXT_"^"_CLK
32 Q
33 ;
34L2 S W1=$P(P0,"~",2),R1=$P(P0,"~",4),FHDFN=$P(P0,"~",5)
35 D PATNAME^FHOMUTL Q:'$G(DFN)
36 S Y0=$G(^DPT(DFN,0))
37 S N1=$P(Y0,"^",1)
38 ;D PID^FHDPA
39 S TC=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",5),SF=$P($G(^(0)),"^",7),SO=$D(^FHPT("ASP",FHDFN,ADM))
40 D:$Y>(IOSL-6) HDR W !!,$E(W1_" "_R1,1,20),?22,N1,?50,BID,?63,$S(SF:"SF",1:""),?66,$S(SO:"SO",1:""),?73,TC
41 D ALG^FHCLN W !,"Allergies: ",$S(ALG="":"None on file",1:ALG),!
42 D ^FHORX1C D:NP NEWP Q
43 ;
44T1 ; Process outpatient event
45 S FHTDAT=$G(^TMP($J,"O",P0,DA)),DFN=$P(P0,"~",4)
46 S FHACTI=$P(FHTDAT,"^",1)
47 S DTP=$P(FHTDAT,"^",2)
48 S BID=$P(FHTDAT,"^",3)
49 S FHDESC=$P(FHTDAT,"^",4)
50 S FHTC=$P(FHTDAT,"^",5)
51 ;I FHBRK=1,(FHDESC["Recurring Meal cancelled"),(FHDESC["Break") Q
52 ;I FHNON=1,(FHDESC["Recurring Meal cancelled"),(FHDESC["Noon") Q
53 ;I FHEVE=1,(FHDESC["Recurring Meal cancelled"),(FHDESC["Eve") Q
54 ;I (FHDESC["Recurring Meal cancelled"),(FHDESC["Break") S FHBRK=1
55 ;I (FHDESC["Recurring Meal cancelled"),(FHDESC["Noon") S FHNON=1
56 ;I (FHDESC["Recurring Meal cancelled"),(FHDESC["Eve") S FHEVE=1
57 S FHDES1=$P(FHDESC,",",1)
58 S FHDIET=$P(FHDES1,":",2),FHDIET=$E(FHDIET,2,$L(FHDIET))
59 I FHDIET'="",$D(^FH(111,"B",FHDIET)) S FHDIDA=$O(^FH(111,"B",FHDIET,0))
60 I $G(FHDIDA),$D(^FH(111,FHDIDA,0)) S FHDIET=$P(^FH(111,FHDIDA,0),U,7)
61 S:FHDIET="" FHDIET="NO ORDER"
62 S Y=FHDIET
63 S W1=$P(P0,"~",2),R1=$P(P0,"~",4),(N1,FHDPTN)=$P(P0,"~",5)
64 ;T2
65 I $D(^FH(119.8,DA,0)) S FHUSER=$P(^(0),U,9) S:$G(FHUSER) FHUSERN=$P(^VA(200,FHUSER,0),U,1)
66 ;S EVT=FHDESC_" by "_FHUSERN
67 I FHDESC["Standing" S FHSO1=$P(FHDESC,":",1),FHDESC="Outpatient SO"_$E(FHDESC,$L(FHSO1)+1,$L(FHDESC))
68 I FHDESC["Supplemental" S FHSF1=$P(FHDESC,":",1),FHDESC="Outpatient SF"_$E(FHDESC,$L(FHSF1)+1,$L(FHDESC))
69 S EVT=FHDESC
70 I $Y>(IOSL-6) D HDR
71 I (FHNMSV=0)!(FHNMSV'=P0) W !!,$E(W1,1,20),?22,FHDPTN,?50,BID,?73,FHTC D ALG^FHCLN W !,"Allergies: ",$S(ALG="":"None on file",1:ALG),!
72 S FHNMSV=P0
73 D LNE
74 Q
75 ;
76HDR ;W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !?20,"D I E T A C T I V I T Y R E P O R T",?72,"Page ",PG
77 W @IOF S PG=PG+1 W !?20,"D I E T A C T I V I T Y R E P O R T",?72,"Page ",PG
78 W !!?(80-$L(H1)\2),H1
79 W !,?30,FHPIO
80 W !!,"Location",?22,"Patient",?50,"ID#",?62,"Sup/Std Service"
81 Q
82 ;
83NEWP K ALG I $G(DFN) D ALG^FHCLN I ALG'="" S EVT="Allergies: "_ALG,TYP="A" D LNE^FHORX1C
84 Q:'$D(^FHPT(FHDFN,"P"))
85 S X1="Pref:" F K=0:0 S K=$O(^FHPT(FHDFN,"P",K)) Q:K<1 S X=^(K,0) D N1
86 W:$L(X1)>6 !?12,X1 Q
87 ;
88N1 S Y=$G(^FH(115.2,+X,0)) Q:$P(Y,"^",2)'="D"
89 S Y=" "_$P(Y,"^",1)_" ("_$P(X,"^",2)_")"_$S($P(X,"^",4)="Y":" (D)",1:"") I $L(X1)+$L(Y)>48 W !?12,X1 S X1="Pref:"
90 S X1=X1_Y Q
91 ;
92LNE ; Break line if longer than 58 chars
93 I $Y>(IOSL-6) D HDR^FHORX1A W !
94 I $L(EVT)<59 G EX
95 F KK=59:-1:4 Q:$E(EVT,KK)?1P
96 I KK=4 S KK=45 W !?5,$E(EVT,1,58)
97 E W !?5,$E(EVT,1,KK-1)
98 S EVT=" "_$E(EVT,KK+1,999) G LNE
99EX W !?5,EVT Q
Note: See TracBrowser for help on using the repository browser.