source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURCES4.m@ 1195

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

initial load of WorldVistAEHR
File size: 2.4 KB
RevLine 
[613]1NURCES4 ;HIRMFO/YH-END OF SHIFT - DIET ;12/12/96
2 ;;4.0;NURSING SERVICE;**16,18,28,29**;Apr 25, 1997
3DIET ;CALL ^FHWHEA FOR DIET INFORMATION
4 D 1^VADPT D NOW^%DTC S GMTS1=9999999-%,GMTS2=9999999-$P(VAIN(7),"^"),GMTSNDM=1 D ^FHWHEA S NDIET="Diet: " G:'$D(^UTILITY($J)) Q
5 K NURFH I $D(^UTILITY($J,"DI")) S NURFHDT=$O(^UTILITY($J,"DI",0)) I '$P(^UTILITY($J,"DI",NURFHDT,0),U,2) S:NURFHDT>0 NURFH(NURFHDT)="DI^"_^UTILITY($J,"DI",NURFHDT,0)
6 I $D(^UTILITY($J,"TF")) S NURFHDT=$O(^UTILITY($J,"TF",0)) I '$P(^UTILITY($J,"TF",NURFHDT,0),U,2) S:NURFHDT>0 NURFH(NURFHDT)="TF^"_^UTILITY($J,"TF",NURFHDT,0)
7 G:'$D(NURFH) Q S NURFHDT=$O(NURFH(0)) Q:NURFHDT'>0 S FHDATA=NURFH(NURFHDT) D
8 .I $P(FHDATA,"^")="DI" S NDIET=NDIET_$S($P(FHDATA,"^",4)'="":$P(FHDATA,"^",4),1:"")_$S($P(FHDATA,"^",6)'="":$S($P(FHDATA,"^",4)'="":", ",1:"")_$P(FHDATA,"^",6),1:"")_$S($P(FHDATA,"^",5)'="":$S($L(NDIET>8):", ",1:"")_$P(FHDATA,"^",5),1:"") Q
9 .I $P(FHDATA,"^")="TF" D
10 ..S NDIET="Tube feeding: "_$S($P(FHDATA,"^",4)'="":$P(FHDATA,"^",4),1:"")_$S($P(FHDATA,"^",5)'="":$S($P(FHDATA,"^",4)'="":", ",1:"")_$P(FHDATA,"^",5)_" strength",1:"")
11 ..S NDIET=NDIET_$S($P(FHDATA,"^",6)'="":$S($L(NDIET)>16:", ",1:"")_$P(FHDATA,"^",6),1:"") Q
12 .Q
13Q K ^UTILITY($J),FHY,FHDATA,NURFH,GMTS1,GMTS2,GMTSNDM,NURFHDT Q
14ALLERGY K NURSAL D ALLERGY^NURCUT1(DFN,.NURSAL) I $O(NURSAL(0))'>0,$G(NURSAL)="" G QA
15 S (NADV,NALLG)="",(NIX,NIY)=1,NII=0 F S NII=$O(NURSAL(NII)) Q:NII'>0 D
16 .I NURSAL(NII)["allergy" D
17 ..I '($L(NALLG)>230) S:NALLG'="" NALLG=NALLG_", " S NALLG=NALLG_$P(NURSAL(NII)," ("),^TMP($J,"ALRGY",NIX)=NALLG
18 ..E S NALLG="",NIX=NIX+1 S:NALLG'="" NALLG=NALLG_", " S NALLG=NALLG_$P(NURSAL(NII)," ("),^TMP($J,"ALRGY",NIX)=NALLG
19 ..Q
20 .I NURSAL(NII)'["allergy" D
21 ..I '($L(NADV)>230) S:NADV'="" NADV=NADV_", " S NADV=NADV_$P(NURSAL(NII)," ("),^TMP($J,"ADVRXN",NIY)=NADV
22 ..E S NADV="",NIY=NIY+1 S:NADV'="" NADV=NADV_", " S NADV=NADV_$P(NURSAL(NII)," ("),^TMP($J,"ADVRXN",NIY)=NADV
23 ..Q
24 .Q
25 S NIX=0
26 I $O(^TMP($J,"ALRGY",NIX)) F S NIX=$O(^TMP($J,"ALRGY",NIX)) Q:NIX'>0 S NALLG=$G(^TMP($J,"ALRGY",NIX)) D
27 . I NIX=1 S NURSAL="Allergy: "_NALLG
28 . E S NURSAL=NALLG
29 . D FITLINE^NURCES5(NURSAL,25,.NPT)
30 . Q
31 E S NURSAL="Allergy: NKA" D FITLINE^NURCES5(NURSAL,25,.NPT)
32 S NIY=0 F S NIY=$O(^TMP($J,"ADVRXN",NIY)) Q:NIY'>0 S NADV=$G(^TMP($J,"ADVRXN",NIY)) D
33 . I NIY=1 S NURSAL="Adv rxn: "_NADV
34 . E S NURSAL=NADV
35 . D FITLINE^NURCES5(NURSAL,25,.NPT)
36 . Q
37QA K ^TMP($J,"ALRGY"),^TMP($J,"ADVRXN"),NADV,NALLG,NII,I,NURSAL,GMRANKA,NIX,NIY
38 Q
Note: See TracBrowser for help on using the repository browser.