- FHNO4 ; HISC/REL - Bulk Nourishments ;4/25/93 19:01
- ;;5.5;DIETETICS;;Jan 28, 2005
- EN1 ; Enter/Edit Bulk Nourishments
- D WRD G:'WRD KIL S DA=WRD,DR="20" D ^DIE G EN1
- EN2 ; List Bulk Nourishments
- D WRD G:'WRD KIL S CT=0 W !
- F K=0:0 S K=$O(^FH(119.6,WRD,"BN",K)) Q:K<1 S X=^(K,0),X1=$P(X,"^",1),X2=$P(X,"^",2) I X1,$D(^FH(118,X1,0)) W !,$J(X2,6)," ",$P(^(0),"^",1) S CT=CT+1
- I 'CT W !,"No Bulk Nourishment Order entered for this Ward."
- G EN2
- WRD K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQM",WRD=0
- S DIC("DR")=".01" W ! D ^DIC Q:U[X!$D(DTOUT) G:Y<1 WRD S WRD=+Y Q
- KIL G KILL^XUSCLEAN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNO4 602 printed Feb 18, 2025@23:18:42 Page 2
- FHNO4 ; HISC/REL - Bulk Nourishments ;4/25/93 19:01
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- EN1 ; Enter/Edit Bulk Nourishments
- +1 DO WRD
- if 'WRD
- GOTO KIL
- SET DA=WRD
- SET DR="20"
- DO ^DIE
- GOTO EN1
- EN2 ; List Bulk Nourishments
- +1 DO WRD
- if 'WRD
- GOTO KIL
- SET CT=0
- WRITE !
- +2 FOR K=0:0
- SET K=$ORDER(^FH(119.6,WRD,"BN",K))
- if K<1
- QUIT
- SET X=^(K,0)
- SET X1=$PIECE(X,"^",1)
- SET X2=$PIECE(X,"^",2)
- IF X1
- IF $DATA(^FH(118,X1,0))
- WRITE !,$JUSTIFY(X2,6)," ",$PIECE(^(0),"^",1)
- SET CT=CT+1
- +3 IF 'CT
- WRITE !,"No Bulk Nourishment Order entered for this Ward."
- +4 GOTO EN2
- WRD KILL DIC
- SET (DIC,DIE)="^FH(119.6,"
- SET DIC(0)="AEQM"
- SET WRD=0
- +1 SET DIC("DR")=".01"
- WRITE !
- DO ^DIC
- if U[X!$DATA(DTOUT)
- QUIT
- if Y<1
- GOTO WRD
- SET WRD=+Y
- QUIT
- KIL GOTO KILL^XUSCLEAN