ENFAR8 ;WIRMFO/SAB-FIXED ASSET RPT, EQUIP LOCATOR LIST FOR STATION ;1/18/2001
;;7.0;ENGINEERING;**29,33,50,63,69**;Aug 17, 1993
; Equipment Locator List for STATION
;
EN ;
; ask STATION
S DIR(0)="F^3:5",DIR("A")="STATION NUMBER"
S DIR("B")=$$GET1^DIQ(6910,"1,",1)
D ^DIR K DIR G:$D(DIRUT) EXIT
S ENSNR=Y
; ask about including not capitalized/accountable equipment
S DIR(0)="Y"
S DIR("A")="Include Not Capitalized/Accountable Equipment"
S DIR("B")="YES"
S DIR("?",1)="This report lists capitalized equipment on a CMR."
S DIR("?",2)=" "
S DIR("?",3)="Equipment with an Investment Category of NOT CAPITALIZED/ACCOUNTABLE"
S DIR("?",4)="can also be included in the output."
S DIR("?",6)=" "
S DIR("?")="Enter YES to list all accountable equipment."
D ^DIR K DIR G:$D(DIRUT) EXIT
S ENEXP=Y
; ask device
S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENFAR8",ZTDESC="Equipment List for Station"
. S ZTSAVE("ENSNR")="",ZTSAVE("ENEXP")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
QEN ; queued entry
U IO
; collect and sort equipment
K ^TMP($J)
S ENSND=$$GET1^DIQ(6910,"1,",1) ; default station number
S ENDA=0 F S ENDA=$O(^ENG(6914,ENDA)) Q:'ENDA D
. S ENSN=$P($G(^ENG(6914,ENDA,9)),U,5) S:ENSN="" ENSN=ENSND
. Q:ENSN'=ENSNR ; not station
. S ENY2=$G(^ENG(6914,ENDA,2))
. S X=$P(ENY2,U,9),ENCMR=$S(X:$E($P($G(^ENG(6914.1,X,0)),U),1,5),1:"")
. Q:ENCMR="" ; not on a CMR
. S ENCSNI=$P(ENY2,U,8)
. S ENCSN=$S(ENCSNI:$P($G(^ENCSN(6917,ENCSNI,0)),U),1:"")
. I ENCSN="" S (ENCSN,ENCSNI)="<null value>"
. S ENY8=$G(^ENG(6914,ENDA,8))
. ; quit when not capitalized (or not accountable if user specified)
. Q:$S(ENEXP:"^1^A^",1:"^1^")'[(U_$P(ENY8,U,2)_U)
. ;Q:'($P(ENY8,U,2)) ;*63
. ;Q:'($P(ENY8,U,2))&'(ENEXP&("^10^23^70^"[(U_$E(ENCSN,1,2)_U))) ;*50
. S ^TMP($J,ENCSN,ENCMR,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
I 'END F S ENCSN=$O(^TMP($J,ENCSN)) Q:ENCSN="" D Q:END
. ; category stock number
. S ENC="0^0" ; initialize CSN count and value
. 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 ENCMR="" F S ENCMR=$O(^TMP($J,ENCSN,ENCMR)) Q:ENCMR="" D Q:END
. . ; cmr
. . S ENDA=0 F S ENDA=$O(^TMP($J,ENCSN,ENCMR,ENDA)) Q:'ENDA D Q:END
. . . ; equipment item
. . . 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:"")
. . . S ENFUND=$$GET1^DIQ(6914,ENDA,62)
. . . S ENI=5 ; number of lines needed to print item
. . . S ENPM=$P($G(^ENG(6914,ENDA,3)),U,6) S:ENPM]"" ENI=ENI+1
. . . S ENMAN=$E($$GET1^DIQ(6914,ENDA_",",1),1,30) S:ENMAN]"" ENI=ENI+1
. . . S ENMOD=$P($G(^ENG(6914,ENDA,1)),U,2) S:ENMOD]"" ENI=ENI+1
. . . S ENSERIAL=$P($G(^ENG(6914,ENDA,1)),U,3) S:ENSERIAL]"" ENI=ENI+1
. . . I IOM'>89,$P(ENY2,U,13)]"" S ENI=ENI+1
. . . I $Y+ENI>IOSL D HD Q:END D HDCSN
. . . W !!,?1,ENDA ; equipment id
. . . W ?12,$E($P(ENY2,U,4),4,5),?14,"/",$E($P(ENY2,U,4),2,3) ; acq date
. . . W ?18,ENFUND ; fund
. . . W ?25,ENSGL ; sgl
. . . W ?30,$J("$"_$FN($P(ENY2,U,3),",",2),14) ; asset value
. . . W ?45,$P(ENY2,U,6) ; le
. . . W ?48,$E($P(ENY2,U,10),4,5),?50,"/",$E($P(ENY2,U,10),2,3) ; repl
. . . W ?54,$$GET1^DIQ(6914,ENDA,24) ; location
. . . W ?74,ENCMR ; cmr
. . . I IOM>89,$P(ENY2,U,13)]"" W ?80,$$FMTE^XLFDT($P(ENY2,U,13),2)
. . . W:ENPM]"" !,?4,"PM: ",ENPM
. . . W:ENMAN]"" !,?4,"Manf: ",ENMAN
. . . W:ENMOD]"" !,?4,"Model: ",ENMOD
. . . W:ENSERIAL]"" !,?4,"S/N: ",ENSERIAL
. . . I IOM'>89,$P(ENY2,U,13)]"" W !,?4,"Last Inv. Date: ",$$FMTE^XLFDT($P(ENY2,U,13),2)
. . . 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)
. . . S $P(ENC,U)=$P($G(ENC),U)+1
. . . S $P(ENC,U,2)=$P($G(ENC),U,2)+$P(ENY2,U,3)
. Q:END
. W !,?13,"(CSN TOTAL",?24,$J("#"_$P(ENC,U),3)
. W ?30,$J("$"_$FN($P(ENC,U,2),",",2),14),")"
I END W !!,"REPORT STOPPED BY USER REQUEST"
E 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",?20,"COUNT",?30,"ASSET VALUE"
. S ENT="0^0"
. S ENSGL="" F S ENSGL=$O(ENT(ENSGL)) Q:ENSGL="" D
. . W !,?9,"SGL ",ENSGL
. . W ?20,$J($P(ENT(ENSGL),U),5)
. . W ?30,"$",$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 !,?20,"-----",?30,"----------------"
. W !,?6,"REPORT TOTAL"
. W ?20,$J($P(ENT,U),5)
. W ?30,"$",$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,ENFUND,ENI,ENMAN,ENMOD,ENPM
K ENSERIAL,ENSGL,ENSN,ENSND,ENSNR,ENT,ENY2
K END,ENDT,ENL,ENPG
Q
HD ; header
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
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 !,$S(ENEXP:"ACCOUNTABLE",1:"CAPITALIZED")," NX EQUIP. FOR STATION: "
W ENSNR,?48,ENDT,?72,"page ",ENPG
W !!,?1,"EQUIPMENT",?12,"ACQ",?18,"FUND",?25,"SGL",?30,"ASSET VALUE"
W ?45,"LE",?48,"REPL",?54,"LOCATION",?74,"CMR"
W:IOM>89 ?80,"INVENTORY"
W !,?1,"ENTRY #",?12,"DATE",?48,"DATE",?54,"ROOM-BLDG-DIV"
W:IOM>89 ?80,"DATE"
W !,?1,$E(ENL,1,10),?12,$E(ENL,1,5),?18,$E(ENL,1,6),?25,$E(ENL,1,4)
W ?30,$E(ENL,1,14),?45,$E(ENL,1,2),?48,$E(ENL,1,5),?54,$E(ENL,1,19)
W ?74,$E(ENL,1,5)
W:IOM>89 ?80,$E(ENL,1,9)
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
;ENFAR8
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAR8 5994 printed Dec 13, 2024@01:53:40 Page 2
ENFAR8 ;WIRMFO/SAB-FIXED ASSET RPT, EQUIP LOCATOR LIST FOR STATION ;1/18/2001
+1 ;;7.0;ENGINEERING;**29,33,50,63,69**;Aug 17, 1993
+2 ; Equipment Locator List for STATION
+3 ;
EN ;
+1 ; ask STATION
+2 SET DIR(0)="F^3:5"
SET DIR("A")="STATION NUMBER"
+3 SET DIR("B")=$$GET1^DIQ(6910,"1,",1)
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+5 SET ENSNR=Y
+6 ; ask about including not capitalized/accountable equipment
+7 SET DIR(0)="Y"
+8 SET DIR("A")="Include Not Capitalized/Accountable Equipment"
+9 SET DIR("B")="YES"
+10 SET DIR("?",1)="This report lists capitalized equipment on a CMR."
+11 SET DIR("?",2)=" "
+12 SET DIR("?",3)="Equipment with an Investment Category of NOT CAPITALIZED/ACCOUNTABLE"
+13 SET DIR("?",4)="can also be included in the output."
+14 SET DIR("?",6)=" "
+15 SET DIR("?")="Enter YES to list all accountable equipment."
+16 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+17 SET ENEXP=Y
+18 ; ask device
+19 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+20 IF $DATA(IO("Q"))
Begin DoDot:1
+21 SET ZTRTN="QEN^ENFAR8"
SET ZTDESC="Equipment List for Station"
+22 SET ZTSAVE("ENSNR")=""
SET ZTSAVE("ENEXP")=""
+23 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 ; default station number
SET ENSND=$$GET1^DIQ(6910,"1,",1)
+5 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6914,ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+6 SET ENSN=$PIECE($GET(^ENG(6914,ENDA,9)),U,5)
if ENSN=""
SET ENSN=ENSND
+7 ; not station
if ENSN'=ENSNR
QUIT
+8 SET ENY2=$GET(^ENG(6914,ENDA,2))
+9 SET X=$PIECE(ENY2,U,9)
SET ENCMR=$SELECT(X:$EXTRACT($PIECE($GET(^ENG(6914.1,X,0)),U),1,5),1:"")
+10 ; not on a CMR
if ENCMR=""
QUIT
+11 SET ENCSNI=$PIECE(ENY2,U,8)
+12 SET ENCSN=$SELECT(ENCSNI:$PIECE($GET(^ENCSN(6917,ENCSNI,0)),U),1:"")
+13 IF ENCSN=""
SET (ENCSN,ENCSNI)="<null value>"
+14 SET ENY8=$GET(^ENG(6914,ENDA,8))
+15 ; quit when not capitalized (or not accountable if user specified)
+16 if $SELECT(ENEXP
QUIT
+17 ;Q:'($P(ENY8,U,2)) ;*63
+18 ;Q:'($P(ENY8,U,2))&'(ENEXP&("^10^23^70^"[(U_$E(ENCSN,1,2)_U))) ;*50
+19 SET ^TMP($JOB,ENCSN,ENCMR,ENDA)=""
+20 IF $DATA(^TMP($JOB,ENCSN))#10=0
SET ^TMP($JOB,ENCSN)=ENCSNI
End DoDot:1
+21 ; generate output
+22 KILL ENT
+23 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDT=Y
+24 SET ENL=""
SET $PIECE(ENL,"-",IOM)=""
+25 SET ENCSN=""
DO HD
+26 IF 'END
FOR
SET ENCSN=$ORDER(^TMP($JOB,ENCSN))
if ENCSN=""
QUIT
Begin DoDot:1
+27 ; category stock number
+28 ; initialize CSN count and value
SET ENC="0^0"
+29 SET ENCSNI=$PIECE($GET(^TMP($JOB,ENCSN)),U)
+30 IF $Y+4>IOSL
DO HD
if END
QUIT
+31 WRITE !!
if ENCSNI
WRITE $PIECE($GET(^ENCSN(6917,ENCSNI,0)),U,3)
WRITE " (CSN: ",ENCSN,")"
+32 SET ENCMR=""
FOR
SET ENCMR=$ORDER(^TMP($JOB,ENCSN,ENCMR))
if ENCMR=""
QUIT
Begin DoDot:2
+33 ; cmr
+34 SET ENDA=0
FOR
SET ENDA=$ORDER(^TMP($JOB,ENCSN,ENCMR,ENDA))
if 'ENDA
QUIT
Begin DoDot:3
+35 ; equipment item
+36 SET ENY2=$GET(^ENG(6914,ENDA,2))
+37 SET X=$PIECE($GET(^ENG(6914,ENDA,8)),U,6)
+38 SET ENSGL=$SELECT(X:$PIECE($GET(^ENG(6914.3,X,0)),U),1:"")
+39 SET ENFUND=$$GET1^DIQ(6914,ENDA,62)
+40 ; number of lines needed to print item
SET ENI=5
+41 SET ENPM=$PIECE($GET(^ENG(6914,ENDA,3)),U,6)
if ENPM]""
SET ENI=ENI+1
+42 SET ENMAN=$EXTRACT($$GET1^DIQ(6914,ENDA_",",1),1,30)
if ENMAN]""
SET ENI=ENI+1
+43 SET ENMOD=$PIECE($GET(^ENG(6914,ENDA,1)),U,2)
if ENMOD]""
SET ENI=ENI+1
+44 SET ENSERIAL=$PIECE($GET(^ENG(6914,ENDA,1)),U,3)
if ENSERIAL]""
SET ENI=ENI+1
+45 IF IOM'>89
IF $PIECE(ENY2,U,13)]""
SET ENI=ENI+1
+46 IF $Y+ENI>IOSL
DO HD
if END
QUIT
DO HDCSN
+47 ; equipment id
WRITE !!,?1,ENDA
+48 ; acq date
WRITE ?12,$EXTRACT($PIECE(ENY2,U,4),4,5),?14,"/",$EXTRACT($PIECE(ENY2,U,4),2,3)
+49 ; fund
WRITE ?18,ENFUND
+50 ; sgl
WRITE ?25,ENSGL
+51 ; asset value
WRITE ?30,$JUSTIFY("$"_$FNUMBER($PIECE(ENY2,U,3),",",2),14)
+52 ; le
WRITE ?45,$PIECE(ENY2,U,6)
+53 ; repl
WRITE ?48,$EXTRACT($PIECE(ENY2,U,10),4,5),?50,"/",$EXTRACT($PIECE(ENY2,U,10),2,3)
+54 ; location
WRITE ?54,$$GET1^DIQ(6914,ENDA,24)
+55 ; cmr
WRITE ?74,ENCMR
+56 IF IOM>89
IF $PIECE(ENY2,U,13)]""
WRITE ?80,$$FMTE^XLFDT($PIECE(ENY2,U,13),2)
+57 if ENPM]""
WRITE !,?4,"PM: ",ENPM
+58 if ENMAN]""
WRITE !,?4,"Manf: ",ENMAN
+59 if ENMOD]""
WRITE !,?4,"Model: ",ENMOD
+60 if ENSERIAL]""
WRITE !,?4,"S/N: ",ENSERIAL
+61 IF IOM'>89
IF $PIECE(ENY2,U,13)]""
WRITE !,?4,"Last Inv. Date: ",$$FMTE^XLFDT($PIECE(ENY2,U,13),2)
+62 if ENSGL=""
SET ENSGL="<null>"
+63 SET $PIECE(ENT(ENSGL),U)=$PIECE($GET(ENT(ENSGL)),U)+1
+64 SET $PIECE(ENT(ENSGL),U,2)=$PIECE($GET(ENT(ENSGL)),U,2)+$PIECE(ENY2,U,3)
+65 SET $PIECE(ENC,U)=$PIECE($GET(ENC),U)+1
+66 SET $PIECE(ENC,U,2)=$PIECE($GET(ENC),U,2)+$PIECE(ENY2,U,3)
End DoDot:3
if END
QUIT
End DoDot:2
if END
QUIT
+67 if END
QUIT
+68 WRITE !,?13,"(CSN TOTAL",?24,$JUSTIFY("#"_$PIECE(ENC,U),3)
+69 WRITE ?30,$JUSTIFY("$"_$FNUMBER($PIECE(ENC,U,2),",",2),14),")"
End DoDot:1
if END
QUIT
+70 IF END
WRITE !!,"REPORT STOPPED BY USER REQUEST"
+71 IF '$TEST
Begin DoDot:1
+72 ; report footer
+73 SET ENSGL=""
SET ENC=0
FOR
SET ENSGL=$ORDER(ENT(ENSGL))
if ENSGL=""
QUIT
SET ENC=ENC+1
+74 IF $Y+ENC+6>IOSL
DO HD
if END
QUIT
+75 WRITE !,ENL,!,"TOTALS",?20,"COUNT",?30,"ASSET VALUE"
+76 SET ENT="0^0"
+77 SET ENSGL=""
FOR
SET ENSGL=$ORDER(ENT(ENSGL))
if ENSGL=""
QUIT
Begin DoDot:2
+78 WRITE !,?9,"SGL ",ENSGL
+79 WRITE ?20,$JUSTIFY($PIECE(ENT(ENSGL),U),5)
+80 WRITE ?30,"$",$JUSTIFY($FNUMBER($PIECE(ENT(ENSGL),U,2),",",2),15)
+81 SET $PIECE(ENT,U)=$PIECE(ENT,U)+$PIECE(ENT(ENSGL),U)
+82 SET $PIECE(ENT,U,2)=$PIECE(ENT,U,2)+$PIECE(ENT(ENSGL),U,2)
End DoDot:2
+83 WRITE !,?20,"-----",?30,"----------------"
+84 WRITE !,?6,"REPORT TOTAL"
+85 WRITE ?20,$JUSTIFY($PIECE(ENT,U),5)
+86 WRITE ?30,"$",$JUSTIFY($FNUMBER($PIECE(ENT,U,2),",",2),15)
+87 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+88 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,ENFUND,ENI,ENMAN,ENMOD,ENPM
+4 KILL ENSERIAL,ENSGL,ENSN,ENSND,ENSNR,ENT,ENY2
+5 KILL END,ENDT,ENL,ENPG
+6 QUIT
HD ; header
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET END=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+4 SET ENPG=ENPG+1
+5 WRITE !,$SELECT(ENEXP:"ACCOUNTABLE",1:"CAPITALIZED")," NX EQUIP. FOR STATION: "
+6 WRITE ENSNR,?48,ENDT,?72,"page ",ENPG
+7 WRITE !!,?1,"EQUIPMENT",?12,"ACQ",?18,"FUND",?25,"SGL",?30,"ASSET VALUE"
+8 WRITE ?45,"LE",?48,"REPL",?54,"LOCATION",?74,"CMR"
+9 if IOM>89
WRITE ?80,"INVENTORY"
+10 WRITE !,?1,"ENTRY #",?12,"DATE",?48,"DATE",?54,"ROOM-BLDG-DIV"
+11 if IOM>89
WRITE ?80,"DATE"
+12 WRITE !,?1,$EXTRACT(ENL,1,10),?12,$EXTRACT(ENL,1,5),?18,$EXTRACT(ENL,1,6),?25,$EXTRACT(ENL,1,4)
+13 WRITE ?30,$EXTRACT(ENL,1,14),?45,$EXTRACT(ENL,1,2),?48,$EXTRACT(ENL,1,5),?54,$EXTRACT(ENL,1,19)
+14 WRITE ?74,$EXTRACT(ENL,1,5)
+15 if IOM>89
WRITE ?80,$EXTRACT(ENL,1,9)
+16 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 ;ENFAR8
