- 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 Jan 18, 2025@02:54:20 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