NURCES4 ;HIRMFO/YH-END OF SHIFT - DIET ;12/12/96
 ;;4.0;NURSING SERVICE;**16,18,28,29**;Apr 25, 1997
DIET ;CALL ^FHWHEA FOR DIET INFORMATION
 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
 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)
 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)
 G:'$D(NURFH) Q S NURFHDT=$O(NURFH(0)) Q:NURFHDT'>0  S FHDATA=NURFH(NURFHDT) D
 .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
 .I $P(FHDATA,"^")="TF" D
 ..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:"")
 ..S NDIET=NDIET_$S($P(FHDATA,"^",6)'="":$S($L(NDIET)>16:", ",1:"")_$P(FHDATA,"^",6),1:"") Q
 .Q
Q K ^UTILITY($J),FHY,FHDATA,NURFH,GMTS1,GMTS2,GMTSNDM,NURFHDT Q
ALLERGY K NURSAL D ALLERGY^NURCUT1(DFN,.NURSAL) I $O(NURSAL(0))'>0,$G(NURSAL)="" G QA
 S (NADV,NALLG)="",(NIX,NIY)=1,NII=0 F  S NII=$O(NURSAL(NII)) Q:NII'>0  D
 .I NURSAL(NII)["allergy" D
 ..I '($L(NALLG)>230) S:NALLG'="" NALLG=NALLG_", " S NALLG=NALLG_$P(NURSAL(NII)," ("),^TMP($J,"ALRGY",NIX)=NALLG
 ..E  S NALLG="",NIX=NIX+1 S:NALLG'="" NALLG=NALLG_", " S NALLG=NALLG_$P(NURSAL(NII)," ("),^TMP($J,"ALRGY",NIX)=NALLG
 ..Q
 .I NURSAL(NII)'["allergy" D
 ..I '($L(NADV)>230) S:NADV'="" NADV=NADV_", " S NADV=NADV_$P(NURSAL(NII)," ("),^TMP($J,"ADVRXN",NIY)=NADV
 ..E  S NADV="",NIY=NIY+1 S:NADV'="" NADV=NADV_", " S NADV=NADV_$P(NURSAL(NII)," ("),^TMP($J,"ADVRXN",NIY)=NADV
 ..Q
 .Q
 S NIX=0
 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
 . I NIX=1 S NURSAL="Allergy: "_NALLG
 . E  S NURSAL=NALLG
 . D FITLINE^NURCES5(NURSAL,25,.NPT)
 . Q
 E  S NURSAL="Allergy: NKA" D FITLINE^NURCES5(NURSAL,25,.NPT)
 S NIY=0 F  S NIY=$O(^TMP($J,"ADVRXN",NIY)) Q:NIY'>0  S NADV=$G(^TMP($J,"ADVRXN",NIY)) D
 . I NIY=1 S NURSAL="Adv rxn: "_NADV
 . E  S NURSAL=NADV
 . D FITLINE^NURCES5(NURSAL,25,.NPT)
 . Q
QA K ^TMP($J,"ALRGY"),^TMP($J,"ADVRXN"),NADV,NALLG,NII,I,NURSAL,GMRANKA,NIX,NIY
 Q