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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCES4 2542 printed Apr 09, 2024@21:24:08 Page 2
NURCES4 ;HIRMFO/YH-END OF SHIFT - DIET ;12/12/96
+1 ;;4.0;NURSING SERVICE;**16,18,28,29**;Apr 25, 1997
DIET ;CALL ^FHWHEA FOR DIET INFORMATION
+1 DO 1^VADPT
DO NOW^%DTC
SET GMTS1=9999999-%
SET GMTS2=9999999-$PIECE(VAIN(7),"^")
SET GMTSNDM=1
DO ^FHWHEA
SET NDIET="Diet: "
if '$DATA(^UTILITY($JOB))
GOTO Q
+2 KILL NURFH
IF $DATA(^UTILITY($JOB,"DI"))
SET NURFHDT=$ORDER(^UTILITY($JOB,"DI",0))
IF '$PIECE(^UTILITY($JOB,"DI",NURFHDT,0),U,2)
if NURFHDT>0
SET NURFH(NURFHDT)="DI^"_^UTILITY($JOB,"DI",NURFHDT,0)
+3 IF $DATA(^UTILITY($JOB,"TF"))
SET NURFHDT=$ORDER(^UTILITY($JOB,"TF",0))
IF '$PIECE(^UTILITY($JOB,"TF",NURFHDT,0),U,2)
if NURFHDT>0
SET NURFH(NURFHDT)="TF^"_^UTILITY($JOB,"TF",NURFHDT,0)
+4 if '$DATA(NURFH)
GOTO Q
SET NURFHDT=$ORDER(NURFH(0))
if NURFHDT'>0
QUIT
SET FHDATA=NURFH(NURFHDT)
Begin DoDot:1
+5 IF $PIECE(FHDATA,"^")="DI"
SET NDIET=NDIET_$SELECT($PIECE(FHDATA,"^",4)'="":$PIECE(FHDATA,"^",4),1:"")_$SELECT($PIECE(FHDATA,"^",6)'="":$SELECT($PIECE(FHDATA,"^",4)'="":", ",1:"")_$PIECE(FHDATA,"^",6),1:"")_...
... $SELECT($PIECE(FHDATA,"^",5)'="":$SELECT($LENGTH(NDIET>8):", ",1:"")_$PIECE(FHDATA,"^",5),1:"")
QUIT
+6 IF $PIECE(FHDATA,"^")="TF"
Begin DoDot:2
+7 SET NDIET="Tube feeding: "_$SELECT($PIECE(FHDATA,"^",4)'="":$PIECE(FHDATA,"^",4),1:"")_$SELECT($PIECE(FHDATA,"^",5)'="":$SELECT($PIECE(FHDATA,"^",4)'="":", ",1:"")_$PIECE(FHDATA,"^",5)_" strength",1:"")
+8 SET NDIET=NDIET_$SELECT($PIECE(FHDATA,"^",6)'="":$SELECT($LENGTH(NDIET)>16:", ",1:"")_$PIECE(FHDATA,"^",6),1:"")
QUIT
End DoDot:2
+9 QUIT
End DoDot:1
Q KILL ^UTILITY($JOB),FHY,FHDATA,NURFH,GMTS1,GMTS2,GMTSNDM,NURFHDT
QUIT
ALLERGY KILL NURSAL
DO ALLERGY^NURCUT1(DFN,.NURSAL)
IF $ORDER(NURSAL(0))'>0
IF $GET(NURSAL)=""
GOTO QA
+1 SET (NADV,NALLG)=""
SET (NIX,NIY)=1
SET NII=0
FOR
SET NII=$ORDER(NURSAL(NII))
if NII'>0
QUIT
Begin DoDot:1
+2 IF NURSAL(NII)["allergy"
Begin DoDot:2
+3 IF '($LENGTH(NALLG)>230)
if NALLG'=""
SET NALLG=NALLG_", "
SET NALLG=NALLG_$PIECE(NURSAL(NII)," (")
SET ^TMP($JOB,"ALRGY",NIX)=NALLG
+4 IF '$TEST
SET NALLG=""
SET NIX=NIX+1
if NALLG'=""
SET NALLG=NALLG_", "
SET NALLG=NALLG_$PIECE(NURSAL(NII)," (")
SET ^TMP($JOB,"ALRGY",NIX)=NALLG
+5 QUIT
End DoDot:2
+6 IF NURSAL(NII)'["allergy"
Begin DoDot:2
+7 IF '($LENGTH(NADV)>230)
if NADV'=""
SET NADV=NADV_", "
SET NADV=NADV_$PIECE(NURSAL(NII)," (")
SET ^TMP($JOB,"ADVRXN",NIY)=NADV
+8 IF '$TEST
SET NADV=""
SET NIY=NIY+1
if NADV'=""
SET NADV=NADV_", "
SET NADV=NADV_$PIECE(NURSAL(NII)," (")
SET ^TMP($JOB,"ADVRXN",NIY)=NADV
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 SET NIX=0
+12 IF $ORDER(^TMP($JOB,"ALRGY",NIX))
FOR
SET NIX=$ORDER(^TMP($JOB,"ALRGY",NIX))
if NIX'>0
QUIT
SET NALLG=$GET(^TMP($JOB,"ALRGY",NIX))
Begin DoDot:1
+13 IF NIX=1
SET NURSAL="Allergy: "_NALLG
+14 IF '$TEST
SET NURSAL=NALLG
+15 DO FITLINE^NURCES5(NURSAL,25,.NPT)
+16 QUIT
End DoDot:1
+17 IF '$TEST
SET NURSAL="Allergy: NKA"
DO FITLINE^NURCES5(NURSAL,25,.NPT)
+18 SET NIY=0
FOR
SET NIY=$ORDER(^TMP($JOB,"ADVRXN",NIY))
if NIY'>0
QUIT
SET NADV=$GET(^TMP($JOB,"ADVRXN",NIY))
Begin DoDot:1
+19 IF NIY=1
SET NURSAL="Adv rxn: "_NADV
+20 IF '$TEST
SET NURSAL=NADV
+21 DO FITLINE^NURCES5(NURSAL,25,.NPT)
+22 QUIT
End DoDot:1
QA KILL ^TMP($JOB,"ALRGY"),^TMP($JOB,"ADVRXN"),NADV,NALLG,NII,I,NURSAL,GMRANKA,NIX,NIY
+1 QUIT
