Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ENEQRPI

ENEQRPI.m

Go to the documentation of this file.
  1. ENEQRPI ;(WCIOFO)/DH,SAB-Equipment Inventory Listings ;10/12/1999
  1. ;;7.0;ENGINEERING;**19,21,39,50,60,63**;Aug 17, 1993
  1. ;
  1. HDR W @IOF,!!,"INVENTORY LISTING",!,"Version ",^ENG("VERSION"),! Q
  1. OUT K EN,ENSND Q
  1. ;
  1. COM S DIC="^ENG(6914,",L=0
  1. S DIOEND="I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
  1. 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]"
  1. E S FLDS="[ENEQ EQUIP. LIST]"
  1. Q
  1. ;
  1. DTYP ;List by EQUIPMENT CATEGORY
  1. D COM S BY="#6" D EN1^DIP G OUT
  1. ;
  1. LOC ;List by LOCATION
  1. D COM S BY=$S($D(^DIBT("B","ENZ LOCATION")):"[ENZ LOCATION]",1:"[EN LOCATION]") D EN1^DIP G OUT
  1. ;
  1. SRV ;List by SERVICE POINTER
  1. D COM S BY="#21" D EN1^DIP G OUT
  1. ;
  1. SHOP ;List by RESPONSIBLE SHOP
  1. 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."
  1. D COM S BY="#30,.01" D EN1^DIP G OUT
  1. ;
  1. STUS ;List by USE STATUS
  1. D COM S BY="#19,20" D EN1^DIP G OUT
  1. CMR ;Official CMR listing
  1. ; input- (optional) $D(ENNXEXP) true when Non-Expendable Expensed rpt
  1. S ENSND=$P($G(^DIC(6910,1,0)),U,2) ; default station #
  1. I ENSND="" W !!,*7,"The Eng Init Parameters File must contain a STATION NUMBER. Can't proceed." G OUT
  1. S DIC="^ENG(6914.1,",DIC(0)="AEQM",DIC("A")="Start WITH: "
  1. D ^DIC K DIC G:+Y'>0 OUT
  1. S EN("FR")=$P(^ENG(6914.1,+Y,0),U),EN("CMR",0)=+Y
  1. CMR1 ; ask go to
  1. K EN("TO")
  1. R !,"Go TO: ",X:DTIME G:X=""!($E(X)=U) OUT
  1. I X=" " S EN("TO")=EN("FR") W " "_EN("TO")
  1. I '$D(EN("TO")),$E(X)'="?" S:X]EN("FR")!(X=EN("FR")) EN("TO")=X
  1. I '$D(EN("TO")) W $C(7),!!,"Please enter a CMR that does not preceed "_EN("FR")_"." G CMR1
  1. ; if range then ask station number
  1. S EN("STA")="ALL" I EN("TO")]EN("FR") D G:$D(DIRUT) OUT
  1. . S DIR(0)="Y"
  1. . S DIR("A")="Do you want to just print CMRs for a specific station"
  1. . S DIR("B")="NO"
  1. . S DIR("?",1)="Answer YES if you only want to print CMRs that have a"
  1. . S DIR("?",2)="specific value in their station number field. If the"
  1. . S DIR("?",3)="CMR's station number is blank, then it will be assumed"
  1. . S DIR("?",4)="to be "_ENSND_"."
  1. . S DIR("?",5)=" "
  1. . S DIR("?")="Enter either 'Y' or 'N'."
  1. . D ^DIR K DIR Q:'Y!$D(DIRUT)
  1. . S DIR(0)="6914.1,5",DA=EN("CMR",0)
  1. . D ^DIR K DIR Q:$D(DIRUT)
  1. . S EN("STA")=Y
  1. ; ask comments
  1. S DIR(0)="Y",DIR("A")="Should the COMMENTS field be printed"
  1. S DIR("B")="NO"
  1. D ^DIR K DIR G:$D(DIRUT) OUT S EN("COM")=Y
  1. ; ask device
  1. D DEV^ENLIB G:POP OUT
  1. I $D(IO("Q")) D G OUT
  1. . S ZTRTN="CMR1A^ENEQRPI",ZTDESC="CMR LISTING"
  1. . S ZTSAVE("ENNXEXP")=""
  1. . S ZTSAVE("EN(""FR"")")="",ZTSAVE("EN(""TO"")")=""
  1. . S ZTSAVE("EN(""STA"")")="",ZTSAVE("EN(""COM"")")=""
  1. . S ZTSAVE("ENSND")="",ZTSAVE("EN(""CMR"",0)")=""
  1. . D ^%ZTLOAD K ZTSK D HOME^%ZIS
  1. CMR1A ; queued entry point
  1. S EN("IOP")=ION
  1. S EN("CMR")=EN("FR")
  1. I EN("STA")'="ALL" D I EN("CMR",5)'=EN("STA") G CMR2A
  1. . S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("CMR",0),5) ; station number
  1. . I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
  1. CMR2 ; cmr loop
  1. S DIC="^ENG(6914,",L=0
  1. S IOP=EN("IOP"),BY=$S($D(^DIBT("B","ENZCMR")):"[ENZCMR]",1:"[ENCMR]")
  1. I '$D(ENNXEXP) D ; CMR report
  1. . I EN("COM") S FLDS=$S($D(^DIPT("B","ENZCMRC")):"[ENZ",1:"[EN")_"CMRC]"
  1. . E S FLDS=$S($D(^DIPT("B","ENZCMR")):"[ENZ",1:"[EN")_"CMR]"
  1. . S DHD=$S($D(^DIPT("B","ENZCMR HD")):"[ENZCMR HD]",1:"[ENCMR HD]")
  1. . S DHIT="D CMRCMP^ENEQRPI,CMRTOT^ENEQRPI"
  1. . 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"
  1. . ; accountable equipment only (patch EN*7*63)
  1. . S DIS(0)="I ""^1^A^""[(U_$P($G(^ENG(6914,D0,8)),U,2)_U)"
  1. . ;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
  1. I $D(ENNXEXP) D ; NON-EXPENDABLE (EXPENSED) report
  1. . I EN("COM") S FLDS=$S($D(^DIPT("B","ENZEXPC")):"[ENZ",1:"[EN")_"EXPC]"
  1. . E S FLDS=$S($D(^DIPT("B","ENZEXP")):"[ENZ",1:"[EN")_"EXP]"
  1. . S DHD=$S($D(^DIPT("B","ENZEXP HD")):"[ENZEXP HD]",1:"[ENEXP HD]")
  1. . S DHIT="D CMRCMP^ENEQRPI"
  1. . S DIOEND="I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
  1. . ; only not accountable (patch EN*7*63)
  1. . S DIS(0)="I ""^1^A^""'[(U_$P($G(^ENG(6914,D0,8)),U,2)_U)"
  1. . ;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
  1. S (TO,FR)=EN("CMR")
  1. S EN("CMR",0)=$O(^ENG(6914.1,"B",EN("CMR"),0)) ; CMR ien
  1. S EN("CMR",.5)=$$GET1^DIQ(6914.1,EN("CMR",0),.5) ; service
  1. S EN("CMR",.6)=$$GET1^DIQ(6914.1,EN("CMR",0),.6) ; brief desc
  1. S EN("CMR",1)=$$GET1^DIQ(6914.1,EN("CMR",0),1) ; resp official
  1. S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("CMR",0),5) ; station number
  1. I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
  1. S EN("CMR","HD")=EN("CMR")
  1. S:EN("CMR",.5)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",.5)_" SERVICE"
  1. S:EN("CMR",.6)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",.6)
  1. S:EN("CMR",1)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",1)
  1. K ENCSN,ENT D EN1^DIP K ENCSN,ENT
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 G OUT ; aborted by user request
  1. CMR2A ; determine next CMR in loop (use B1 x-ref for acsii collating sequence)
  1. S EN("X")=$O(^ENG(6914.1,"B1",$E(EN("CMR"),1,29)_" "))
  1. S EN("I")=$S(EN("X")]"":$O(^ENG(6914.1,"B1",EN("X"),0)),1:"")
  1. S EN("CMR")=$S(EN("I"):$P($G(^ENG(6914.1,EN("I"),0)),U),1:"")
  1. I EN("CMR")=""!(EN("CMR")]EN("TO")) G OUT
  1. I EN("STA")'="ALL" D I EN("STA")'=EN("CMR",5) G CMR2A
  1. . S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("I"),5) ; station #
  1. . I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
  1. 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
  1. G CMR2
  1. ;
  1. CMRNOM ; Print CSN Nomenclature on CMR (called from ENCMR print template)
  1. Q:'$D(D0)
  1. I '$D(ENCSN) S ENCSN=$P($G(^ENG(6914,D0,2)),U,8) D CMRNOMP Q
  1. Q:$P($G(^ENG(6914,D0,2)),U,8)=ENCSN
  1. S ENCSN=$P($G(^ENG(6914,D0,2)),U,8) D CMRNOMP
  1. Q
  1. CMRNOMP ; prints nomenclature when CSN changes
  1. Q:ENCSN=""
  1. Q:'$D(^ENCSN(6917,ENCSN,0))
  1. N X,DIWL,DIWR,DIWF,ENI
  1. K ^UTILITY($J,"W") S DIWL=1,DIWR=IOM,DIWF="W"
  1. W !!,"CATEGORY STOCK NUMBER: ",$P(^ENCSN(6917,ENCSN,0),U)
  1. W " (",$P(^ENCSN(6917,ENCSN,0),U,3),")"
  1. S ENI=0
  1. F S ENI=$O(^ENCSN(6917,ENCSN,1,ENI)) Q:'ENI I $D(^(ENI,0)) S X=^(0) D ^DIWP
  1. D ^DIWW
  1. Q
  1. CMRCMP ; List components of equipment on CMR (called by DHIT)
  1. Q:'$D(D0)
  1. N ENDA,ENVAL
  1. ; print components
  1. S ENDA=0
  1. F S ENDA=$O(^ENG(6914,"AE",D0,ENDA)) Q:'ENDA D
  1. . W ?9,"COMPONENT ENTRY #: ",ENDA
  1. . W ?40,$E($P($G(^ENG(6914,ENDA,0)),U,2),1,20)
  1. . S ENVAL=$P($G(^ENG(6914,ENDA,2)),U,3)
  1. . I ENVAL]"" W ?61,$J("$"_$FN(ENVAL,"",2),12) W ! Q
  1. . S ENVAL=$P($G(^ENG(6914,ENDA,2)),U,12)
  1. . I ENVAL]"" W ?61,$J("$"_$FN(ENVAL,"",2),12)," LEASE"
  1. . W !
  1. Q
  1. CMRTOT ; Maintain totals for CMR (called by DHIT)
  1. ; add value to totals
  1. ; input
  1. ; D0 - ien of equipment entry
  1. ; ENSND - default station number (from 6910)
  1. ; optional ENT(station,fund,sgl)=count^lease cost^asset value
  1. ; output
  1. ; ENT(
  1. Q:'$D(D0)
  1. N ENSN,ENFUND,ENSGL,ENY
  1. S ENY(2)=$G(^ENG(6914,D0,2))
  1. S ENY(8)=$G(^ENG(6914,D0,8))
  1. S ENY(9)=$G(^ENG(6914,D0,9))
  1. S ENSN=$P(ENY(9),U,5)
  1. I $P(ENY(8),U,2) S ENFUND=$P(ENY(9),U,7),ENSGL=$P(ENY(8),U,6)
  1. I '$P(ENY(8),U,2) S ENFUND="<null>",ENSGL=10
  1. I ENSN="",$G(ENSND)]"" S ENSN=ENSND
  1. S:ENSN="" ENSN="<null>"
  1. S:ENFUND="" ENFUND="<null>"
  1. S:ENSGL="" ENSGL="<null>"
  1. S $P(ENT(ENSN,ENFUND,ENSGL),U)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U)+1
  1. S $P(ENT(ENSN,ENFUND,ENSGL),U,2)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U,2)+$P(ENY(2),U,12)
  1. S $P(ENT(ENSN,ENFUND,ENSGL),U,3)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U,3)+$P(ENY(2),U,3)
  1. Q
  1. ;
  1. ;ENEQRPI