- FHREP1 ; HISC/NCA - Inventory Worksheet and Report ;3/9/95 08:28
- ;;5.5;DIETETICS;**13**;Jan 28, 2005;Build 1
- EN2 ; Print the Inventory Worksheet & Report
- S FHXX="F"
- R !!,"Select W=Worksheet or R=Report: ",FHR:DTIME G:'$T!("^"[FHR) KIL^FHREP
- I "wr"[FHR S X=FHR D TR^FH S FHR=X
- I FHR'?1U!("WR"'[FHR) W *7," Enter W or R" G EN2
- E0 ; Read in Month and Year
- D NOW^%DTC S NOW=%\1
- K %DT W !!,"Enter Mth/Yr: "_+$E(NOW,4,5)_"/"_$E(NOW,2,3)_"// " R X:DTIME G:'$T!(X["^") KIL^FHREP
- I X="" S X=$E(NOW,1,5)_"00"
- S %DT="M" D ^%DT K %DT I Y<1!($E(Y,1,5)>$E(NOW,1,5)) W *7," Answer Month and Yr as Mth/Yr or Mth Yr.",!?25," CANNOT be greater than now." G E0
- S MTH=+$E(Y,4,5),MTH=$P("January February March April May June July August September October November December"," ",MTH),YR=$E(Y,2,3),MTH=MTH_" "_YR
- I FHR="W" D F1^FHREP G:FHXX["^"!("^"[X) KIL^FHREP
- I FHR="R" D D1^FHREP G:"^"[X KIL^FHREP
- E1 K IOP S %ZIS="MQ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP G:POP KIL^FHREP
- I $D(IO("Q")) S FHPGM="Q0^FHREP1",FHLST="FHR^FHXX^MTH^SRT" D EN2^FH G KIL^FHREP
- U IO D Q0 D ^%ZISC K %ZIS,IOP G KIL^FHREP
- Q0 ; Process Printing worksheet or report
- D Q1 G KIL^FHREP
- Q1 ; Loop through Ingredients
- K ^TMP($J) S ANS="",(K,GRDTOT,OLD,SUBTOT,TOTAL,PG)=0 D NOW^%DTC S DTP=% D DTP^FH S HD=DTP S CK=1
- F K=0:0 S K=$O(^FHING(K)) Q:K<1 S X=$P($G(^(K,0)),"^",19) I X="Y" S X=$G(^(0)) D LP S:OK ^TMP($J,P0_$S(FHXX="S":$E(L0,1,15),1:"FG"_P0),ING)=K_"^"_UP_"^"_COST_"^"_QOH_"^"_UDC_"^"_UDQ_"^"_$E(MIN,1,5)
- S REC=0
- S P0="" F L1=0:0 S P0=$O(^TMP($J,P0)) Q:P0=""!(ANS="^") S ING="" F L2=0:0 S ING=$O(^TMP($J,P0,ING)) Q:ING="" S XX=^(ING) D P1 Q:ANS="^"
- I FHR="R",ANS="",SRT W !!,?55,"TOTAL: ",$J(SUBTOT,8,2)
- I FHR="R",ANS="",'SRT D SUB W !!?49,"GRAND TOTAL: ",$J(GRDTOT,8,2)
- Q
- LP ; Get Food Group or Storage
- S ING=$P(X,"^",1),UP=$P(X,"^",5),COST=$P(X,"^",9),QOH=$P(X,"^",11),UDC=$P(X,"^",23),UDQ=$P(X,"^",24),MIN=$P(X,"^",25),OK=1,L0=""
- S DTP=UDC D:DTP'="" DTP^FH S UDC=DTP,DTP=UDQ D:DTP'="" DTP^FH S UDQ=DTP
- I FHXX="F" S P0=$P(X,"^",13) S:P0<1!(P0>6) P0=7 S:SRT&(P0'=SRT) OK=0 Q
- S LOC=$P(X,"^",12),L0=$P($G(^FH(113.1,+LOC,0)),"^",1) S:L0="" L0="UNCLASSIFIED" S P0=$P($G(^FH(113.1,+LOC,0)),"^",3),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0) S:SRT&(LOC'=SRT) OK=0
- Q
- P1 ; Loop to print or if FHR="E" edit QOH
- S K=$P(XX,"^",1),UP=$P(XX,"^",2),COST=$P(XX,"^",3),QOH=$P(XX,"^",4),UDC=$P(XX,"^",5),UDQ=$P(XX,"^",6),MIN=$P(XX,"^",7),REC=REC+1
- I FHR="E" D Q
- .W !!,"Ingredient: ",$P(^FHING(K,0),"^",1)
- .W:UDQ'="" !?12,"QOH LAST UPDATED ON ",UDQ,!
- .K DIE S DIE="^FHING(",DA=K
- .S:OKAY DR="8;S:X=COST Y=""@1"";29////"_DT_";@1;10;S:X=QOH Y="""";30////"_DT
- .S:'OKAY DR="10;S:X=QOH Y="""";30////"_DT D ^DIE S:$D(DTOUT) CK=0 S:$D(Y)!$D(DTOUT) ANS="^" K DA,DIE,DR,DTOUT,Y
- .Q
- D CHK Q:ANS="^"
- D:$Y'<(IOSL-5) HD W ! Q:ANS="^"
- I $L(ING)'>30 D
- .W !,$J(MIN,5),?6,ING,?39,UP,?43,$J(COST,8,3)
- .I FHR="W" W ?53,UDC,?63,$J(QOH,8,2),?73,"_____" Q
- .W ?55,$J(QOH,8,2),?64,$J(TOTAL,8,2)
- .Q
- E D
- .S L=$L($E(ING,1,30),",")
- .S:L=1 L=L+1 W !,$J(MIN,5),?6,$P(ING,",",1,L-1),","
- .W !?6,$P(ING,",",L,99),?39,UP,?43,$J(COST,8,3)
- .I FHR="W" W ?53,UDC,?63,$J(QOH,8,2),?73,"_____" Q
- .W ?55,$J(QOH,8,2),?64,$J(TOTAL,8,2)
- .Q
- Q
- CHK ; Check the Food Group or Storage to do Subtotal & Grandtotal
- S P1=$S(FHXX="F":+P0,1:$E(P0,3,17))
- I REC=1 S OLD=P1 D HDR
- I OLD'=P1 D:FHR="R" SUB D HD
- S OLD=P1
- ; Calculate subtotal grand total
- Q:FHR'="R"
- S TOTAL=COST*QOH
- S SUBTOT=SUBTOT+TOTAL
- S GRDTOT=GRDTOT+TOTAL
- Q
- SUB ; Write subtotal
- W !!,?52,"SUBTOTAL: ",$J(SUBTOT,8,2)
- S SUBTOT=0
- Q
- HD ; Check for end of page
- G:REC=1 HDR
- I IOST?1"C".E W:$X>1 ! W *7 K DIR S DIR(0)="E" D ^DIR I 'Y S ANS="^" Q
- HDR ; Heading for the Inventory
- W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1
- W !,HD,?70,"Page ",PG,!!?22,"I N V E N T O R Y " W $S(FHR="W":"W O R K S H E E T",1:"R E P O R T"),!!
- W ?(80-$L(MTH)/2),MTH,!!
- I FHXX="F" S P2="FOOD GROUP: "_$P("MEAT PRODUCTS^MILK PRODUCTS^FRUITS & VEGETABLES^BREADS^COMMERCIAL NUTRITION SUPPLEMENTS^MISCELLANEOUS^UNCLASSIFIED","^",+P1)
- E S P2=P1
- W ?(80-$L(P2)/2),P2,!!
- I FHR="W" W !?56,"DATE",!?47,"ITEM",?56,"LAST",?66,"QOH",?74,"QOH",!,"ITEM#",?20,"NAME",?38,"U/P",?47,"COST",?55,"UPDATE",?63,"LAST MTH",?72,"CURRENT",! Q
- W !?47,"ITEM",?58,"QOH",?67,"TOTAL",!,"ITEM#",?20,"NAME",?38,"U/P",?47,"COST",?56,"CURRENT",?68,"COST",!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHREP1 4413 printed Feb 18, 2025@23:21:21 Page 2
- FHREP1 ; HISC/NCA - Inventory Worksheet and Report ;3/9/95 08:28
- +1 ;;5.5;DIETETICS;**13**;Jan 28, 2005;Build 1
- EN2 ; Print the Inventory Worksheet & Report
- +1 SET FHXX="F"
- +2 READ !!,"Select W=Worksheet or R=Report: ",FHR:DTIME
- if '$TEST!("^"[FHR)
- GOTO KIL^FHREP
- +3 IF "wr"[FHR
- SET X=FHR
- DO TR^FH
- SET FHR=X
- +4 IF FHR'?1U!("WR"'[FHR)
- WRITE *7," Enter W or R"
- GOTO EN2
- E0 ; Read in Month and Year
- +1 DO NOW^%DTC
- SET NOW=%\1
- +2 KILL %DT
- WRITE !!,"Enter Mth/Yr: "_+$EXTRACT(NOW,4,5)_"/"_$EXTRACT(NOW,2,3)_"// "
- READ X:DTIME
- if '$TEST!(X["^")
- GOTO KIL^FHREP
- +3 IF X=""
- SET X=$EXTRACT(NOW,1,5)_"00"
- +4 SET %DT="M"
- DO ^%DT
- KILL %DT
- IF Y<1!($EXTRACT(Y,1,5)>$EXTRACT(NOW,1,5))
- WRITE *7," Answer Month and Yr as Mth/Yr or Mth Yr.",!?25," CANNOT be greater than now."
- GOTO E0
- +5 SET MTH=+$EXTRACT(Y,4,5)
- SET MTH=$PIECE("January February March April May June July August September October November December"," ",MTH)
- SET YR=$EXTRACT(Y,2,3)
- SET MTH=MTH_" "_YR
- +6 IF FHR="W"
- DO F1^FHREP
- if FHXX["^"!("^"[X)
- GOTO KIL^FHREP
- +7 IF FHR="R"
- DO D1^FHREP
- if "^"[X
- GOTO KIL^FHREP
- E1 KILL IOP
- SET %ZIS="MQ"
- SET %ZIS("B")="HOME"
- WRITE !
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO KIL^FHREP
- +1 IF $DATA(IO("Q"))
- SET FHPGM="Q0^FHREP1"
- SET FHLST="FHR^FHXX^MTH^SRT"
- DO EN2^FH
- GOTO KIL^FHREP
- +2 USE IO
- DO Q0
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL^FHREP
- Q0 ; Process Printing worksheet or report
- +1 DO Q1
- GOTO KIL^FHREP
- Q1 ; Loop through Ingredients
- +1 KILL ^TMP($JOB)
- SET ANS=""
- SET (K,GRDTOT,OLD,SUBTOT,TOTAL,PG)=0
- DO NOW^%DTC
- SET DTP=%
- DO DTP^FH
- SET HD=DTP
- SET CK=1
- +2 FOR K=0:0
- SET K=$ORDER(^FHING(K))
- if K<1
- QUIT
- SET X=$PIECE($GET(^(K,0)),"^",19)
- IF X="Y"
- SET X=$GET(^(0))
- DO LP
- if OK
- SET ^TMP($JOB,P0_$SELECT(FHXX="S":$EXTRACT(L0,1,15),1:"FG"_P0),ING)=K_"^"_UP_"^"_COST_"^"_QOH_"^"_UDC_"^"_UDQ_"^"_$EXTRACT(MIN,1,5)
- +3 SET REC=0
- +4 SET P0=""
- FOR L1=0:0
- SET P0=$ORDER(^TMP($JOB,P0))
- if P0=""!(ANS="^")
- QUIT
- SET ING=""
- FOR L2=0:0
- SET ING=$ORDER(^TMP($JOB,P0,ING))
- if ING=""
- QUIT
- SET XX=^(ING)
- DO P1
- if ANS="^"
- QUIT
- +5 IF FHR="R"
- IF ANS=""
- IF SRT
- WRITE !!,?55,"TOTAL: ",$JUSTIFY(SUBTOT,8,2)
- +6 IF FHR="R"
- IF ANS=""
- IF 'SRT
- DO SUB
- WRITE !!?49,"GRAND TOTAL: ",$JUSTIFY(GRDTOT,8,2)
- +7 QUIT
- LP ; Get Food Group or Storage
- +1 SET ING=$PIECE(X,"^",1)
- SET UP=$PIECE(X,"^",5)
- SET COST=$PIECE(X,"^",9)
- SET QOH=$PIECE(X,"^",11)
- SET UDC=$PIECE(X,"^",23)
- SET UDQ=$PIECE(X,"^",24)
- SET MIN=$PIECE(X,"^",25)
- SET OK=1
- SET L0=""
- +2 SET DTP=UDC
- if DTP'=""
- DO DTP^FH
- SET UDC=DTP
- SET DTP=UDQ
- if DTP'=""
- DO DTP^FH
- SET UDQ=DTP
- +3 IF FHXX="F"
- SET P0=$PIECE(X,"^",13)
- if P0<1!(P0>6)
- SET P0=7
- if SRT&(P0'=SRT)
- SET OK=0
- QUIT
- +4 SET LOC=$PIECE(X,"^",12)
- SET L0=$PIECE($GET(^FH(113.1,+LOC,0)),"^",1)
- if L0=""
- SET L0="UNCLASSIFIED"
- SET P0=$PIECE($GET(^FH(113.1,+LOC,0)),"^",3)
- SET P0=$SELECT(P0<1:99,P0<10:"0"_P0,1:P0)
- if SRT&(LOC'=SRT)
- SET OK=0
- +5 QUIT
- P1 ; Loop to print or if FHR="E" edit QOH
- +1 SET K=$PIECE(XX,"^",1)
- SET UP=$PIECE(XX,"^",2)
- SET COST=$PIECE(XX,"^",3)
- SET QOH=$PIECE(XX,"^",4)
- SET UDC=$PIECE(XX,"^",5)
- SET UDQ=$PIECE(XX,"^",6)
- SET MIN=$PIECE(XX,"^",7)
- SET REC=REC+1
- +2 IF FHR="E"
- Begin DoDot:1
- +3 WRITE !!,"Ingredient: ",$PIECE(^FHING(K,0),"^",1)
- +4 if UDQ'=""
- WRITE !?12,"QOH LAST UPDATED ON ",UDQ,!
- +5 KILL DIE
- SET DIE="^FHING("
- SET DA=K
- +6 if OKAY
- SET DR="8;S:X=COST Y=""@1"";29////"_DT_";@1;10;S:X=QOH Y="""";30////"_DT
- +7 if 'OKAY
- SET DR="10;S:X=QOH Y="""";30////"_DT
- DO ^DIE
- if $DATA(DTOUT)
- SET CK=0
- if $DATA(Y)!$DATA(DTOUT)
- SET ANS="^"
- KILL DA,DIE,DR,DTOUT,Y
- +8 QUIT
- End DoDot:1
- QUIT
- +9 DO CHK
- if ANS="^"
- QUIT
- +10 if $Y'<(IOSL-5)
- DO HD
- WRITE !
- if ANS="^"
- QUIT
- +11 IF $LENGTH(ING)'>30
- Begin DoDot:1
- +12 WRITE !,$JUSTIFY(MIN,5),?6,ING,?39,UP,?43,$JUSTIFY(COST,8,3)
- +13 IF FHR="W"
- WRITE ?53,UDC,?63,$JUSTIFY(QOH,8,2),?73,"_____"
- QUIT
- +14 WRITE ?55,$JUSTIFY(QOH,8,2),?64,$JUSTIFY(TOTAL,8,2)
- +15 QUIT
- End DoDot:1
- +16 IF '$TEST
- Begin DoDot:1
- +17 SET L=$LENGTH($EXTRACT(ING,1,30),",")
- +18 if L=1
- SET L=L+1
- WRITE !,$JUSTIFY(MIN,5),?6,$PIECE(ING,",",1,L-1),","
- +19 WRITE !?6,$PIECE(ING,",",L,99),?39,UP,?43,$JUSTIFY(COST,8,3)
- +20 IF FHR="W"
- WRITE ?53,UDC,?63,$JUSTIFY(QOH,8,2),?73,"_____"
- QUIT
- +21 WRITE ?55,$JUSTIFY(QOH,8,2),?64,$JUSTIFY(TOTAL,8,2)
- +22 QUIT
- End DoDot:1
- +23 QUIT
- CHK ; Check the Food Group or Storage to do Subtotal & Grandtotal
- +1 SET P1=$SELECT(FHXX="F":+P0,1:$EXTRACT(P0,3,17))
- +2 IF REC=1
- SET OLD=P1
- DO HDR
- +3 IF OLD'=P1
- if FHR="R"
- DO SUB
- DO HD
- +4 SET OLD=P1
- +5 ; Calculate subtotal grand total
- +6 if FHR'="R"
- QUIT
- +7 SET TOTAL=COST*QOH
- +8 SET SUBTOT=SUBTOT+TOTAL
- +9 SET GRDTOT=GRDTOT+TOTAL
- +10 QUIT
- SUB ; Write subtotal
- +1 WRITE !!,?52,"SUBTOTAL: ",$JUSTIFY(SUBTOT,8,2)
- +2 SET SUBTOT=0
- +3 QUIT
- HD ; Check for end of page
- +1 if REC=1
- GOTO HDR
- +2 IF IOST?1"C".E
- if $X>1
- WRITE !
- WRITE *7
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET ANS="^"
- QUIT
- HDR ; Heading for the Inventory
- +1 if '($EXTRACT(IOST,1,2)'="C-"&'PG)
- WRITE @IOF
- SET PG=PG+1
- +2 WRITE !,HD,?70,"Page ",PG,!!?22,"I N V E N T O R Y "
- WRITE $SELECT(FHR="W":"W O R K S H E E T",1:"R E P O R T"),!!
- +3 WRITE ?(80-$LENGTH(MTH)/2),MTH,!!
- +4 IF FHXX="F"
- SET P2="FOOD GROUP: "_$PIECE("MEAT PRODUCTS^MILK PRODUCTS^FRUITS & VEGETABLES^BREADS^COMMERCIAL NUTRITION SUPPLEMENTS^MISCELLANEOUS^UNCLASSIFIED","^",+P1)
- +5 IF '$TEST
- SET P2=P1
- +6 WRITE ?(80-$LENGTH(P2)/2),P2,!!
- +7 IF FHR="W"
- WRITE !?56,"DATE",!?47,"ITEM",?56,"LAST",?66,"QOH",?74,"QOH",!,"ITEM#",?20,"NAME",?38,"U/P",?47,"COST",?55,"UPDATE",?63,"LAST MTH",?72,"CURRENT",!
- QUIT
- +8 WRITE !?47,"ITEM",?58,"QOH",?67,"TOTAL",!,"ITEM#",?20,"NAME",?38,"U/P",?47,"COST",?56,"CURRENT",?68,"COST",!
- +9 QUIT