ENFAUTL ;(WIRMFO)/DH/SAB-FAP Utilities ;1.12.98
;;7.0;ENGINEERING;**25,29,39,48**;August 17, 1993
CHKFA(DA) ;X returned
;piece 1 = 1 if FA current, 0 otherwise
;piece 2 = date/time of current FA
;piece 3 = date/time of current FD
;piece 4 = IEN of most recent FA
N FADA,FADT,FDDT,J,K,L,X
S K=0 F J=0:0 S J=$O(^ENG(6915.2,"B",DA,J)) Q:'J S K=J
S FADT=$S(K=0:"",1:$P(^ENG(6915.2,K,0),U,2))
S L=0 F J=0:0 S J=$O(^ENG(6915.5,"B",DA,J)) Q:'J S L=J
S FDDT=$S(L=0:"",1:$P(^ENG(6915.5,L,0),U,2))
S FADA=(FADT>FDDT)
S X=FADA_U_FADT_U_FDDT_U_K
Q X
;
DEC(X) ;Add decimal points if necessary
;X must be numeric
N X1,X2,Y
S X=$TR(X,"$")
I X?1.12N1"."2N S Y=X G DECDUN
I X=0 S Y="0.00" G DECDUN
I X'["." S Y=X_".00" S:$L(Y)>15 Y="" G DECDUN
S X1=$P(X,"."),X2=$P(X,".",2) I $L(X1)>12 S Y="" G DECDUN
S Y=X1_"."_$E((X2_"00"),1,2)
DECDUN Q Y
;
CMRSTA ;Update STATION NUMBER in 6914 upon changes to 6914.1
;Triggered by 'AD' x-ref on 6914.1
N EQ,CMR,STATION,DATE,I,X
S %DT="T",X="N" D ^%DT,DD^%DT S DATE=Y
S STATION("DEF")=$P(^DIC(6910,1,0),U,2)
S CMR=DA,STATION=$P(^ENG(6914.1,CMR,0),U,7)
S (EQ("COR"),EQ("UPDT"),EQ("FAP"))=0
W !!,"Please bear with me as I attempt to update your Equipment File..."
S I=0 F S I=$O(^ENG(6914,"AD",CMR,I)) Q:I'>0 W:'(I#10) "." D
. S STATION("EX")=$P($G(^ENG(6914,I,9)),U,5)
. I STATION("EX")="",STATION=STATION("DEF") S $P(^ENG(6914,I,9),U,5)=STATION,EQ("UPDT")=EQ("UPDT")+1 Q
. I STATION=STATION("EX") S EQ("COR")=EQ("COR")+1 Q
. I $D(^ENG(6915.2,"B",I)),+$$CHKFA(I) S EQ("FAP")=EQ("FAP")+1,EQ("FAP",I)="" Q
. S $P(^ENG(6914,I,9),U,5)=STATION,EQ("UPDT")=EQ("UPDT")+1
RSLTS ;Summarize the outcome
W !!,(EQ("COR")+EQ("UPDT")+EQ("FAP"))," Equipment Records were examined."
W !,EQ("COR")," were found to be correct as is."
W !,EQ("UPDT")," were updated."
I EQ("FAP")>0 D G:'EQ("LIST") CMRXIT
. S EQ("LIST")=0
. W !,EQ("FAP")," have been sent to FAP under the old station number."
. 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."
. S DIR(0)="Y",DIR("A")="Would you like a list of these "_EQ("FAP")_" records",DIR("B")="YES"
. D ^DIR K DIR I $D(DIRUT)!(Y'>0) Q
. S EQ("LIST")=1,%ZIS="QM" D ^%ZIS I POP S EQ("LIST")=0 Q
. I $D(IO("Q")) D
.. S ZTDESC="Equipment to be edited via FAP",ZTRTN="DQ^ENFAUTL"
.. F I="EQ","CMR","STATION","DATE" S ZTSAVE(I)=""
.. S EQ("LIST")=0 D ^%ZTLOAD,HOME^%ZIS K ZTSK
I EQ("FAP")'>0 G CMRXIT
;
DQ ;Print the FAP list
N END,ENL,ENPG
U IO
S (END,ENPG)=0,$P(ENL,"-",(IOM-2))="-" D HD
S I=0 F S I=$O(EQ("FAP",I)) Q:I'>0 D Q:END
. W !,?10,I
. I $Y+4>IOSL,$O(EQ(I))>0 D HD
;
CMRXIT ; Exit CMRSTA
Q
;
HD ;Report header
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
I $E(IOST,1,2)="C-"!ENPG W @IOF
S ENPG=ENPG+1
W "Equipment Not Updated at time of CMR STATION NUMBER change"
W ?(IOM-10),"Page ",ENPG
W !," because the Equipment was Reported to FAP."
W !,"CMR: ",$P(^ENG(6914.1,CMR,0),U),?20,"New STATION NUMBER: ",STATION
W !,"Date of change: ",DATE
W !,ENL
Q
;
CC(STATION,CMR) ;Is putative STATION NUMBER consistent with CMR
N X,X1,X2 I STATION'?3N.2UN S X=0 G CCDUN
S X=1,X1=$E(STATION),X2=$E(CMR,1,2)
I "89"[X1,"57^58"'[X2 S X=0 G CCDUN
I X1=3,$E(X2)'=6 S X=0
CCDUN Q X
;
DATE(TYPE) ;Get dates for FAP docs
;Returns ENFAP("DT")
S %DT("A")=TYPE_" DATE: ",%DT="AE"
DT D ^%DT I Y'>0 S ENFAP("DT")=+Y Q
I $E(Y,4,5)="00" W !,$C(7),"Month is required." G DT
I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
S ENFAP("DT")=+Y
Q
;
CMRCC(ENI) ; CMR (#6914.1) file COST CENTER computed field
; in ENI (ien of CMR)
N ENCC,ENX
S ENCC=""
S ENX=$E($G(^ENG(6914.1,ENI,0)),1,2)
S ENX(0)=$S(ENX]"":$O(^ENG(6914.9,"B",ENX,0)),1:"")
S:ENX(0) ENCC=$P($G(^ENG(6914.9,ENX(0),0)),U,3)
Q ENCC
;
;ENFAUTL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAUTL 3932 printed Apr 09, 2024@21:01:38 Page 2
ENFAUTL ;(WIRMFO)/DH/SAB-FAP Utilities ;1.12.98
+1 ;;7.0;ENGINEERING;**25,29,39,48**;August 17, 1993
CHKFA(DA) ;X returned
+1 ;piece 1 = 1 if FA current, 0 otherwise
+2 ;piece 2 = date/time of current FA
+3 ;piece 3 = date/time of current FD
+4 ;piece 4 = IEN of most recent FA
+5 NEW FADA,FADT,FDDT,J,K,L,X
+6 SET K=0
FOR J=0:0
SET J=$ORDER(^ENG(6915.2,"B",DA,J))
if 'J
QUIT
SET K=J
+7 SET FADT=$SELECT(K=0:"",1:$PIECE(^ENG(6915.2,K,0),U,2))
+8 SET L=0
FOR J=0:0
SET J=$ORDER(^ENG(6915.5,"B",DA,J))
if 'J
QUIT
SET L=J
+9 SET FDDT=$SELECT(L=0:"",1:$PIECE(^ENG(6915.5,L,0),U,2))
+10 SET FADA=(FADT>FDDT)
+11 SET X=FADA_U_FADT_U_FDDT_U_K
+12 QUIT X
+13 ;
DEC(X) ;Add decimal points if necessary
+1 ;X must be numeric
+2 NEW X1,X2,Y
+3 SET X=$TRANSLATE(X,"$")
+4 IF X?1.12N1"."2N
SET Y=X
GOTO DECDUN
+5 IF X=0
SET Y="0.00"
GOTO DECDUN
+6 IF X'["."
SET Y=X_".00"
if $LENGTH(Y)>15
SET Y=""
GOTO DECDUN
+7 SET X1=$PIECE(X,".")
SET X2=$PIECE(X,".",2)
IF $LENGTH(X1)>12
SET Y=""
GOTO DECDUN
+8 SET Y=X1_"."_$EXTRACT((X2_"00"),1,2)
DECDUN QUIT Y
+1 ;
CMRSTA ;Update STATION NUMBER in 6914 upon changes to 6914.1
+1 ;Triggered by 'AD' x-ref on 6914.1
+2 NEW EQ,CMR,STATION,DATE,I,X
+3 SET %DT="T"
SET X="N"
DO ^%DT
DO DD^%DT
SET DATE=Y
+4 SET STATION("DEF")=$PIECE(^DIC(6910,1,0),U,2)
+5 SET CMR=DA
SET STATION=$PIECE(^ENG(6914.1,CMR,0),U,7)
+6 SET (EQ("COR"),EQ("UPDT"),EQ("FAP"))=0
+7 WRITE !!,"Please bear with me as I attempt to update your Equipment File..."
+8 SET I=0
FOR
SET I=$ORDER(^ENG(6914,"AD",CMR,I))
if I'>0
QUIT
if '(I#10)
WRITE "."
Begin DoDot:1
+9 SET STATION("EX")=$PIECE($GET(^ENG(6914,I,9)),U,5)
+10 IF STATION("EX")=""
IF STATION=STATION("DEF")
SET $PIECE(^ENG(6914,I,9),U,5)=STATION
SET EQ("UPDT")=EQ("UPDT")+1
QUIT
+11 IF STATION=STATION("EX")
SET EQ("COR")=EQ("COR")+1
QUIT
+12 IF $DATA(^ENG(6915.2,"B",I))
IF +$$CHKFA(I)
SET EQ("FAP")=EQ("FAP")+1
SET EQ("FAP",I)=""
QUIT
+13 SET $PIECE(^ENG(6914,I,9),U,5)=STATION
SET EQ("UPDT")=EQ("UPDT")+1
End DoDot:1
RSLTS ;Summarize the outcome
+1 WRITE !!,(EQ("COR")+EQ("UPDT")+EQ("FAP"))," Equipment Records were examined."
+2 WRITE !,EQ("COR")," were found to be correct as is."
+3 WRITE !,EQ("UPDT")," were updated."
+4 IF EQ("FAP")>0
Begin DoDot:1
+5 SET EQ("LIST")=0
+6 WRITE !,EQ("FAP")," have been sent to FAP under the old station number."
+7 WRITE !,"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."
+8 SET DIR(0)="Y"
SET DIR("A")="Would you like a list of these "_EQ("FAP")_" records"
SET DIR("B")="YES"
+9 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y'>0)
QUIT
+10 SET EQ("LIST")=1
SET %ZIS="QM"
DO ^%ZIS
IF POP
SET EQ("LIST")=0
QUIT
+11 IF $DATA(IO("Q"))
Begin DoDot:2
+12 SET ZTDESC="Equipment to be edited via FAP"
SET ZTRTN="DQ^ENFAUTL"
+13 FOR I="EQ","CMR","STATION","DATE"
SET ZTSAVE(I)=""
+14 SET EQ("LIST")=0
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:2
End DoDot:1
if 'EQ("LIST")
GOTO CMRXIT
+15 IF EQ("FAP")'>0
GOTO CMRXIT
+16 ;
DQ ;Print the FAP list
+1 NEW END,ENL,ENPG
+2 USE IO
+3 SET (END,ENPG)=0
SET $PIECE(ENL,"-",(IOM-2))="-"
DO HD
+4 SET I=0
FOR
SET I=$ORDER(EQ("FAP",I))
if I'>0
QUIT
Begin DoDot:1
+5 WRITE !,?10,I
+6 IF $Y+4>IOSL
IF $ORDER(EQ(I))>0
DO HD
End DoDot:1
if END
QUIT
+7 ;
CMRXIT ; Exit CMRSTA
+1 QUIT
+2 ;
HD ;Report header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+3 SET ENPG=ENPG+1
+4 WRITE "Equipment Not Updated at time of CMR STATION NUMBER change"
+5 WRITE ?(IOM-10),"Page ",ENPG
+6 WRITE !," because the Equipment was Reported to FAP."
+7 WRITE !,"CMR: ",$PIECE(^ENG(6914.1,CMR,0),U),?20,"New STATION NUMBER: ",STATION
+8 WRITE !,"Date of change: ",DATE
+9 WRITE !,ENL
+10 QUIT
+11 ;
CC(STATION,CMR) ;Is putative STATION NUMBER consistent with CMR
+1 NEW X,X1,X2
IF STATION'?3N.2UN
SET X=0
GOTO CCDUN
+2 SET X=1
SET X1=$EXTRACT(STATION)
SET X2=$EXTRACT(CMR,1,2)
+3 IF "89"[X1
IF "57^58"'[X2
SET X=0
GOTO CCDUN
+4 IF X1=3
IF $EXTRACT(X2)'=6
SET X=0
CCDUN QUIT X
+1 ;
DATE(TYPE) ;Get dates for FAP docs
+1 ;Returns ENFAP("DT")
+2 SET %DT("A")=TYPE_" DATE: "
SET %DT="AE"
DT DO ^%DT
IF Y'>0
SET ENFAP("DT")=+Y
QUIT
+1 IF $EXTRACT(Y,4,5)="00"
WRITE !,$CHAR(7),"Month is required."
GOTO DT
+2 IF $EXTRACT(Y,6,7)="00"
SET Y=$EXTRACT(Y,1,5)_"01"
+3 SET ENFAP("DT")=+Y
+4 QUIT
+5 ;
CMRCC(ENI) ; CMR (#6914.1) file COST CENTER computed field
+1 ; in ENI (ien of CMR)
+2 NEW ENCC,ENX
+3 SET ENCC=""
+4 SET ENX=$EXTRACT($GET(^ENG(6914.1,ENI,0)),1,2)
+5 SET ENX(0)=$SELECT(ENX]"":$ORDER(^ENG(6914.9,"B",ENX,0)),1:"")
+6 if ENX(0)
SET ENCC=$PIECE($GET(^ENG(6914.9,ENX(0),0)),U,3)
+7 QUIT ENCC
+8 ;
+9 ;ENFAUTL
