ENPAT15 ;WISC/SAB-FIX PM MANHOURS ;1/13/95
;;7.0;ENGINEERING;**15**;Aug 17, 1993
I DUZ(0)'["@" W "Please set DUZ(0)=""@"" and re-run this routine",! Q
PMHRS W !,"Moving inappropriately posted PM manhours"
S ENI=0
F S ENI=$O(^DIC(6922,ENI)) Q:'ENI D
. ; engineering section loop
. S ENPMM=29000000
. F S ENPMM=$O(^DIC(6922,ENI,1,"B",ENPMM)) Q:'ENPMM D
. . ; invalid PM month loop
. . S ENII=$O(^DIC(6922,ENI,1,"B",ENPMM,0))
. . Q:'ENII
. . W "."
. . K PMTOT
. . S ENIII=0
. . F S ENIII=$O(^DIC(6922,ENI,1,ENII,1,ENIII)) Q:'ENIII D
. . . ; technician loop
. . . S ENY0=$G(^DIC(6922,ENI,1,ENII,1,ENIII,0))
. . . S ENTECH=$P(ENY0,U),ENHRS=$P(ENY0,U,2)
. . . I ENTECH]"",ENHRS]"" S PMTOT(ENTECH)=ENHRS
. . ; post accumulated hours
. . S ENSHKEY=ENI
. . S ENPMDT=$E(ENPMM,2,5)
. . I $D(PMTOT) D COUNT^ENBCPM8
. . ; kill invalid PM month
. . S DA(1)=ENI,DA=ENII,DIK="^DIC(6922,"_DA(1)_",1,"
. . D ^DIK
. ;clean up internal count of technicians
. ;source of problem was COUNT+8^ENBCPM8 (repaired with this patch)
. S ENPMM=0
. L +^DIC(6922,ENI)
. F S ENPMM=$O(^DIC(6922,ENI,1,"B",ENPMM)) Q:'ENPMM D
. . S ENII=$O(^DIC(6922,ENI,1,"B",ENPMM,0)) Q:'ENII D
. . . S (ENIII,ENLAST,ENCOUNT)=0
. . . F S ENIII=$O(^DIC(6922,ENI,1,ENII,1,ENIII)) Q:'ENIII S ENLAST=ENIII,ENCOUNT=ENCOUNT+1
. . . S:ENLAST $P(^DIC(6922,ENI,1,ENII,1,0),"^",3)=ENLAST,$P(^(0),"^",4)=ENCOUNT
. L -^DIC(6922,ENI)
K DA,DIK,ENHRS,ENI,ENII,ENIII,ENPMDT,ENPMM,ENSHKEY,ENTECH,ENY0,PMTOT
K ENLAST,ENCOUNT
;
UBC W !!,"Modifying Data in File #7336.9 (OFM BUDGET CATEGORY)"
S DIC=1,DIC(0)="X",X="7336.9" D ^DIC
I Y<0 W "ERROR - File 7336.9 Not Found",! G UBCEND
; additional MM Budget Categories
S (DIC,DIE)="^OFM(7336.9,",DR="1///^S X=ENX1"
S DIC(0)="X",X="EDUCATION" D ^DIC,ERR:Y'>0
I Y>0 S ENX1="MA,MI,MM",DA=+Y D ^DIE
S DIC(0)="X",X="NHCU" D ^DIC,ERR:Y'>0
I Y>0 S ENX1="MA,MI,MM,NR",DA=+Y D ^DIE
S DIC(0)="X",X="RESEARCH" D ^DIC,ERR:Y'>0
I Y>0 S ENX1="MA,MI,MM",DA=+Y D ^DIE
UBCEND K DA,DIC,DIE,DR,ENDA,ENX1,X,Y
UPC W !!,"Modifying Data in File #7336.8 (OFM PROJ CATEGORY)"
S DIC=1,DIC(0)="X",X="7336.8" D ^DIC
I Y<0 W "ERROR - File 7336.8 Not Found",! G UPCEND
; Update mapping to MM budget categories
S (DIC,DIE)="^OFM(7336.8,",DR="10///^S X=ENX10"
S DIC(0)="X",X="EDUCATION" D ^DIC,ERR:Y'>0
I Y>0 S ENX10="EDUCATION",DA=+Y D ^DIE
S DIC(0)="X",X="NHCU" D ^DIC,ERR:Y'>0
I Y>0 S ENX10="NHCU",DA=+Y D ^DIE
S DIC(0)="X",X="RESEARCH" D ^DIC,ERR:Y'>0
I Y>0 S ENX10="RESEARCH",DA=+Y D ^DIE
UPCEND K DA,DIC,DIE,DR,ENDA,ENX10,X,Y
INDX W !!,"Re-Indexing ENG SPACE (#6928) file"
K DIK S DIK="^ENG(""SP""," D IXALL^DIK
K DIK
Q
ERR W !,"ERROR - ",X," not found in file",! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPAT15 2757 printed Sep 15, 2024@21:18:45 Page 2
ENPAT15 ;WISC/SAB-FIX PM MANHOURS ;1/13/95
+1 ;;7.0;ENGINEERING;**15**;Aug 17, 1993
+2 IF DUZ(0)'["@"
WRITE "Please set DUZ(0)=""@"" and re-run this routine",!
QUIT
PMHRS WRITE !,"Moving inappropriately posted PM manhours"
+1 SET ENI=0
+2 FOR
SET ENI=$ORDER(^DIC(6922,ENI))
if 'ENI
QUIT
Begin DoDot:1
+3 ; engineering section loop
+4 SET ENPMM=29000000
+5 FOR
SET ENPMM=$ORDER(^DIC(6922,ENI,1,"B",ENPMM))
if 'ENPMM
QUIT
Begin DoDot:2
+6 ; invalid PM month loop
+7 SET ENII=$ORDER(^DIC(6922,ENI,1,"B",ENPMM,0))
+8 if 'ENII
QUIT
+9 WRITE "."
+10 KILL PMTOT
+11 SET ENIII=0
+12 FOR
SET ENIII=$ORDER(^DIC(6922,ENI,1,ENII,1,ENIII))
if 'ENIII
QUIT
Begin DoDot:3
+13 ; technician loop
+14 SET ENY0=$GET(^DIC(6922,ENI,1,ENII,1,ENIII,0))
+15 SET ENTECH=$PIECE(ENY0,U)
SET ENHRS=$PIECE(ENY0,U,2)
+16 IF ENTECH]""
IF ENHRS]""
SET PMTOT(ENTECH)=ENHRS
End DoDot:3
+17 ; post accumulated hours
+18 SET ENSHKEY=ENI
+19 SET ENPMDT=$EXTRACT(ENPMM,2,5)
+20 IF $DATA(PMTOT)
DO COUNT^ENBCPM8
+21 ; kill invalid PM month
+22 SET DA(1)=ENI
SET DA=ENII
SET DIK="^DIC(6922,"_DA(1)_",1,"
+23 DO ^DIK
End DoDot:2
+24 ;clean up internal count of technicians
+25 ;source of problem was COUNT+8^ENBCPM8 (repaired with this patch)
+26 SET ENPMM=0
+27 LOCK +^DIC(6922,ENI)
+28 FOR
SET ENPMM=$ORDER(^DIC(6922,ENI,1,"B",ENPMM))
if 'ENPMM
QUIT
Begin DoDot:2
+29 SET ENII=$ORDER(^DIC(6922,ENI,1,"B",ENPMM,0))
if 'ENII
QUIT
Begin DoDot:3
+30 SET (ENIII,ENLAST,ENCOUNT)=0
+31 FOR
SET ENIII=$ORDER(^DIC(6922,ENI,1,ENII,1,ENIII))
if 'ENIII
QUIT
SET ENLAST=ENIII
SET ENCOUNT=ENCOUNT+1
+32 if ENLAST
SET $PIECE(^DIC(6922,ENI,1,ENII,1,0),"^",3)=ENLAST
SET $PIECE(^(0),"^",4)=ENCOUNT
End DoDot:3
End DoDot:2
+33 LOCK -^DIC(6922,ENI)
End DoDot:1
+34 KILL DA,DIK,ENHRS,ENI,ENII,ENIII,ENPMDT,ENPMM,ENSHKEY,ENTECH,ENY0,PMTOT
+35 KILL ENLAST,ENCOUNT
+36 ;
UBC WRITE !!,"Modifying Data in File #7336.9 (OFM BUDGET CATEGORY)"
+1 SET DIC=1
SET DIC(0)="X"
SET X="7336.9"
DO ^DIC
+2 IF Y<0
WRITE "ERROR - File 7336.9 Not Found",!
GOTO UBCEND
+3 ; additional MM Budget Categories
+4 SET (DIC,DIE)="^OFM(7336.9,"
SET DR="1///^S X=ENX1"
+5 SET DIC(0)="X"
SET X="EDUCATION"
DO ^DIC
if Y'>0
DO ERR
+6 IF Y>0
SET ENX1="MA,MI,MM"
SET DA=+Y
DO ^DIE
+7 SET DIC(0)="X"
SET X="NHCU"
DO ^DIC
if Y'>0
DO ERR
+8 IF Y>0
SET ENX1="MA,MI,MM,NR"
SET DA=+Y
DO ^DIE
+9 SET DIC(0)="X"
SET X="RESEARCH"
DO ^DIC
if Y'>0
DO ERR
+10 IF Y>0
SET ENX1="MA,MI,MM"
SET DA=+Y
DO ^DIE
UBCEND KILL DA,DIC,DIE,DR,ENDA,ENX1,X,Y
UPC WRITE !!,"Modifying Data in File #7336.8 (OFM PROJ CATEGORY)"
+1 SET DIC=1
SET DIC(0)="X"
SET X="7336.8"
DO ^DIC
+2 IF Y<0
WRITE "ERROR - File 7336.8 Not Found",!
GOTO UPCEND
+3 ; Update mapping to MM budget categories
+4 SET (DIC,DIE)="^OFM(7336.8,"
SET DR="10///^S X=ENX10"
+5 SET DIC(0)="X"
SET X="EDUCATION"
DO ^DIC
if Y'>0
DO ERR
+6 IF Y>0
SET ENX10="EDUCATION"
SET DA=+Y
DO ^DIE
+7 SET DIC(0)="X"
SET X="NHCU"
DO ^DIC
if Y'>0
DO ERR
+8 IF Y>0
SET ENX10="NHCU"
SET DA=+Y
DO ^DIE
+9 SET DIC(0)="X"
SET X="RESEARCH"
DO ^DIC
if Y'>0
DO ERR
+10 IF Y>0
SET ENX10="RESEARCH"
SET DA=+Y
DO ^DIE
UPCEND KILL DA,DIC,DIE,DR,ENDA,ENX10,X,Y
INDX WRITE !!,"Re-Indexing ENG SPACE (#6928) file"
+1 KILL DIK
SET DIK="^ENG(""SP"","
DO IXALL^DIK
+2 KILL DIK
+3 QUIT
ERR WRITE !,"ERROR - ",X," not found in file",!
QUIT
