ENEQRPI ;(WCIOFO)/DH,SAB-Equipment Inventory Listings ;10/12/1999
;;7.0;ENGINEERING;**19,21,39,50,60,63**;Aug 17, 1993
;
HDR W @IOF,!!,"INVENTORY LISTING",!,"Version ",^ENG("VERSION"),! Q
OUT K EN,ENSND Q
;
COM S DIC="^ENG(6914,",L=0
S DIOEND="I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
I $D(^ENG(6910.2,"B","INVENTORY TEMPLATE")) S I=$O(^("INVENTORY TEMPLATE",0)) I I>0,$P(^ENG(6910.2,I,0),U,2)="L",$D(^DIPT("B","ENZEQ EQUIP. LIST")) S FLDS="[ENZEQ EQUIP. LIST]"
E S FLDS="[ENEQ EQUIP. LIST]"
Q
;
DTYP ;List by EQUIPMENT CATEGORY
D COM S BY="#6" D EN1^DIP G OUT
;
LOC ;List by LOCATION
D COM S BY=$S($D(^DIBT("B","ENZ LOCATION")):"[ENZ LOCATION]",1:"[EN LOCATION]") D EN1^DIP G OUT
;
SRV ;List by SERVICE POINTER
D COM S BY="#21" D EN1^DIP G OUT
;
SHOP ;List by RESPONSIBLE SHOP
W !!,"Important note: SHOP NAME(S) MUST BE ENTERED IN RESPONSE TO THE 'START WITH'",!,"AND 'GO TO' PROMPTS. NUMBERS WILL NOT BE UNDERSTOOD BY THE SORT LOGIC."
D COM S BY="#30,.01" D EN1^DIP G OUT
;
STUS ;List by USE STATUS
D COM S BY="#19,20" D EN1^DIP G OUT
CMR ;Official CMR listing
; input- (optional) $D(ENNXEXP) true when Non-Expendable Expensed rpt
S ENSND=$P($G(^DIC(6910,1,0)),U,2) ; default station #
I ENSND="" W !!,*7,"The Eng Init Parameters File must contain a STATION NUMBER. Can't proceed." G OUT
S DIC="^ENG(6914.1,",DIC(0)="AEQM",DIC("A")="Start WITH: "
D ^DIC K DIC G:+Y'>0 OUT
S EN("FR")=$P(^ENG(6914.1,+Y,0),U),EN("CMR",0)=+Y
CMR1 ; ask go to
K EN("TO")
R !,"Go TO: ",X:DTIME G:X=""!($E(X)=U) OUT
I X=" " S EN("TO")=EN("FR") W " "_EN("TO")
I '$D(EN("TO")),$E(X)'="?" S:X]EN("FR")!(X=EN("FR")) EN("TO")=X
I '$D(EN("TO")) W $C(7),!!,"Please enter a CMR that does not preceed "_EN("FR")_"." G CMR1
; if range then ask station number
S EN("STA")="ALL" I EN("TO")]EN("FR") D G:$D(DIRUT) OUT
. S DIR(0)="Y"
. S DIR("A")="Do you want to just print CMRs for a specific station"
. S DIR("B")="NO"
. S DIR("?",1)="Answer YES if you only want to print CMRs that have a"
. S DIR("?",2)="specific value in their station number field. If the"
. S DIR("?",3)="CMR's station number is blank, then it will be assumed"
. S DIR("?",4)="to be "_ENSND_"."
. S DIR("?",5)=" "
. S DIR("?")="Enter either 'Y' or 'N'."
. D ^DIR K DIR Q:'Y!$D(DIRUT)
. S DIR(0)="6914.1,5",DA=EN("CMR",0)
. D ^DIR K DIR Q:$D(DIRUT)
. S EN("STA")=Y
; ask comments
S DIR(0)="Y",DIR("A")="Should the COMMENTS field be printed"
S DIR("B")="NO"
D ^DIR K DIR G:$D(DIRUT) OUT S EN("COM")=Y
; ask device
D DEV^ENLIB G:POP OUT
I $D(IO("Q")) D G OUT
. S ZTRTN="CMR1A^ENEQRPI",ZTDESC="CMR LISTING"
. S ZTSAVE("ENNXEXP")=""
. S ZTSAVE("EN(""FR"")")="",ZTSAVE("EN(""TO"")")=""
. S ZTSAVE("EN(""STA"")")="",ZTSAVE("EN(""COM"")")=""
. S ZTSAVE("ENSND")="",ZTSAVE("EN(""CMR"",0)")=""
. D ^%ZTLOAD K ZTSK D HOME^%ZIS
CMR1A ; queued entry point
S EN("IOP")=ION
S EN("CMR")=EN("FR")
I EN("STA")'="ALL" D I EN("CMR",5)'=EN("STA") G CMR2A
. S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("CMR",0),5) ; station number
. I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
CMR2 ; cmr loop
S DIC="^ENG(6914,",L=0
S IOP=EN("IOP"),BY=$S($D(^DIBT("B","ENZCMR")):"[ENZCMR]",1:"[ENCMR]")
I '$D(ENNXEXP) D ; CMR report
. I EN("COM") S FLDS=$S($D(^DIPT("B","ENZCMRC")):"[ENZ",1:"[EN")_"CMRC]"
. E S FLDS=$S($D(^DIPT("B","ENZCMR")):"[ENZ",1:"[EN")_"CMR]"
. S DHD=$S($D(^DIPT("B","ENZCMR HD")):"[ENZCMR HD]",1:"[ENCMR HD]")
. S DHIT="D CMRCMP^ENEQRPI,CMRTOT^ENEQRPI"
. S DIOEND="D:$D(ENT) SUM^ENEQCMR D:$D(ENCSN) SIG^ENEQCMR I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
. ; accountable equipment only (patch EN*7*63)
. S DIS(0)="I ""^1^A^""[(U_$P($G(^ENG(6914,D0,8)),U,2)_U)"
. ;S DIS(0)="I $P($G(^ENG(6914,D0,8)),U,2)!(""^10^23^70^""[(U_$S($P($G(^ENG(6914,D0,2)),U,8):$E($P($G(^ENCSN(6917,$P(^ENG(6914,D0,2),U,8),0)),U),1,2),1:"""")_U))" ; capitalized or adp, vech, or firearm
I $D(ENNXEXP) D ; NON-EXPENDABLE (EXPENSED) report
. I EN("COM") S FLDS=$S($D(^DIPT("B","ENZEXPC")):"[ENZ",1:"[EN")_"EXPC]"
. E S FLDS=$S($D(^DIPT("B","ENZEXP")):"[ENZ",1:"[EN")_"EXP]"
. S DHD=$S($D(^DIPT("B","ENZEXP HD")):"[ENZEXP HD]",1:"[ENEXP HD]")
. S DHIT="D CMRCMP^ENEQRPI"
. S DIOEND="I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
. ; only not accountable (patch EN*7*63)
. S DIS(0)="I ""^1^A^""'[(U_$P($G(^ENG(6914,D0,8)),U,2)_U)"
. ;S DIS(0)="I '$P($G(^ENG(6914,D0,8)),U,2)&'(""^10^23^70^""[(U_$S($P($G(^ENG(6914,D0,2)),U,8):$E($P($G(^ENCSN(6917,$P(^ENG(6914,D0,2),U,8),0)),U),1,2),1:"""")_U))" ; not capitalized and not adp, vech, or firearm
S (TO,FR)=EN("CMR")
S EN("CMR",0)=$O(^ENG(6914.1,"B",EN("CMR"),0)) ; CMR ien
S EN("CMR",.5)=$$GET1^DIQ(6914.1,EN("CMR",0),.5) ; service
S EN("CMR",.6)=$$GET1^DIQ(6914.1,EN("CMR",0),.6) ; brief desc
S EN("CMR",1)=$$GET1^DIQ(6914.1,EN("CMR",0),1) ; resp official
S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("CMR",0),5) ; station number
I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
S EN("CMR","HD")=EN("CMR")
S:EN("CMR",.5)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",.5)_" SERVICE"
S:EN("CMR",.6)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",.6)
S:EN("CMR",1)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",1)
K ENCSN,ENT D EN1^DIP K ENCSN,ENT
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 G OUT ; aborted by user request
CMR2A ; determine next CMR in loop (use B1 x-ref for acsii collating sequence)
S EN("X")=$O(^ENG(6914.1,"B1",$E(EN("CMR"),1,29)_" "))
S EN("I")=$S(EN("X")]"":$O(^ENG(6914.1,"B1",EN("X"),0)),1:"")
S EN("CMR")=$S(EN("I"):$P($G(^ENG(6914.1,EN("I"),0)),U),1:"")
I EN("CMR")=""!(EN("CMR")]EN("TO")) G OUT
I EN("STA")'="ALL" D I EN("STA")'=EN("CMR",5) G CMR2A
. S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("I"),5) ; station #
. I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
I ION=EN("IOP"),$E(IOST,1,2)="C-" S DIR(0)="Y",DIR("A")="Continue to another EIL ("_EN("CMR")_")",DIR("B")="YES" D ^DIR K DIR G:'Y OUT
G CMR2
;
CMRNOM ; Print CSN Nomenclature on CMR (called from ENCMR print template)
Q:'$D(D0)
I '$D(ENCSN) S ENCSN=$P($G(^ENG(6914,D0,2)),U,8) D CMRNOMP Q
Q:$P($G(^ENG(6914,D0,2)),U,8)=ENCSN
S ENCSN=$P($G(^ENG(6914,D0,2)),U,8) D CMRNOMP
Q
CMRNOMP ; prints nomenclature when CSN changes
Q:ENCSN=""
Q:'$D(^ENCSN(6917,ENCSN,0))
N X,DIWL,DIWR,DIWF,ENI
K ^UTILITY($J,"W") S DIWL=1,DIWR=IOM,DIWF="W"
W !!,"CATEGORY STOCK NUMBER: ",$P(^ENCSN(6917,ENCSN,0),U)
W " (",$P(^ENCSN(6917,ENCSN,0),U,3),")"
S ENI=0
F S ENI=$O(^ENCSN(6917,ENCSN,1,ENI)) Q:'ENI I $D(^(ENI,0)) S X=^(0) D ^DIWP
D ^DIWW
Q
CMRCMP ; List components of equipment on CMR (called by DHIT)
Q:'$D(D0)
N ENDA,ENVAL
; print components
S ENDA=0
F S ENDA=$O(^ENG(6914,"AE",D0,ENDA)) Q:'ENDA D
. W ?9,"COMPONENT ENTRY #: ",ENDA
. W ?40,$E($P($G(^ENG(6914,ENDA,0)),U,2),1,20)
. S ENVAL=$P($G(^ENG(6914,ENDA,2)),U,3)
. I ENVAL]"" W ?61,$J("$"_$FN(ENVAL,"",2),12) W ! Q
. S ENVAL=$P($G(^ENG(6914,ENDA,2)),U,12)
. I ENVAL]"" W ?61,$J("$"_$FN(ENVAL,"",2),12)," LEASE"
. W !
Q
CMRTOT ; Maintain totals for CMR (called by DHIT)
; add value to totals
; input
; D0 - ien of equipment entry
; ENSND - default station number (from 6910)
; optional ENT(station,fund,sgl)=count^lease cost^asset value
; output
; ENT(
Q:'$D(D0)
N ENSN,ENFUND,ENSGL,ENY
S ENY(2)=$G(^ENG(6914,D0,2))
S ENY(8)=$G(^ENG(6914,D0,8))
S ENY(9)=$G(^ENG(6914,D0,9))
S ENSN=$P(ENY(9),U,5)
I $P(ENY(8),U,2) S ENFUND=$P(ENY(9),U,7),ENSGL=$P(ENY(8),U,6)
I '$P(ENY(8),U,2) S ENFUND="<null>",ENSGL=10
I ENSN="",$G(ENSND)]"" S ENSN=ENSND
S:ENSN="" ENSN="<null>"
S:ENFUND="" ENFUND="<null>"
S:ENSGL="" ENSGL="<null>"
S $P(ENT(ENSN,ENFUND,ENSGL),U)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U)+1
S $P(ENT(ENSN,ENFUND,ENSGL),U,2)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U,2)+$P(ENY(2),U,12)
S $P(ENT(ENSN,ENFUND,ENSGL),U,3)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U,3)+$P(ENY(2),U,3)
Q
;
;ENEQRPI
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQRPI 8095 printed Apr 09, 2024@21:00:05 Page 2
ENEQRPI ;(WCIOFO)/DH,SAB-Equipment Inventory Listings ;10/12/1999
+1 ;;7.0;ENGINEERING;**19,21,39,50,60,63**;Aug 17, 1993
+2 ;
HDR WRITE @IOF,!!,"INVENTORY LISTING",!,"Version ",^ENG("VERSION"),!
QUIT
OUT KILL EN,ENSND
QUIT
+1 ;
COM SET DIC="^ENG(6914,"
SET L=0
+1 SET DIOEND="I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
+2 IF $DATA(^ENG(6910.2,"B","INVENTORY TEMPLATE"))
SET I=$ORDER(^("INVENTORY TEMPLATE",0))
IF I>0
IF $PIECE(^ENG(6910.2,I,0),U,2)="L"
IF $DATA(^DIPT("B","ENZEQ EQUIP. LIST"))
SET FLDS="[ENZEQ EQUIP. LIST]"
+3 IF '$TEST
SET FLDS="[ENEQ EQUIP. LIST]"
+4 QUIT
+5 ;
DTYP ;List by EQUIPMENT CATEGORY
+1 DO COM
SET BY="#6"
DO EN1^DIP
GOTO OUT
+2 ;
LOC ;List by LOCATION
+1 DO COM
SET BY=$SELECT($DATA(^DIBT("B","ENZ LOCATION")):"[ENZ LOCATION]",1:"[EN LOCATION]")
DO EN1^DIP
GOTO OUT
+2 ;
SRV ;List by SERVICE POINTER
+1 DO COM
SET BY="#21"
DO EN1^DIP
GOTO OUT
+2 ;
SHOP ;List by RESPONSIBLE SHOP
+1 WRITE !!,"Important note: SHOP NAME(S) MUST BE ENTERED IN RESPONSE TO THE 'START WITH'",!,"AND 'GO TO' PROMPTS. NUMBERS WILL NOT BE UNDERSTOOD BY THE SORT LOGIC."
+2 DO COM
SET BY="#30,.01"
DO EN1^DIP
GOTO OUT
+3 ;
STUS ;List by USE STATUS
+1 DO COM
SET BY="#19,20"
DO EN1^DIP
GOTO OUT
CMR ;Official CMR listing
+1 ; input- (optional) $D(ENNXEXP) true when Non-Expendable Expensed rpt
+2 ; default station #
SET ENSND=$PIECE($GET(^DIC(6910,1,0)),U,2)
+3 IF ENSND=""
WRITE !!,*7,"The Eng Init Parameters File must contain a STATION NUMBER. Can't proceed."
GOTO OUT
+4 SET DIC="^ENG(6914.1,"
SET DIC(0)="AEQM"
SET DIC("A")="Start WITH: "
+5 DO ^DIC
KILL DIC
if +Y'>0
GOTO OUT
+6 SET EN("FR")=$PIECE(^ENG(6914.1,+Y,0),U)
SET EN("CMR",0)=+Y
CMR1 ; ask go to
+1 KILL EN("TO")
+2 READ !,"Go TO: ",X:DTIME
if X=""!($EXTRACT(X)=U)
GOTO OUT
+3 IF X=" "
SET EN("TO")=EN("FR")
WRITE " "_EN("TO")
+4 IF '$DATA(EN("TO"))
IF $EXTRACT(X)'="?"
if X]EN("FR")!(X=EN("FR"))
SET EN("TO")=X
+5 IF '$DATA(EN("TO"))
WRITE $CHAR(7),!!,"Please enter a CMR that does not preceed "_EN("FR")_"."
GOTO CMR1
+6 ; if range then ask station number
+7 SET EN("STA")="ALL"
IF EN("TO")]EN("FR")
Begin DoDot:1
+8 SET DIR(0)="Y"
+9 SET DIR("A")="Do you want to just print CMRs for a specific station"
+10 SET DIR("B")="NO"
+11 SET DIR("?",1)="Answer YES if you only want to print CMRs that have a"
+12 SET DIR("?",2)="specific value in their station number field. If the"
+13 SET DIR("?",3)="CMR's station number is blank, then it will be assumed"
+14 SET DIR("?",4)="to be "_ENSND_"."
+15 SET DIR("?",5)=" "
+16 SET DIR("?")="Enter either 'Y' or 'N'."
+17 DO ^DIR
KILL DIR
if 'Y!$DATA(DIRUT)
QUIT
+18 SET DIR(0)="6914.1,5"
SET DA=EN("CMR",0)
+19 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+20 SET EN("STA")=Y
End DoDot:1
if $DATA(DIRUT)
GOTO OUT
+21 ; ask comments
+22 SET DIR(0)="Y"
SET DIR("A")="Should the COMMENTS field be printed"
+23 SET DIR("B")="NO"
+24 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO OUT
SET EN("COM")=Y
+25 ; ask device
+26 DO DEV^ENLIB
if POP
GOTO OUT
+27 IF $DATA(IO("Q"))
Begin DoDot:1
+28 SET ZTRTN="CMR1A^ENEQRPI"
SET ZTDESC="CMR LISTING"
+29 SET ZTSAVE("ENNXEXP")=""
+30 SET ZTSAVE("EN(""FR"")")=""
SET ZTSAVE("EN(""TO"")")=""
+31 SET ZTSAVE("EN(""STA"")")=""
SET ZTSAVE("EN(""COM"")")=""
+32 SET ZTSAVE("ENSND")=""
SET ZTSAVE("EN(""CMR"",0)")=""
+33 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO OUT
CMR1A ; queued entry point
+1 SET EN("IOP")=ION
+2 SET EN("CMR")=EN("FR")
+3 IF EN("STA")'="ALL"
Begin DoDot:1
+4 ; station number
SET EN("CMR",5)=$$GET1^DIQ(6914.1,EN("CMR",0),5)
+5 ; default station #
IF EN("CMR",5)=""
SET EN("CMR",5)=ENSND
End DoDot:1
IF EN("CMR",5)'=EN("STA")
GOTO CMR2A
CMR2 ; cmr loop
+1 SET DIC="^ENG(6914,"
SET L=0
+2 SET IOP=EN("IOP")
SET BY=$SELECT($DATA(^DIBT("B","ENZCMR")):"[ENZCMR]",1:"[ENCMR]")
+3 ; CMR report
IF '$DATA(ENNXEXP)
Begin DoDot:1
+4 IF EN("COM")
SET FLDS=$SELECT($DATA(^DIPT("B","ENZCMRC")):"[ENZ",1:"[EN")_"CMRC]"
+5 IF '$TEST
SET FLDS=$SELECT($DATA(^DIPT("B","ENZCMR")):"[ENZ",1:"[EN")_"CMR]"
+6 SET DHD=$SELECT($DATA(^DIPT("B","ENZCMR HD")):"[ENZCMR HD]",1:"[ENCMR HD]")
+7 SET DHIT="D CMRCMP^ENEQRPI,CMRTOT^ENEQRPI"
+8 SET DIOEND="D:$D(ENT) SUM^ENEQCMR D:$D(ENCSN) SIG^ENEQCMR I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
+9 ; accountable equipment only (patch EN*7*63)
+10 SET DIS(0)="I ""^1^A^""[(U_$P($G(^ENG(6914,D0,8)),U,2)_U)"
+11 ;S DIS(0)="I $P($G(^ENG(6914,D0,8)),U,2)!(""^10^23^70^""[(U_$S($P($G(^ENG(6914,D0,2)),U,8):$E($P($G(^ENCSN(6917,$P(^ENG(6914,D0,2),U,8),0)),U),1,2),1:"""")_U))" ; capitalized or adp, vech, or firearm
End DoDot:1
+12 ; NON-EXPENDABLE (EXPENSED) report
IF $DATA(ENNXEXP)
Begin DoDot:1
+13 IF EN("COM")
SET FLDS=$SELECT($DATA(^DIPT("B","ENZEXPC")):"[ENZ",1:"[EN")_"EXPC]"
+14 IF '$TEST
SET FLDS=$SELECT($DATA(^DIPT("B","ENZEXP")):"[ENZ",1:"[EN")_"EXP]"
+15 SET DHD=$SELECT($DATA(^DIPT("B","ENZEXP HD")):"[ENZEXP HD]",1:"[ENEXP HD]")
+16 SET DHIT="D CMRCMP^ENEQRPI"
+17 SET DIOEND="I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
+18 ; only not accountable (patch EN*7*63)
+19 SET DIS(0)="I ""^1^A^""'[(U_$P($G(^ENG(6914,D0,8)),U,2)_U)"
+20 ;S DIS(0)="I '$P($G(^ENG(6914,D0,8)),U,2)&'(""^10^23^70^""[(U_$S($P($G(^ENG(6914,D0,2)),U,8):$E($P($G(^ENCSN(6917,$P(^ENG(6914,D0,2),U,8),0)),U),1,2),1:"""")_U))" ; not capitalized and not adp, vech, or firearm
End DoDot:1
+21 SET (TO,FR)=EN("CMR")
+22 ; CMR ien
SET EN("CMR",0)=$ORDER(^ENG(6914.1,"B",EN("CMR"),0))
+23 ; service
SET EN("CMR",.5)=$$GET1^DIQ(6914.1,EN("CMR",0),.5)
+24 ; brief desc
SET EN("CMR",.6)=$$GET1^DIQ(6914.1,EN("CMR",0),.6)
+25 ; resp official
SET EN("CMR",1)=$$GET1^DIQ(6914.1,EN("CMR",0),1)
+26 ; station number
SET EN("CMR",5)=$$GET1^DIQ(6914.1,EN("CMR",0),5)
+27 ; default station #
IF EN("CMR",5)=""
SET EN("CMR",5)=ENSND
+28 SET EN("CMR","HD")=EN("CMR")
+29 if EN("CMR",.5)]""
SET EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",.5)_" SERVICE"
+30 if EN("CMR",.6)]""
SET EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",.6)
+31 if EN("CMR",1)]""
SET EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",1)
+32 KILL ENCSN,ENT
DO EN1^DIP
KILL ENCSN,ENT
+33 ; aborted by user request
IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
GOTO OUT
CMR2A ; determine next CMR in loop (use B1 x-ref for acsii collating sequence)
+1 SET EN("X")=$ORDER(^ENG(6914.1,"B1",$EXTRACT(EN("CMR"),1,29)_" "))
+2 SET EN("I")=$SELECT(EN("X")]"":$ORDER(^ENG(6914.1,"B1",EN("X"),0)),1:"")
+3 SET EN("CMR")=$SELECT(EN("I"):$PIECE($GET(^ENG(6914.1,EN("I"),0)),U),1:"")
+4 IF EN("CMR")=""!(EN("CMR")]EN("TO"))
GOTO OUT
+5 IF EN("STA")'="ALL"
Begin DoDot:1
+6 ; station #
SET EN("CMR",5)=$$GET1^DIQ(6914.1,EN("I"),5)
+7 ; default station #
IF EN("CMR",5)=""
SET EN("CMR",5)=ENSND
End DoDot:1
IF EN("STA")'=EN("CMR",5)
GOTO CMR2A
+8 IF ION=EN("IOP")
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="Y"
SET DIR("A")="Continue to another EIL ("_EN("CMR")_")"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
if 'Y
GOTO OUT
+9 GOTO CMR2
+10 ;
CMRNOM ; Print CSN Nomenclature on CMR (called from ENCMR print template)
+1 if '$DATA(D0)
QUIT
+2 IF '$DATA(ENCSN)
SET ENCSN=$PIECE($GET(^ENG(6914,D0,2)),U,8)
DO CMRNOMP
QUIT
+3 if $PIECE($GET(^ENG(6914,D0,2)),U,8)=ENCSN
QUIT
+4 SET ENCSN=$PIECE($GET(^ENG(6914,D0,2)),U,8)
DO CMRNOMP
+5 QUIT
CMRNOMP ; prints nomenclature when CSN changes
+1 if ENCSN=""
QUIT
+2 if '$DATA(^ENCSN(6917,ENCSN,0))
QUIT
+3 NEW X,DIWL,DIWR,DIWF,ENI
+4 KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=IOM
SET DIWF="W"
+5 WRITE !!,"CATEGORY STOCK NUMBER: ",$PIECE(^ENCSN(6917,ENCSN,0),U)
+6 WRITE " (",$PIECE(^ENCSN(6917,ENCSN,0),U,3),")"
+7 SET ENI=0
+8 FOR
SET ENI=$ORDER(^ENCSN(6917,ENCSN,1,ENI))
if 'ENI
QUIT
IF $DATA(^(ENI,0))
SET X=^(0)
DO ^DIWP
+9 DO ^DIWW
+10 QUIT
CMRCMP ; List components of equipment on CMR (called by DHIT)
+1 if '$DATA(D0)
QUIT
+2 NEW ENDA,ENVAL
+3 ; print components
+4 SET ENDA=0
+5 FOR
SET ENDA=$ORDER(^ENG(6914,"AE",D0,ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+6 WRITE ?9,"COMPONENT ENTRY #: ",ENDA
+7 WRITE ?40,$EXTRACT($PIECE($GET(^ENG(6914,ENDA,0)),U,2),1,20)
+8 SET ENVAL=$PIECE($GET(^ENG(6914,ENDA,2)),U,3)
+9 IF ENVAL]""
WRITE ?61,$JUSTIFY("$"_$FNUMBER(ENVAL,"",2),12)
WRITE !
QUIT
+10 SET ENVAL=$PIECE($GET(^ENG(6914,ENDA,2)),U,12)
+11 IF ENVAL]""
WRITE ?61,$JUSTIFY("$"_$FNUMBER(ENVAL,"",2),12)," LEASE"
+12 WRITE !
End DoDot:1
+13 QUIT
CMRTOT ; Maintain totals for CMR (called by DHIT)
+1 ; add value to totals
+2 ; input
+3 ; D0 - ien of equipment entry
+4 ; ENSND - default station number (from 6910)
+5 ; optional ENT(station,fund,sgl)=count^lease cost^asset value
+6 ; output
+7 ; ENT(
+8 if '$DATA(D0)
QUIT
+9 NEW ENSN,ENFUND,ENSGL,ENY
+10 SET ENY(2)=$GET(^ENG(6914,D0,2))
+11 SET ENY(8)=$GET(^ENG(6914,D0,8))
+12 SET ENY(9)=$GET(^ENG(6914,D0,9))
+13 SET ENSN=$PIECE(ENY(9),U,5)
+14 IF $PIECE(ENY(8),U,2)
SET ENFUND=$PIECE(ENY(9),U,7)
SET ENSGL=$PIECE(ENY(8),U,6)
+15 IF '$PIECE(ENY(8),U,2)
SET ENFUND="<null>"
SET ENSGL=10
+16 IF ENSN=""
IF $GET(ENSND)]""
SET ENSN=ENSND
+17 if ENSN=""
SET ENSN="<null>"
+18 if ENFUND=""
SET ENFUND="<null>"
+19 if ENSGL=""
SET ENSGL="<null>"
+20 SET $PIECE(ENT(ENSN,ENFUND,ENSGL),U)=$PIECE($GET(ENT(ENSN,ENFUND,ENSGL)),U)+1
+21 SET $PIECE(ENT(ENSN,ENFUND,ENSGL),U,2)=$PIECE($GET(ENT(ENSN,ENFUND,ENSGL)),U,2)+$PIECE(ENY(2),U,12)
+22 SET $PIECE(ENT(ENSN,ENFUND,ENSGL),U,3)=$PIECE($GET(ENT(ENSN,ENFUND,ENSGL)),U,3)+$PIECE(ENY(2),U,3)
+23 QUIT
+24 ;
+25 ;ENEQRPI
