source: FOIAVistA/tag/r/ENGINEERING-EN/ENFAUTL.m@ 1375

Last change on this file since 1375 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1ENFAUTL ;(WIRMFO)/DH/SAB-FAP Utilities ;1.12.98
2 ;;7.0;ENGINEERING;**25,29,39,48**;August 17, 1993
3CHKFA(DA) ;X returned
4 ;piece 1 = 1 if FA current, 0 otherwise
5 ;piece 2 = date/time of current FA
6 ;piece 3 = date/time of current FD
7 ;piece 4 = IEN of most recent FA
8 N FADA,FADT,FDDT,J,K,L,X
9 S K=0 F J=0:0 S J=$O(^ENG(6915.2,"B",DA,J)) Q:'J S K=J
10 S FADT=$S(K=0:"",1:$P(^ENG(6915.2,K,0),U,2))
11 S L=0 F J=0:0 S J=$O(^ENG(6915.5,"B",DA,J)) Q:'J S L=J
12 S FDDT=$S(L=0:"",1:$P(^ENG(6915.5,L,0),U,2))
13 S FADA=(FADT>FDDT)
14 S X=FADA_U_FADT_U_FDDT_U_K
15 Q X
16 ;
17DEC(X) ;Add decimal points if necessary
18 ;X must be numeric
19 N X1,X2,Y
20 S X=$TR(X,"$")
21 I X?1.12N1"."2N S Y=X G DECDUN
22 I X=0 S Y="0.00" G DECDUN
23 I X'["." S Y=X_".00" S:$L(Y)>15 Y="" G DECDUN
24 S X1=$P(X,"."),X2=$P(X,".",2) I $L(X1)>12 S Y="" G DECDUN
25 S Y=X1_"."_$E((X2_"00"),1,2)
26DECDUN Q Y
27 ;
28CMRSTA ;Update STATION NUMBER in 6914 upon changes to 6914.1
29 ;Triggered by 'AD' x-ref on 6914.1
30 N EQ,CMR,STATION,DATE,I,X
31 S %DT="T",X="N" D ^%DT,DD^%DT S DATE=Y
32 S STATION("DEF")=$P(^DIC(6910,1,0),U,2)
33 S CMR=DA,STATION=$P(^ENG(6914.1,CMR,0),U,7)
34 S (EQ("COR"),EQ("UPDT"),EQ("FAP"))=0
35 W !!,"Please bear with me as I attempt to update your Equipment File..."
36 S I=0 F S I=$O(^ENG(6914,"AD",CMR,I)) Q:I'>0 W:'(I#10) "." D
37 . S STATION("EX")=$P($G(^ENG(6914,I,9)),U,5)
38 . I STATION("EX")="",STATION=STATION("DEF") S $P(^ENG(6914,I,9),U,5)=STATION,EQ("UPDT")=EQ("UPDT")+1 Q
39 . I STATION=STATION("EX") S EQ("COR")=EQ("COR")+1 Q
40 . I $D(^ENG(6915.2,"B",I)),+$$CHKFA(I) S EQ("FAP")=EQ("FAP")+1,EQ("FAP",I)="" Q
41 . S $P(^ENG(6914,I,9),U,5)=STATION,EQ("UPDT")=EQ("UPDT")+1
42RSLTS ;Summarize the outcome
43 W !!,(EQ("COR")+EQ("UPDT")+EQ("FAP"))," Equipment Records were examined."
44 W !,EQ("COR")," were found to be correct as is."
45 W !,EQ("UPDT")," were updated."
46 I EQ("FAP")>0 D G:'EQ("LIST") CMRXIT
47 . S EQ("LIST")=0
48 . W !,EQ("FAP")," have been sent to FAP under the old station number."
49 . W !,"These ",EQ("FAP")," records can only be changed via FAP documents. You must",!,"do an FD, manually change the STATION NUMBER, and then do an FA."
50 . S DIR(0)="Y",DIR("A")="Would you like a list of these "_EQ("FAP")_" records",DIR("B")="YES"
51 . D ^DIR K DIR I $D(DIRUT)!(Y'>0) Q
52 . S EQ("LIST")=1,%ZIS="QM" D ^%ZIS I POP S EQ("LIST")=0 Q
53 . I $D(IO("Q")) D
54 .. S ZTDESC="Equipment to be edited via FAP",ZTRTN="DQ^ENFAUTL"
55 .. F I="EQ","CMR","STATION","DATE" S ZTSAVE(I)=""
56 .. S EQ("LIST")=0 D ^%ZTLOAD,HOME^%ZIS K ZTSK
57 I EQ("FAP")'>0 G CMRXIT
58 ;
59DQ ;Print the FAP list
60 N END,ENL,ENPG
61 U IO
62 S (END,ENPG)=0,$P(ENL,"-",(IOM-2))="-" D HD
63 S I=0 F S I=$O(EQ("FAP",I)) Q:I'>0 D Q:END
64 . W !,?10,I
65 . I $Y+4>IOSL,$O(EQ(I))>0 D HD
66 ;
67CMRXIT ; Exit CMRSTA
68 Q
69 ;
70HD ;Report header
71 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
72 I $E(IOST,1,2)="C-"!ENPG W @IOF
73 S ENPG=ENPG+1
74 W "Equipment Not Updated at time of CMR STATION NUMBER change"
75 W ?(IOM-10),"Page ",ENPG
76 W !," because the Equipment was Reported to FAP."
77 W !,"CMR: ",$P(^ENG(6914.1,CMR,0),U),?20,"New STATION NUMBER: ",STATION
78 W !,"Date of change: ",DATE
79 W !,ENL
80 Q
81 ;
82CC(STATION,CMR) ;Is putative STATION NUMBER consistent with CMR
83 N X,X1,X2 I STATION'?3N.2UN S X=0 G CCDUN
84 S X=1,X1=$E(STATION),X2=$E(CMR,1,2)
85 I "89"[X1,"57^58"'[X2 S X=0 G CCDUN
86 I X1=3,$E(X2)'=6 S X=0
87CCDUN Q X
88 ;
89DATE(TYPE) ;Get dates for FAP docs
90 ;Returns ENFAP("DT")
91 S %DT("A")=TYPE_" DATE: ",%DT="AE"
92DT D ^%DT I Y'>0 S ENFAP("DT")=+Y Q
93 I $E(Y,4,5)="00" W !,$C(7),"Month is required." G DT
94 I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
95 S ENFAP("DT")=+Y
96 Q
97 ;
98CMRCC(ENI) ; CMR (#6914.1) file COST CENTER computed field
99 ; in ENI (ien of CMR)
100 N ENCC,ENX
101 S ENCC=""
102 S ENX=$E($G(^ENG(6914.1,ENI,0)),1,2)
103 S ENX(0)=$S(ENX]"":$O(^ENG(6914.9,"B",ENX,0)),1:"")
104 S:ENX(0) ENCC=$P($G(^ENG(6914.9,ENX(0),0)),U,3)
105 Q ENCC
106 ;
107 ;ENFAUTL
Note: See TracBrowser for help on using the repository browser.