- 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 Feb 18, 2025@23:46:50 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