- ENTIRT ;WOIFO/LKG - TERMINATE RESPONSIBILITY ;2/4/08 12:32
- ;;7.0;ENGINEERING;**87,89**;Aug 17, 1993;Build 20
- TERMLST ;Entry for list termination processing
- N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,DIC,D,ENACL,ENCNT,ENDA,ENMETHOD,ENERR,ENX,ENI,ENJ,X,Y
- LSTSTART S DIR(0)="S^E:EQUIPMENT;P:PERSON",DIR("A")="Specify method for selecting IT assignments"
- D ^DIR K DIR G:$D(DIRUT) LSTEXIT
- S ENMETHOD=Y
- I ENMETHOD="E" D G:$D(ENERR) LSTEXIT
- . N D,DIC S DIC("S")="I $D(^ENG(6916.3,""AEA"",Y))" D GETEQ^ENUTL
- . I $D(DTOUT)!$D(DUOUT)!(Y<1) S ENERR=1 Q
- . S ENDA=+Y
- . K DIC,D,^TMP($J,"ENITTR"),ENERR
- . D FIND^DIC(6916.3,"","@;.01;1;20","PQX",ENDA,"","AEA","I $P(^(0),U,8)=""""","","^TMP($J,""ENITTR"")","ENERR")
- I ENMETHOD="P" D G:$D(ENERR) LSTEXIT
- . N D,DIC S DIC=200,DIC(0)="AEMQ",DIC("S")="I $D(^ENG(6916.3,""AOA"",Y))"
- . D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<1) S ENERR=1 Q
- . S ENDA=+Y
- . K DIC,D,^TMP($J,"ENITTR"),ENERR
- . D FIND^DIC(6916.3,"","@;.01;1;20","PQX",ENDA,"","AOA2","I $P(^(0),U,8)=""""","","^TMP($J,""ENITTR"")","ENERR")
- I $P($G(^TMP($J,"ENITTR","DILIST",0)),U)'>0 W !!,"There are no active responsibilities for this "_$S(ENMETHOD="E":"equipment",ENMETHOD="P":"person",1:"")_"." K DIR S DIR(0)="E" D ^DIR K DIR K ^TMP($J,"ENITTR") G LSTEXIT:'Y,LSTSTART
- K ^TMP($J,"SCR"),^TMP($J,"INDX"),ENACL
- S ^TMP($J,"SCR")=$P(^TMP($J,"ENITTR","DILIST",0),U)_"^ACTIVE IT RESPONSIBILITIES"
- S ^TMP($J,"SCR",0)="5;9;ENTRY #^15;20;MFG EQUIP NAME^37;30;OWNER^69;10;STATUS"
- S ENI=0
- F S ENI=$O(^TMP($J,"ENITTR","DILIST",ENI)) Q:+ENI'>0 D
- . N ENX S ENX=$G(^TMP($J,"ENITTR","DILIST",ENI,0))
- . S ^TMP($J,"SCR",ENI)=$P(ENX,U,2)_U_$E($$GET1^DIQ(6914,$P(ENX,U,2)_",",3),1,20)_U_$P(ENX,U,3,4)
- . S ^TMP($J,"INDX",ENI)=$P(ENX,U)
- K ^TMP($J,"ENITTR")
- D EN2^ENPLS2(1)
- G:'$D(ENACL)!$D(DIRUT) LSTEXIT
- S DIR(0)="Y",DIR("A")="OK to terminate assignments",DIR("B")="NO" D ^DIR K DIR
- G:'Y!$D(DIRUT) LSTEXIT
- S ENCNT=0,ENX=""
- F S ENX=$O(ENACL(ENX)) Q:ENX="" D
- . N ENXSTR
- . S ENXSTR=$G(ENACL(ENX)) Q:ENXSTR=""
- . I $L(ENXSTR,",")>0 D
- . . F ENJ=1:1 S ENI=$P(ENXSTR,",",ENJ) Q:+ENI'>0 D
- . . . S DA=^TMP($J,"INDX",ENI) L +^ENG(6916.3,DA):$S($G(DILOCKTM)>5:DILOCKTM,1:5) E D MSG(DA,"Termination") Q
- . . . S X=$$TERM^ENTIUTL1(DA)
- . . . L -^ENG(6916.3,DA) K DA
- . . . S ENCNT=ENCNT+1
- W !!,ENCNT," IT responsibilities were terminated." K DIR S DIR(0)="E" D ^DIR K DIR
- K ^TMP($J,"SCR"),^TMP($J,"INDX")
- G LSTEXIT:'Y,LSTSTART
- LSTEXIT ;
- K ^TMP($J,"SCR"),^TMP($J,"INDX")
- Q
- MSG(ENDA,ENMSG) ;Write Error Message
- N END,ENERR,ENDAC S ENDAC=ENDA_"," D GETS^DIQ(6916.3,ENDAC,".01;1","E","END","ENERR")
- W !,"Assignment Equip Entry# ",$G(END(6916.3,ENDAC,.01,"E"))," for ",$G(END(6916.3,ENDAC,1,"E"))," is locked by another process.",!?10,ENMSG," was bypassed."
- Q
- ;
- ;ENTIRT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTIRT 2812 printed Feb 18, 2025@23:22:24 Page 2
- ENTIRT ;WOIFO/LKG - TERMINATE RESPONSIBILITY ;2/4/08 12:32
- +1 ;;7.0;ENGINEERING;**87,89**;Aug 17, 1993;Build 20
- TERMLST ;Entry for list termination processing
- +1 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,DIC,D,ENACL,ENCNT,ENDA,ENMETHOD,ENERR,ENX,ENI,ENJ,X,Y
- LSTSTART SET DIR(0)="S^E:EQUIPMENT;P:PERSON"
- SET DIR("A")="Specify method for selecting IT assignments"
- +1 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO LSTEXIT
- +2 SET ENMETHOD=Y
- +3 IF ENMETHOD="E"
- Begin DoDot:1
- +4 NEW D,DIC
- SET DIC("S")="I $D(^ENG(6916.3,""AEA"",Y))"
- DO GETEQ^ENUTL
- +5 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<1)
- SET ENERR=1
- QUIT
- +6 SET ENDA=+Y
- +7 KILL DIC,D,^TMP($JOB,"ENITTR"),ENERR
- +8 DO FIND^DIC(6916.3,"","@;.01;1;20","PQX",ENDA,"","AEA","I $P(^(0),U,8)=""""","","^TMP($J,""ENITTR"")","ENERR")
- End DoDot:1
- if $DATA(ENERR)
- GOTO LSTEXIT
- +9 IF ENMETHOD="P"
- Begin DoDot:1
- +10 NEW D,DIC
- SET DIC=200
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $D(^ENG(6916.3,""AOA"",Y))"
- +11 DO ^DIC
- IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<1)
- SET ENERR=1
- QUIT
- +12 SET ENDA=+Y
- +13 KILL DIC,D,^TMP($JOB,"ENITTR"),ENERR
- +14 DO FIND^DIC(6916.3,"","@;.01;1;20","PQX",ENDA,"","AOA2","I $P(^(0),U,8)=""""","","^TMP($J,""ENITTR"")","ENERR")
- End DoDot:1
- if $DATA(ENERR)
- GOTO LSTEXIT
- +15 IF $PIECE($GET(^TMP($JOB,"ENITTR","DILIST",0)),U)'>0
- WRITE !!,"There are no active responsibilities for this "_$SELECT(ENMETHOD="E":"equipment",ENMETHOD="P":"person",1:"")_"."
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- KILL ^TMP($JOB,"ENITTR")
- if 'Y
- GOTO LSTEXIT
- GOTO LSTSTART
- +16 KILL ^TMP($JOB,"SCR"),^TMP($JOB,"INDX"),ENACL
- +17 SET ^TMP($JOB,"SCR")=$PIECE(^TMP($JOB,"ENITTR","DILIST",0),U)_"^ACTIVE IT RESPONSIBILITIES"
- +18 SET ^TMP($JOB,"SCR",0)="5;9;ENTRY #^15;20;MFG EQUIP NAME^37;30;OWNER^69;10;STATUS"
- +19 SET ENI=0
- +20 FOR
- SET ENI=$ORDER(^TMP($JOB,"ENITTR","DILIST",ENI))
- if +ENI'>0
- QUIT
- Begin DoDot:1
- +21 NEW ENX
- SET ENX=$GET(^TMP($JOB,"ENITTR","DILIST",ENI,0))
- +22 SET ^TMP($JOB,"SCR",ENI)=$PIECE(ENX,U,2)_U_$EXTRACT($$GET1^DIQ(6914,$PIECE(ENX,U,2)_",",3),1,20)_U_$PIECE(ENX,U,3,4)
- +23 SET ^TMP($JOB,"INDX",ENI)=$PIECE(ENX,U)
- End DoDot:1
- +24 KILL ^TMP($JOB,"ENITTR")
- +25 DO EN2^ENPLS2(1)
- +26 if '$DATA(ENACL)!$DATA(DIRUT)
- GOTO LSTEXIT
- +27 SET DIR(0)="Y"
- SET DIR("A")="OK to terminate assignments"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +28 if 'Y!$DATA(DIRUT)
- GOTO LSTEXIT
- +29 SET ENCNT=0
- SET ENX=""
- +30 FOR
- SET ENX=$ORDER(ENACL(ENX))
- if ENX=""
- QUIT
- Begin DoDot:1
- +31 NEW ENXSTR
- +32 SET ENXSTR=$GET(ENACL(ENX))
- if ENXSTR=""
- QUIT
- +33 IF $LENGTH(ENXSTR,",")>0
- Begin DoDot:2
- +34 FOR ENJ=1:1
- SET ENI=$PIECE(ENXSTR,",",ENJ)
- if +ENI'>0
- QUIT
- Begin DoDot:3
- +35 SET DA=^TMP($JOB,"INDX",ENI)
- LOCK +^ENG(6916.3,DA):$SELECT($GET(DILOCKTM)>5:DILOCKTM,1:5)
- IF '$TEST
- DO MSG(DA,"Termination")
- QUIT
- +36 SET X=$$TERM^ENTIUTL1(DA)
- +37 LOCK -^ENG(6916.3,DA)
- KILL DA
- +38 SET ENCNT=ENCNT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +39 WRITE !!,ENCNT," IT responsibilities were terminated."
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +40 KILL ^TMP($JOB,"SCR"),^TMP($JOB,"INDX")
- +41 if 'Y
- GOTO LSTEXIT
- GOTO LSTSTART
- LSTEXIT ;
- +1 KILL ^TMP($JOB,"SCR"),^TMP($JOB,"INDX")
- +2 QUIT
- MSG(ENDA,ENMSG) ;Write Error Message
- +1 NEW END,ENERR,ENDAC
- SET ENDAC=ENDA_","
- DO GETS^DIQ(6916.3,ENDAC,".01;1","E","END","ENERR")
- +2 WRITE !,"Assignment Equip Entry# ",$GET(END(6916.3,ENDAC,.01,"E"))," for ",$GET(END(6916.3,ENDAC,1,"E"))," is locked by another process.",!?10,ENMSG," was bypassed."
- +3 QUIT
- +4 ;
- +5 ;ENTIRT