PRCNCOST ;SSI/SEB-Display Cost Report ;[ 02/26/97 5:57 PM ]
;;1.0;PRCN;**3**;Sep 13, 1996
EN ;
W !!,"This report should be printed on 132 column paper !"
S IOM=132,%ZIS="Q" D ^%ZIS Q:POP>0
I $D(IO("Q")) D Q
. S ZTRTN="BEG^PRCNCOST",ZTDESC="Equipment Cost Report"
. D ^%ZTLOAD,HOME^%ZIS K IO("Q"),ZTSK,%ZTLOAD,ZTREQ
I $E(IOST)="C" U IO
BEG K ^TMP($J) S PG=0,$P(LIN,"-",130)=""
D HDR S GTOTAL=0,D0=""
F STA=10,31 F S D0=$O(^PRCN(413,"AC",STA,D0)) Q:D0="" D
. S PSERV=$P(^PRCN(413,D0,0),U,3) Q:PSERV=""
. S SERV=$P(^DIC(49,PSERV,0),U),^TMP($J,"COST",SERV,D0)=""
S SERV=""
SRV S SERV=$O(^TMP($J,"COST",SERV)) G EXIT:$G(C)'="",FIN:SERV=""
W !,"Service: ",SERV S (D0,STOTAL)=0,NL=NL+1 D CHKPG Q:$G(C)'=""
S D0="" F S D0=$O(^TMP($J,"COST",SERV,D0)) Q:D0="" D GETSUMS
Q:$D(C) W !!,"Subtotal for ",SERV,":",?117,$J(STOTAL,10,2),!
F I=1:1:130 W "-"
S GTOTAL=GTOTAL+STOTAL,NL=NL+3 D CHKPG
G SRV
FIN W !,"Total:",?117,$J(GTOTAL,10,2) S NL=NL+1 D CHKPG
I $E(IOST)'="C" W @IOF
D ^%ZISC
EXIT K D0,D1,GTOTAL,STOTAL,LTOTAL,TOTAL,SERV,PSERV,C,FN,I,NL,PN,COST
K TXT,LIN,STA,^TMP($J,"COST")
Q
GETSUMS ; Get line item total & display stuff
W !,$P(^PRCN(413,D0,0),U) S (D1,TOTAL,LTOTAL)=0
F S D1=$O(^PRCN(413,D0,1,D1)) Q:'+D1 D
. S DR=15,DR(413.015)=6,DIQ(0)="C",DIQ="LBTOT"
. S DIC=413,DA=D0,DA(1)=D1,DA(413.015)=D1 NEW D1
. D EN^DIQ1
. S X=$G(LBTOT(413.015,DA(413.015),6))
. S LTOTAL=LTOTAL+X
. K DIC,LBTOT,DIC,DR,DIQ,DA,X
S TOTAL=TOTAL+LTOTAL W $J(LTOTAL,10,2)
F FN=20,22,24,53,54,60,63,65,66 D
. S:FN<25 I=2,PN=FN-15 S:FN>25 I=7,PN=FN-51
. S COST=$P($G(^PRCN(413,D0,I)),U,PN),TOTAL=TOTAL+COST
. W $J(COST,10,2)
W $J(TOTAL,10,2) S STOTAL=STOTAL+TOTAL,NL=NL+1 D CHKPG
Q
CHKPG ; If printing to screen & it is full, clear screen
Q:IOT'["TRM"!(IOSL>NL+3) W !,"Hit RETURN to continue or '^' to quit. "
R C:DTIME S:'$T C=U K:C'?1"^".E C
Q
HDR ; Print a header for the report
S PG=PG+1,TXT=" " I $E(IOST)="C" W @IOF
W !,"EQUIPMENT REQUEST COST SUMMARY REPORT"
W $J("",IOM-$L(TXT)\2) S X="N",%DT="T" D ^%DT W $$FMTE^XLFDT(Y,"1P")_" PAGE: "_PG,!
W ?31,"Annual",?61,"Training",?71,"Training",?81,"Constr./",?91
W "Special",?101,"Test",?111,"Maint.",!,?21,"Line Item",?31,"Recurring"
W ?41,"Training",?51,"Contract",?61,"Tuition",?71,"Travel",?81
W "Renov.",?91,"Install.",?101,"Equipment",?111,"Impact",?121,"Total"
W !,"Transaction #" S NL=5 F I=2:1:12 W ?(I*10+1),"Cost"
W !,LIN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNCOST 2475 printed Nov 22, 2024@17:04:24 Page 2
PRCNCOST ;SSI/SEB-Display Cost Report ;[ 02/26/97 5:57 PM ]
+1 ;;1.0;PRCN;**3**;Sep 13, 1996
EN ;
+1 WRITE !!,"This report should be printed on 132 column paper !"
+2 SET IOM=132
SET %ZIS="Q"
DO ^%ZIS
if POP>0
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="BEG^PRCNCOST"
SET ZTDESC="Equipment Cost Report"
+5 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q"),ZTSK,%ZTLOAD,ZTREQ
End DoDot:1
QUIT
+6 IF $EXTRACT(IOST)="C"
USE IO
BEG KILL ^TMP($JOB)
SET PG=0
SET $PIECE(LIN,"-",130)=""
+1 DO HDR
SET GTOTAL=0
SET D0=""
+2 FOR STA=10,31
FOR
SET D0=$ORDER(^PRCN(413,"AC",STA,D0))
if D0=""
QUIT
Begin DoDot:1
+3 SET PSERV=$PIECE(^PRCN(413,D0,0),U,3)
if PSERV=""
QUIT
+4 SET SERV=$PIECE(^DIC(49,PSERV,0),U)
SET ^TMP($JOB,"COST",SERV,D0)=""
End DoDot:1
+5 SET SERV=""
SRV SET SERV=$ORDER(^TMP($JOB,"COST",SERV))
if $GET(C)'=""
GOTO EXIT
if SERV=""
GOTO FIN
+1 WRITE !,"Service: ",SERV
SET (D0,STOTAL)=0
SET NL=NL+1
DO CHKPG
if $GET(C)'=""
QUIT
+2 SET D0=""
FOR
SET D0=$ORDER(^TMP($JOB,"COST",SERV,D0))
if D0=""
QUIT
DO GETSUMS
+3 if $DATA(C)
QUIT
WRITE !!,"Subtotal for ",SERV,":",?117,$JUSTIFY(STOTAL,10,2),!
+4 FOR I=1:1:130
WRITE "-"
+5 SET GTOTAL=GTOTAL+STOTAL
SET NL=NL+3
DO CHKPG
+6 GOTO SRV
FIN WRITE !,"Total:",?117,$JUSTIFY(GTOTAL,10,2)
SET NL=NL+1
DO CHKPG
+1 IF $EXTRACT(IOST)'="C"
WRITE @IOF
+2 DO ^%ZISC
EXIT KILL D0,D1,GTOTAL,STOTAL,LTOTAL,TOTAL,SERV,PSERV,C,FN,I,NL,PN,COST
+1 KILL TXT,LIN,STA,^TMP($JOB,"COST")
+2 QUIT
GETSUMS ; Get line item total & display stuff
+1 WRITE !,$PIECE(^PRCN(413,D0,0),U)
SET (D1,TOTAL,LTOTAL)=0
+2 FOR
SET D1=$ORDER(^PRCN(413,D0,1,D1))
if '+D1
QUIT
Begin DoDot:1
+3 SET DR=15
SET DR(413.015)=6
SET DIQ(0)="C"
SET DIQ="LBTOT"
+4 SET DIC=413
SET DA=D0
SET DA(1)=D1
SET DA(413.015)=D1
NEW D1
+5 DO EN^DIQ1
+6 SET X=$GET(LBTOT(413.015,DA(413.015),6))
+7 SET LTOTAL=LTOTAL+X
+8 KILL DIC,LBTOT,DIC,DR,DIQ,DA,X
End DoDot:1
+9 SET TOTAL=TOTAL+LTOTAL
WRITE $JUSTIFY(LTOTAL,10,2)
+10 FOR FN=20,22,24,53,54,60,63,65,66
Begin DoDot:1
+11 if FN<25
SET I=2
SET PN=FN-15
if FN>25
SET I=7
SET PN=FN-51
+12 SET COST=$PIECE($GET(^PRCN(413,D0,I)),U,PN)
SET TOTAL=TOTAL+COST
+13 WRITE $JUSTIFY(COST,10,2)
End DoDot:1
+14 WRITE $JUSTIFY(TOTAL,10,2)
SET STOTAL=STOTAL+TOTAL
SET NL=NL+1
DO CHKPG
+15 QUIT
CHKPG ; If printing to screen & it is full, clear screen
+1 if IOT'["TRM"!(IOSL>NL+3)
QUIT
WRITE !,"Hit RETURN to continue or '^' to quit. "
+2 READ C:DTIME
if '$TEST
SET C=U
if C'?1"^".E
KILL C
+3 QUIT
HDR ; Print a header for the report
+1 SET PG=PG+1
SET TXT=" "
IF $EXTRACT(IOST)="C"
WRITE @IOF
+2 WRITE !,"EQUIPMENT REQUEST COST SUMMARY REPORT"
+3 WRITE $JUSTIFY("",IOM-$LENGTH(TXT)\2)
SET X="N"
SET %DT="T"
DO ^%DT
WRITE $$FMTE^XLFDT(Y,"1P")_" PAGE: "_PG,!
+4 WRITE ?31,"Annual",?61,"Training",?71,"Training",?81,"Constr./",?91
+5 WRITE "Special",?101,"Test",?111,"Maint.",!,?21,"Line Item",?31,"Recurring"
+6 WRITE ?41,"Training",?51,"Contract",?61,"Tuition",?71,"Travel",?81
+7 WRITE "Renov.",?91,"Install.",?101,"Equipment",?111,"Impact",?121,"Total"
+8 WRITE !,"Transaction #"
SET NL=5
FOR I=2:1:12
WRITE ?(I*10+1),"Cost"
+9 WRITE !,LIN
+10 QUIT
