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

ENLIB1.m

Go to the documentation of this file.
  1. ENLIB1 ;(WASH ISC)/DH-Package Utilities ;8/5/1998
  1. ;;7.0;ENGINEERING;**35,53**;Aug 17, 1993
  1. MNTH S:'$D(ENMN) ENMN="" I ENMN']"" S ENMNTH="" Q
  1. S ENMNTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",ENMN)
  1. Q
  1. RVMNTH I $D(ENMNTH),$L(ENMNTH)=3 S A=ENMNTH,ENMN=$S(A="JAN":1,A="FEB":2,A="MAR":3,A="APR":4,A="MAY":5,A="JUN":6,A="JUL":7,A="AUG":8,A="SEP":9,A="OCT":10,A="NOV":11,A="DEC":12,1:-1) K A Q
  1. S ENMN=-1
  1. Q
  1. RDMNTH S ENMN="" R !,"Select MONTH: ",X:DTIME I X?1.2N,X>0,X<13 S ENMN=+X
  1. I X="^" S ENMN=-1 Q
  1. I ENMN="",X?.U S X=$E(X,1,3),ENMN=$S(X="JAN":1,X="FEB":2,X="MAR":3,X="APR":4,X="MAY":5,X="JUN":6,X="JUL":7,X="AUG":8,X="SEP":9,X="OCT":10,X="NOV":11,X="DEC":12,1:"")
  1. I X?3U,ENMN]"" W " "_ENMN
  1. I ENMN="" W !,*7,"Enter month as an integer from 1 to 12." G RDMNTH
  1. Q
  1. WOCMP S E(1)=$S($D(^ENG(6920,DA,2)):^(2),1:""),E(2)=$P(E(1),U,1) K:E(2)'=35 E Q:$D(E(2))=0 S E=$S($D(^(3)):^(3),1:"") F E(3)=3,6,7,9 K:$P(E,U,E(3))="" X I E(3)=9 K E
  1. Q
  1. ;
  1. TECH ;Set ASSIGNED TECH from PRIMARY TECH
  1. ; called by File 6920 Field 16 "AG" cross-reference set logic
  1. ; Input DA = work order ien
  1. ; X = entered primary technican (pointer to file 6929)
  1. ; This code puts a newly entered primary techinician into the
  1. ; TECHNICIANS ASSIGNED multiple if not already there.
  1. N EN1,ENR,ENFNO,ENNXL,ENNXT
  1. Q:'$D(^ENG(6920,DA,2))
  1. S EN1=$P(^ENG(6920,DA,2),U,2) Q:EN1=""
  1. I '$D(^ENG("EMP",EN1,0)) Q
  1. I '$D(^ENG(6920,DA,7,0)) S ^ENG(6920,DA,7,0)="^6920.02PA^1^1",^ENG(6920,DA,7,1,0)=EN1_"^^"_$P(^ENG("EMP",EN1,0),U,10) Q
  1. F ENR=0:0 S ENR=$O(^ENG(6920,DA,7,ENR)) Q:ENR="" I $D(^(ENR,0)),$P(^(0),U)=EN1 Q
  1. G:ENR]"" DNTECH
  1. S ENFNO=$P(^ENG(6920,DA,7,0),U,1,2),ENNXL=$P(^(0),U,3),ENNXT=$P(^(0),U,4)
  1. TECH1 S ENNXL=ENNXL+1 I $D(^ENG(6920,DA,7,ENNXL)) G TECH1
  1. S ^ENG(6920,DA,7,ENNXL,0)=EN1_"^^"_$P(^ENG("EMP",EN1,0),U,10),ENNXT=ENNXT+1,^ENG(6920,DA,7,0)=ENFNO_U_ENNXL_U_ENNXT
  1. DNTECH ;
  1. Q
  1. ;
  1. INTECH ;Set PRIMARY TECH from ASSIGNED TECH
  1. ; called by File 6920.02 Field .01 "AE" cross-reference set logic
  1. ; Input DA(1) = work order ien (file 6920)
  1. ; X = entered technican (pointer to file 6929)
  1. ; If PRIMARY TECH ASSIGNED (#16) field in the Work Order (#6920) file
  1. ; is blank then this code will set it equal to the technician just
  1. ; entered in the 6920.02 subfile (TECHNICIANS ASSIGNED multiple).
  1. Q:'$D(DA(1))
  1. Q:$P($G(^ENG(6920,DA(1),2)),U,2)]"" ; primary tech not blank
  1. S $P(^ENG(6920,DA(1),2),U,2)=X
  1. Q
  1. ;
  1. OUTECH ;Update PRIMARY TECH if same as deleted ASSIGNED TECH
  1. ; called by File 6920.02 Field .01 "AE" cross-reference kill logic
  1. ; Input DA(1) = work order ien (file 6920)
  1. ; X = deleted technician (pointer to file 6929)
  1. ; If technician just deleted from the 6920.02 subfile (TECHNICIANS
  1. ; ASSIGNED) is the primary tech of the work order then this code will
  1. ; update the PRIMARY TECH ASSIGNED (#16) field of the Work Order (#6920)
  1. N ENI,ENTECH,ENX
  1. Q:'$D(DA(1))
  1. Q:$P($G(^ENG(6920,DA(1),2)),U,2)'=X ; not primary tech
  1. ; see if there is another assigned technician to use as primary tech
  1. S ENTECH=""
  1. S ENI=0 F S ENI=$O(^ENG(6920,DA(1),7,ENI)) Q:'ENI D Q:ENTECH'=""
  1. . S ENX=$P($G(^ENG(6920,DA(1),7,ENI,0)),U)
  1. . I ENX'=X,ENX?1.N S ENTECH=ENX
  1. ; update primary tech
  1. S $P(^ENG(6920,DA(1),2),U,2)=ENTECH
  1. Q
  1. ;
  1. CMR S IOP="HOME" D ^%ZIS W !,"This CMR is not currently in use. Enter 'A' to add it to the file, 'L' to",!,"see a list of active CMR's, or '^' to abort. L// "
  1. S R="" R R:DTIME I R'="","Ll"'[$E(R) G CMROUT
  1. CMR1 S ENY=1,I=0 F J=0:0 S I=$O(^ENG(6914,"AD",I)) Q:I="" W !,I S ENY=ENY+1 I (IOSL-ENY)<6 D CONT Q:R="^"
  1. CMROUT Q:R="A" W ! K ENY,I S X="" I $D(^ENG(6914,DA,2)) S X=$P(^(2),U,9)
  1. Q
  1. ;
  1. IX ;Look-up X-ref ;Expects DIC,ENDX,X
  1. K EN N S,S1,I,X2,R S I=1,S=X,X2=$L(X),S1="",ENY=1
  1. IX1 S S=$O(@(DIC_""""_ENDX_""",S)")) G:S="" IX2
  1. I $E(S,1,X2)=X W !,?5,I,?10,S S EN(I)=S,I=I+1,ENY=ENY+1 I (IOSL-ENY)<5 D CONT G:$E(R)="^" IX2
  1. I S?.N D IXNUM
  1. I $E(S,1,X2)=X!($E(S1,1,X2)=X) G IX1
  1. I X?.N S S=X_" ",S1=$O(@(DIC_""""_ENDX_""",S)")) I $E(S1,1,X2)=X G IX1
  1. IX2 S X="" I I>1 S:$D(ENIX) ENIX=1 W !,"Select (1 to ",I-1,"): " R X:DTIME I X]"",X'="^" S X=$S($D(EN(X)):EN(X),1:"")
  1. IXOUT K EN,ENY
  1. Q
  1. IXNUM S S1=$O(@(DIC_""""_ENDX_""",S)"))
  1. I S1=+S1,$E(S1,1,X2)'=X S S=S1 G IXNUM
  1. Q
  1. ;
  1. SWOPT ;Validate software option selection
  1. N Y S Y=$P($G(^ENG(6910.2,DA,0)),U) Q:Y=""
  1. I Y="ASK INCOMING INSPECTION W.O." K:"012"'[X X Q
  1. I Y="AUTO PRINT NEW W.O." K:"SLN"'[X X Q
  1. I Y="EQUIPMENT REPLACEMENT TEMPLATE" K:"SL"'[X X Q
  1. I Y="EXPANDED PM WORK ORDERS" K:X'="Y" X Q
  1. I Y="INVENTORY TEMPLATE" K:"SL"'[X X Q
  1. I Y="NOTIFY W.O. REQUESTOR" K:"CSA"'[X X Q
  1. I Y="PM DEVICE TYPE IDENTIFIER" K:"EM"'[X X Q
  1. I Y="PM SORT" K:"ECILPS"'[X X Q
  1. I Y="PRINT BAR CODES ON W.O." K:"NY"'[X X Q
  1. I Y="SAFETY PRINTOUT" K:"SL"'[X X Q
  1. I Y="SPACE SURVEY PRINTOUT" K:"SL"'[X X Q
  1. I Y="WARRANTY EXPIRATION TEMPLATE" K:"SL"'[X X Q
  1. Q
  1. ;
  1. BLDG ;Called for Building File
  1. N X1,I1,X2
  1. S X2=$P(X,"-",2,3) I X2["-" W !,?7,"BUILDINGS may not contain more than one hyphen." K X Q
  1. I $D(X),X2'?.NU W " Incorrect DIVISION format." K X Q
  1. S X1=$P(X,"-") Q:X1?.NU F I1=1:1:$L(X1) I $E(X1,I1)'?1NU,"e. "'[$E(X1,I1) K X Q
  1. I '$D(X) W !,?7,"BUILDING not in proper format."
  1. Q
  1. ;
  1. CONT S:$D(ENY) ENY=1 R !!,"<cr> to continue, '^' to stop...",R:DTIME
  1. Q
  1. ;ENLIB1