- 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 Apr 23, 2025@18:08:42 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
