- ENFAR4 ;WIRMFO/SAB-FIXED ASSET RPT, CAPITALIZED EQUIP FOR STATION; 3/11/96
- ;;7.0;ENGINEERING;**25**;Aug 17, 1993
- ; Capitalized Equipment List for STATION by CSN and CMR
- ;
- 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 device
- S %ZIS="QM" D ^%ZIS G:POP EXIT
- I $D(IO("Q")) D G EXIT
- . S ZTRTN="QEN^ENFAR4",ZTDESC="Capitalized Equip for Station"
- . S ZTSAVE("ENSNR")=""
- . 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
- . Q:$P($G(^ENG(6914,ENDA,8)),U,2)'=1 ; not capitalized
- . 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 ^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
- . . . I $Y+8>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 ; equipment id
- . . . W ?13,$P(ENY2,U,7) ; NXRN
- . . . W ?22,$E($P(ENY2,U,4),4,5),?24,"/",$E($P(ENY2,U,4),2,3) ; acq date
- . . . W ?28,ENSGL ; sgl
- . . . W ?33,$J("$"_$FN($P(ENY2,U,3),",",2),14) ; asset value
- . . . W ?48,$P(ENY2,U,6) ; le
- . . . W ?51,$E($P(ENY2,U,10),4,5),?53,"/",$E($P(ENY2,U,10),2,3) ; repl
- . . . W ?57,$E($P($G(^ENG(6914,ENDA,1)),U,3),1,16) ; serial #
- . . . W ?74,ENCMR ; cmr
- . . . 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)
- . . . 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 !,?16,"(CSN TOTAL",?27,$J("#"_$P(ENC,U),3)
- . W ?33,$J("$"_$FN($P(ENC,U,2),",",2),14),")"
- 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)
- . W ?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
- K 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 !,"CAPITALIZED EQUIPMENT BY CSN FOR STATION: ",ENSNR
- W ?48,ENDT,?72,"page ",ENPG
- W !!,?2,"EQUIP ID #",?13,"NXRN",?22,"ACQ",?28,"SGL",?33,"ASSET VALUE"
- W ?48,"LE",?51,"REPL",?57,"SERIAL NUMBER",?74,"CMR"
- W !,?2,$E(ENL,1,10),?13,$E(ENL,1,8),?22,$E(ENL,1,5),?28,$E(ENL,1,4)
- W ?33,$E(ENL,1,14),?48,$E(ENL,1,2),?51,$E(ENL,1,5),?57,$E(ENL,1,16)
- W ?74,$E(ENL,1,5)
- 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
- ;ENFAR4
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAR4 4596 printed Feb 18, 2025@23:19:58 Page 2
- ENFAR4 ;WIRMFO/SAB-FIXED ASSET RPT, CAPITALIZED EQUIP FOR STATION; 3/11/96
- +1 ;;7.0;ENGINEERING;**25**;Aug 17, 1993
- +2 ; Capitalized Equipment List for STATION by CSN and CMR
- +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 device
- +7 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO EXIT
- +8 IF $DATA(IO("Q"))
- Begin DoDot:1
- +9 SET ZTRTN="QEN^ENFAR4"
- SET ZTDESC="Capitalized Equip for Station"
- +10 SET ZTSAVE("ENSNR")=""
- +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 ; 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 ; not capitalized
- if $PIECE($GET(^ENG(6914,ENDA,8)),U,2)'=1
- QUIT
- +7 SET ENSN=$PIECE($GET(^ENG(6914,ENDA,9)),U,5)
- if ENSN=""
- SET ENSN=ENSND
- +8 ; not station
- if ENSN'=ENSNR
- QUIT
- +9 SET ENY2=$GET(^ENG(6914,ENDA,2))
- +10 SET X=$PIECE(ENY2,U,9)
- SET ENCMR=$SELECT(X:$EXTRACT($PIECE($GET(^ENG(6914.1,X,0)),U),1,5),1:"")
- +11 ; not on a CMR
- if ENCMR=""
- QUIT
- +12 SET ENCSNI=$PIECE(ENY2,U,8)
- +13 SET ENCSN=$SELECT(ENCSNI:$PIECE($GET(^ENCSN(6917,ENCSNI,0)),U),1:"")
- +14 IF ENCSN=""
- SET (ENCSN,ENCSNI)="<null value>"
- +15 SET ^TMP($JOB,ENCSN,ENCMR,ENDA)=""
- +16 IF $DATA(^TMP($JOB,ENCSN))#10=0
- SET ^TMP($JOB,ENCSN)=ENCSNI
- End DoDot:1
- +17 ; generate output
- +18 KILL ENT
- +19 SET (END,ENPG)=0
- DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET ENDT=Y
- +20 SET ENL=""
- SET $PIECE(ENL,"-",IOM)=""
- +21 SET ENCSN=""
- DO HD
- +22 IF 'END
- FOR
- SET ENCSN=$ORDER(^TMP($JOB,ENCSN))
- if ENCSN=""
- QUIT
- Begin DoDot:1
- +23 ; category stock number
- +24 ; initialize CSN count and value
- SET ENC="0^0"
- +25 SET ENCSNI=$PIECE($GET(^TMP($JOB,ENCSN)),U)
- +26 IF $Y+4>IOSL
- DO HD
- if END
- QUIT
- +27 WRITE !!
- if ENCSNI
- WRITE $PIECE($GET(^ENCSN(6917,ENCSNI,0)),U,3)
- WRITE " (CSN: ",ENCSN,")"
- +28 SET ENCMR=""
- FOR
- SET ENCMR=$ORDER(^TMP($JOB,ENCSN,ENCMR))
- if ENCMR=""
- QUIT
- Begin DoDot:2
- +29 ; cmr
- +30 SET ENDA=0
- FOR
- SET ENDA=$ORDER(^TMP($JOB,ENCSN,ENCMR,ENDA))
- if 'ENDA
- QUIT
- Begin DoDot:3
- +31 ; equipment item
- +32 IF $Y+8>IOSL
- DO HD
- if END
- QUIT
- DO HDCSN
- +33 SET ENY2=$GET(^ENG(6914,ENDA,2))
- +34 SET X=$PIECE($GET(^ENG(6914,ENDA,8)),U,6)
- +35 SET ENSGL=$SELECT(X:$PIECE($GET(^ENG(6914.3,X,0)),U),1:"")
- +36 ; equipment id
- WRITE !!,?2,ENDA
- +37 ; NXRN
- WRITE ?13,$PIECE(ENY2,U,7)
- +38 ; acq date
- WRITE ?22,$EXTRACT($PIECE(ENY2,U,4),4,5),?24,"/",$EXTRACT($PIECE(ENY2,U,4),2,3)
- +39 ; sgl
- WRITE ?28,ENSGL
- +40 ; asset value
- WRITE ?33,$JUSTIFY("$"_$FNUMBER($PIECE(ENY2,U,3),",",2),14)
- +41 ; le
- WRITE ?48,$PIECE(ENY2,U,6)
- +42 ; repl
- WRITE ?51,$EXTRACT($PIECE(ENY2,U,10),4,5),?53,"/",$EXTRACT($PIECE(ENY2,U,10),2,3)
- +43 ; serial #
- WRITE ?57,$EXTRACT($PIECE($GET(^ENG(6914,ENDA,1)),U,3),1,16)
- +44 ; cmr
- WRITE ?74,ENCMR
- +45 SET ENPM=$PIECE($GET(^ENG(6914,ENDA,3)),U,6)
- +46 if ENPM]""
- WRITE !,?4,"PM: ",ENPM
- +47 SET ENMAN=$EXTRACT($$GET1^DIQ(6914,ENDA_",",1),1,30)
- +48 if ENMAN]""
- WRITE !,?4,"Manf: ",ENMAN
- +49 SET ENMOD=$PIECE($GET(^ENG(6914,ENDA,1)),U,2)
- +50 if ENMOD]""
- WRITE !,?4,"Model: ",ENMOD
- +51 if ENSGL=""
- SET ENSGL="<null>"
- +52 SET $PIECE(ENT(ENSGL),U)=$PIECE($GET(ENT(ENSGL)),U)+1
- +53 SET $PIECE(ENT(ENSGL),U,2)=$PIECE($GET(ENT(ENSGL)),U,2)+$PIECE(ENY2,U,3)
- +54 SET $PIECE(ENC,U)=$PIECE($GET(ENC),U)+1
- +55 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
- +56 if END
- QUIT
- +57 WRITE !,?16,"(CSN TOTAL",?27,$JUSTIFY("#"_$PIECE(ENC,U),3)
- +58 WRITE ?33,$JUSTIFY("$"_$FNUMBER($PIECE(ENC,U,2),",",2),14),")"
- End DoDot:1
- if END
- QUIT
- +59 IF 'END
- Begin DoDot:1
- +60 ; report footer
- +61 SET ENSGL=""
- SET ENC=0
- FOR
- SET ENSGL=$ORDER(ENT(ENSGL))
- if ENSGL=""
- QUIT
- SET ENC=ENC+1
- +62 IF $Y+ENC+6>IOSL
- DO HD
- if END
- QUIT
- +63 WRITE !,ENL,!,"TOTALS",?19,"COUNT",?27,"ASSET VALUE"
- +64 SET ENT="0^0"
- +65 SET ENSGL=""
- FOR
- SET ENSGL=$ORDER(ENT(ENSGL))
- if ENSGL=""
- QUIT
- Begin DoDot:2
- +66 WRITE !,?8,"SGL ",ENSGL
- +67 WRITE ?19,$JUSTIFY($PIECE(ENT(ENSGL),U),5)
- +68 WRITE ?27,"$",$JUSTIFY($FNUMBER($PIECE(ENT(ENSGL),U,2),",",2),15)
- +69 SET $PIECE(ENT,U)=$PIECE(ENT,U)+$PIECE(ENT(ENSGL),U)
- +70 SET $PIECE(ENT,U,2)=$PIECE(ENT,U,2)+$PIECE(ENT(ENSGL),U,2)
- End DoDot:2
- +71 WRITE !,?19,"-----",?27,"----------------"
- +72 WRITE !,?5,"REPORT TOTAL"
- +73 WRITE ?19,$JUSTIFY($PIECE(ENT,U),5)
- +74 WRITE ?27,"$",$JUSTIFY($FNUMBER($PIECE(ENT,U,2),",",2),15)
- +75 IF $EXTRACT(IOST,1,2)="C-"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +76 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
- +4 KILL 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 !,"CAPITALIZED EQUIPMENT BY CSN FOR STATION: ",ENSNR
- +6 WRITE ?48,ENDT,?72,"page ",ENPG
- +7 WRITE !!,?2,"EQUIP ID #",?13,"NXRN",?22,"ACQ",?28,"SGL",?33,"ASSET VALUE"
- +8 WRITE ?48,"LE",?51,"REPL",?57,"SERIAL NUMBER",?74,"CMR"
- +9 WRITE !,?2,$EXTRACT(ENL,1,10),?13,$EXTRACT(ENL,1,8),?22,$EXTRACT(ENL,1,5),?28,$EXTRACT(ENL,1,4)
- +10 WRITE ?33,$EXTRACT(ENL,1,14),?48,$EXTRACT(ENL,1,2),?51,$EXTRACT(ENL,1,5),?57,$EXTRACT(ENL,1,16)
- +11 WRITE ?74,$EXTRACT(ENL,1,5)
- +12 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 ;ENFAR4