ENFAR1 ;WIRMFO/SAB-FIXED ASSET RPT, CAPITALIZED EQUIPMENT ON CMR; 3/11/96
;;7.0;ENGINEERING;**25**;Aug 17, 1993
; Capitalized Equipment List for CMR by CSN
;
CMR ; ask CMR
S DIC=6914.1,DIC(0)="AQEM" D ^DIC K DIC G:Y'>0 EXIT
S ENCMRI=+Y,ENCMR=$P(Y,U,2)
I $$LOC^ENFAVAL(ENCMR)="" D G CMR
. W $C(7),!,"CMR ",ENCMR," is inappropriate for capitalized NX equip."
. W !,"Please choose a different CMR.",!
; ask device
S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENFAR1",ZTDESC="Capitalized Equipment on CMR"
. S ZTSAVE("ENCMR")="",ZTSAVE("ENCMRI")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
QEN ; queued entry
U IO
; collect and sort equipment
K ^TMP($J)
S ENDA="" F S ENDA=$O(^ENG(6914,"AD",ENCMRI,ENDA)) Q:ENDA="" D
. Q:$P($G(^ENG(6914,ENDA,8)),U,2)'=1 ; not capitalized
. S ENCSNI=$P($G(^ENG(6914,ENDA,2)),U,8)
. S ENCSN=$S(ENCSNI:$P($G(^ENCSN(6917,ENCSNI,0)),U),1:"")
. I ENCSN="" S (ENCSN,ENCSNI)="<null value>"
. S ^TMP($J,ENCSN,ENDA)=""
. I $D(^TMP($J,ENCSN))#10=0 S ^TMP($J,ENCSN)=ENCSNI
; generate output
K ENT
S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
S ENL="",$P(ENL,"-",IOM)=""
S ENCSN="" D HD
F S ENCSN=$O(^TMP($J,ENCSN)) Q:ENCSN="" D Q:END
. ; category stock number
. S ENCSNI=$P($G(^TMP($J,ENCSN)),U)
. I $Y+4>IOSL D HD Q:END
. W !! W:ENCSNI $P($G(^ENCSN(6917,ENCSNI,0)),U,3) W " (CSN: ",ENCSN,")"
. S ENDA=0 F S ENDA=$O(^TMP($J,ENCSN,ENDA)) Q:'ENDA D Q:END
. . ; equipment item
. . I $Y+6>IOSL D HD Q:END D HDCSN
. . S ENY2=$G(^ENG(6914,ENDA,2))
. . S X=$P($G(^ENG(6914,ENDA,8)),U,6)
. . S ENSGL=$S(X:$P($G(^ENG(6914.3,X,0)),U),1:"")
. . W !!,?2,ENDA ; equip id
. . W ?13,$E($P($G(^ENG(6914,ENDA,1)),U,3),1,19) ; serial #
. . W ?33,$J("$"_$FN($P(ENY2,U,3),",",2),14) ; asset value
. . W ?48,ENSGL ; sgl
. . W ?53,$E($P(ENY2,U,4),4,5),?55,"/",$E($P(ENY2,U,4),2,3) ; acq date
. . W ?60,$P(ENY2,U,6) ; le
. . W ?64,$E($P(ENY2,U,10),4,5),?66,"/",$E($P(ENY2,U,10),2,3) ; repl
. . W ?71,$P(ENY2,U,7) ; nxrn
. . S ENPM=$P($G(^ENG(6914,ENDA,3)),U,6)
. . W:ENPM]"" !,?4,"PM: ",ENPM
. . S ENMAN=$E($$GET1^DIQ(6914,ENDA_",",1),1,30)
. . W:ENMAN]"" !,?4,"Manf: ",ENMAN
. . S ENMOD=$P($G(^ENG(6914,ENDA,1)),U,2)
. . W:ENMOD]"" !,?4,"Model: ",ENMOD
. . S:ENSGL="" ENSGL="<null>"
. . S $P(ENT(ENSGL),U)=$P($G(ENT(ENSGL)),U)+1
. . S $P(ENT(ENSGL),U,2)=$P($G(ENT(ENSGL)),U,2)+$P(ENY2,U,3)
I 'END D
. ; report footer
. S ENSGL="",ENC=0 F S ENSGL=$O(ENT(ENSGL)) Q:ENSGL="" S ENC=ENC+1
. I $Y+ENC+6>IOSL D HD Q:END
. W !,ENL,!,"TOTALS",?19,"COUNT",?27,"ASSET VALUE"
. S ENT="0^0"
. S ENSGL="" F S ENSGL=$O(ENT(ENSGL)) Q:ENSGL="" D
. . W !,?8,"SGL ",ENSGL
. . W ?19,$J($P(ENT(ENSGL),U),5)
. . W ?27,"$",$J($FN($P(ENT(ENSGL),U,2),",",2),15)
. . S $P(ENT,U)=$P(ENT,U)+$P(ENT(ENSGL),U)
. . S $P(ENT,U,2)=$P(ENT,U,2)+$P(ENT(ENSGL),U,2)
. W !,?19,"-----",?27,"----------------"
. W !,?5,"REPORT TOTAL"
. W ?19,$J($P(ENT,U),5),?27,"$",$J($FN($P(ENT,U,2),",",2),15)
. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
D ^%ZISC
EXIT I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP($J)
K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
K ENC,ENCMR,ENCMRI,ENCSN,ENCSNI,ENDA,ENMAN,ENMOD,ENPM,ENSGL,ENT,ENY2
K END,ENDT,ENL,ENPG
Q
HD ; header
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
I $E(IOST,1,2)="C-"!ENPG W @IOF
S ENPG=ENPG+1
W !,"CAPITALIZED EQUIPMENT BY CSN FOR CMR: ",$E(ENCMR,1,5)
W ?48,ENDT,?72,"page ",ENPG
W !!,?2,"EQUIP ID #",?13,"SERIAL NUMBER",?33,"ASSET VALUE",?48,"SGL"
W ?53,"ACQ",?60,"LE",?64,"REPL",?71,"NXRN"
W !,?2,$E(ENL,1,10),?13,$E(ENL,1,19),?33,$E(ENL,1,14),?48,$E(ENL,1,4)
W ?53,$E(ENL,1,5),?60,$E(ENL,1,2),?64,$E(ENL,1,5),?71,$E(ENL,1,8)
Q
HDCSN ; header for continued CSN
I $G(ENCSN)]"" D
. W ! W:$G(ENCSNI) $P($G(^ENCSN(6917,ENCSNI,0)),U,3)
. W " (CSN: ",ENCSN," continued)"
Q
;ENFAR1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAR1 3924 printed Nov 22, 2024@17:03:41 Page 2
ENFAR1 ;WIRMFO/SAB-FIXED ASSET RPT, CAPITALIZED EQUIPMENT ON CMR; 3/11/96
+1 ;;7.0;ENGINEERING;**25**;Aug 17, 1993
+2 ; Capitalized Equipment List for CMR by CSN
+3 ;
CMR ; ask CMR
+1 SET DIC=6914.1
SET DIC(0)="AQEM"
DO ^DIC
KILL DIC
if Y'>0
GOTO EXIT
+2 SET ENCMRI=+Y
SET ENCMR=$PIECE(Y,U,2)
+3 IF $$LOC^ENFAVAL(ENCMR)=""
Begin DoDot:1
+4 WRITE $CHAR(7),!,"CMR ",ENCMR," is inappropriate for capitalized NX equip."
+5 WRITE !,"Please choose a different CMR.",!
End DoDot:1
GOTO CMR
+6 ; ask device
+7 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTRTN="QEN^ENFAR1"
SET ZTDESC="Capitalized Equipment on CMR"
+10 SET ZTSAVE("ENCMR")=""
SET ZTSAVE("ENCMRI")=""
+11 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
QEN ; queued entry
+1 USE IO
+2 ; collect and sort equipment
+3 KILL ^TMP($JOB)
+4 SET ENDA=""
FOR
SET ENDA=$ORDER(^ENG(6914,"AD",ENCMRI,ENDA))
if ENDA=""
QUIT
Begin DoDot:1
+5 ; not capitalized
if $PIECE($GET(^ENG(6914,ENDA,8)),U,2)'=1
QUIT
+6 SET ENCSNI=$PIECE($GET(^ENG(6914,ENDA,2)),U,8)
+7 SET ENCSN=$SELECT(ENCSNI:$PIECE($GET(^ENCSN(6917,ENCSNI,0)),U),1:"")
+8 IF ENCSN=""
SET (ENCSN,ENCSNI)="<null value>"
+9 SET ^TMP($JOB,ENCSN,ENDA)=""
+10 IF $DATA(^TMP($JOB,ENCSN))#10=0
SET ^TMP($JOB,ENCSN)=ENCSNI
End DoDot:1
+11 ; generate output
+12 KILL ENT
+13 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDT=Y
+14 SET ENL=""
SET $PIECE(ENL,"-",IOM)=""
+15 SET ENCSN=""
DO HD
+16 FOR
SET ENCSN=$ORDER(^TMP($JOB,ENCSN))
if ENCSN=""
QUIT
Begin DoDot:1
+17 ; category stock number
+18 SET ENCSNI=$PIECE($GET(^TMP($JOB,ENCSN)),U)
+19 IF $Y+4>IOSL
DO HD
if END
QUIT
+20 WRITE !!
if ENCSNI
WRITE $PIECE($GET(^ENCSN(6917,ENCSNI,0)),U,3)
WRITE " (CSN: ",ENCSN,")"
+21 SET ENDA=0
FOR
SET ENDA=$ORDER(^TMP($JOB,ENCSN,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+22 ; equipment item
+23 IF $Y+6>IOSL
DO HD
if END
QUIT
DO HDCSN
+24 SET ENY2=$GET(^ENG(6914,ENDA,2))
+25 SET X=$PIECE($GET(^ENG(6914,ENDA,8)),U,6)
+26 SET ENSGL=$SELECT(X:$PIECE($GET(^ENG(6914.3,X,0)),U),1:"")
+27 ; equip id
WRITE !!,?2,ENDA
+28 ; serial #
WRITE ?13,$EXTRACT($PIECE($GET(^ENG(6914,ENDA,1)),U,3),1,19)
+29 ; asset value
WRITE ?33,$JUSTIFY("$"_$FNUMBER($PIECE(ENY2,U,3),",",2),14)
+30 ; sgl
WRITE ?48,ENSGL
+31 ; acq date
WRITE ?53,$EXTRACT($PIECE(ENY2,U,4),4,5),?55,"/",$EXTRACT($PIECE(ENY2,U,4),2,3)
+32 ; le
WRITE ?60,$PIECE(ENY2,U,6)
+33 ; repl
WRITE ?64,$EXTRACT($PIECE(ENY2,U,10),4,5),?66,"/",$EXTRACT($PIECE(ENY2,U,10),2,3)
+34 ; nxrn
WRITE ?71,$PIECE(ENY2,U,7)
+35 SET ENPM=$PIECE($GET(^ENG(6914,ENDA,3)),U,6)
+36 if ENPM]""
WRITE !,?4,"PM: ",ENPM
+37 SET ENMAN=$EXTRACT($$GET1^DIQ(6914,ENDA_",",1),1,30)
+38 if ENMAN]""
WRITE !,?4,"Manf: ",ENMAN
+39 SET ENMOD=$PIECE($GET(^ENG(6914,ENDA,1)),U,2)
+40 if ENMOD]""
WRITE !,?4,"Model: ",ENMOD
+41 if ENSGL=""
SET ENSGL="<null>"
+42 SET $PIECE(ENT(ENSGL),U)=$PIECE($GET(ENT(ENSGL)),U)+1
+43 SET $PIECE(ENT(ENSGL),U,2)=$PIECE($GET(ENT(ENSGL)),U,2)+$PIECE(ENY2,U,3)
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+44 IF 'END
Begin DoDot:1
+45 ; report footer
+46 SET ENSGL=""
SET ENC=0
FOR
SET ENSGL=$ORDER(ENT(ENSGL))
if ENSGL=""
QUIT
SET ENC=ENC+1
+47 IF $Y+ENC+6>IOSL
DO HD
if END
QUIT
+48 WRITE !,ENL,!,"TOTALS",?19,"COUNT",?27,"ASSET VALUE"
+49 SET ENT="0^0"
+50 SET ENSGL=""
FOR
SET ENSGL=$ORDER(ENT(ENSGL))
if ENSGL=""
QUIT
Begin DoDot:2
+51 WRITE !,?8,"SGL ",ENSGL
+52 WRITE ?19,$JUSTIFY($PIECE(ENT(ENSGL),U),5)
+53 WRITE ?27,"$",$JUSTIFY($FNUMBER($PIECE(ENT(ENSGL),U,2),",",2),15)
+54 SET $PIECE(ENT,U)=$PIECE(ENT,U)+$PIECE(ENT(ENSGL),U)
+55 SET $PIECE(ENT,U,2)=$PIECE(ENT,U,2)+$PIECE(ENT(ENSGL),U,2)
End DoDot:2
+56 WRITE !,?19,"-----",?27,"----------------"
+57 WRITE !,?5,"REPORT TOTAL"
+58 WRITE ?19,$JUSTIFY($PIECE(ENT,U),5),?27,"$",$JUSTIFY($FNUMBER($PIECE(ENT,U,2),",",2),15)
+59 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+60 DO ^%ZISC
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL ^TMP($JOB)
+2 KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
+3 KILL ENC,ENCMR,ENCMRI,ENCSN,ENCSNI,ENDA,ENMAN,ENMOD,ENPM,ENSGL,ENT,ENY2
+4 KILL END,ENDT,ENL,ENPG
+5 QUIT
HD ; header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+3 SET ENPG=ENPG+1
+4 WRITE !,"CAPITALIZED EQUIPMENT BY CSN FOR CMR: ",$EXTRACT(ENCMR,1,5)
+5 WRITE ?48,ENDT,?72,"page ",ENPG
+6 WRITE !!,?2,"EQUIP ID #",?13,"SERIAL NUMBER",?33,"ASSET VALUE",?48,"SGL"
+7 WRITE ?53,"ACQ",?60,"LE",?64,"REPL",?71,"NXRN"
+8 WRITE !,?2,$EXTRACT(ENL,1,10),?13,$EXTRACT(ENL,1,19),?33,$EXTRACT(ENL,1,14),?48,$EXTRACT(ENL,1,4)
+9 WRITE ?53,$EXTRACT(ENL,1,5),?60,$EXTRACT(ENL,1,2),?64,$EXTRACT(ENL,1,5),?71,$EXTRACT(ENL,1,8)
+10 QUIT
HDCSN ; header for continued CSN
+1 IF $GET(ENCSN)]""
Begin DoDot:1
+2 WRITE !
if $GET(ENCSNI)
WRITE $PIECE($GET(^ENCSN(6917,ENCSNI,0)),U,3)
+3 WRITE " (CSN: ",ENCSN," continued)"
End DoDot:1
+4 QUIT
+5 ;ENFAR1
