ENTIRS ;WOIFO/LKG - SIGN RESPONSIBILITIES ;2/5/08 14:57
;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
IN ;Entry point
K ^TMP($J,"SCR"),^TMP($J,"INDX"),ENACL S:'$G(DT) DT=$$DT^XLFDT()
S ENJ="",ENC=0
F S ENJ=$O(^ENG(6916.3,"AOA",DUZ,ENJ)) Q:ENJ="" D
. S ENI=""
. F S ENI=$O(^ENG(6916.3,"AOA",DUZ,ENJ,ENI)) Q:ENI="" D
. . S ENNOD0=$G(^ENG(6916.3,ENI,0)) Q:ENNOD0=""
. . Q:$P(ENNOD0,U,8)'=""
. . I $P(ENNOD0,U,5),$$FMDIFF^XLFDT(DT,$P(ENNOD0,U,5))<360 Q
. . S ENIC=ENI_"," K END,ENERR D GETS^DIQ(6916.3,ENIC,".01;1;20","E","END","ENERR")
. . S ENDAC=$P(ENNOD0,U)_"," D GETS^DIQ(6914,ENDAC,"3;4;5","E","END","ENERR")
. . S ENC=ENC+1
. . S ^TMP($J,"SCR",ENC)=$G(END(6916.3,ENIC,.01,"E"))_U_$E($G(END(6914,ENDAC,3,"E")),1,20)_U_$G(END(6914,ENDAC,4,"E"))_U_$G(END(6914,ENDAC,5,"E"))
. . S ^TMP($J,"INDX",ENC)=ENI
I 'ENC W !!,"There are no assignment to sign." K DIR S DIR(0)="E" D ^DIR K DIR G EX
S ^TMP($J,"SCR")=ENC_"^IT RESPONSIBILITIES REQUIRING SIGNATURE BY "_$G(END(6916.3,ENIC,1,"E"))
S ^TMP($J,"SCR",0)="5;9;ENTRY #^15;20;MFG EQUIP NAME^37;25;MODEL^65;14;SERIAL#"
D EN2^ENPLS2(1) G:'$D(ENACL) EX
K DIR S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="NO" D ^DIR K DIR
G:'Y!$D(DIRUT) EX
N L,DIC,FLDS,FR,TO,BY,IOP,DHD
S ENDA=$O(^ENG(6916.2,"@"),-1)
I '$$CMP^XUSESIG1($P($G(^ENG(6916.2,ENDA,0)),U,3),$NAME(^ENG(6916.2,ENDA,1))) W !!,"Hand receipt text is corrupted - Please contact EPS AEMS/MERS support" G EX
S L=0,DIC=6916.2,FLDS=1,FR=ENDA,TO=ENDA,BY="@NUMBER",IOP="HOME",DHD="@"
D EN1^DIP
K DIR S DIR(0)="Y",DIR("A")="OK to sign",DIR("B")="NO" D ^DIR K DIR
G:'Y!$D(DIRUT) EX
D SIG^XUSESIG I X1="" W !,"<Invalid Electronic Signature> Signing Aborted." G EX
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 ENDA=^TMP($J,"INDX",ENI) L +^ENG(6916.3,ENDA):$S($G(DILOCKTM)>5:DILOCKTM,1:5) E D MSG^ENTIRT(ENDA,"Signature") Q
. . . S ENZ=$$SIGN^ENTIUTL1(ENDA)
. . . S:ENZ ENCNT=ENCNT+1 D:'ENZ MSG2(ENDA)
. . . L -^ENG(6916.3,ENDA)
W !!,ENCNT," assignment records were signed."
EX ;
K ^TMP($J,"SCR"),^TMP($J,"INDX"),DIROUT,DIRUT,DTOUT,DUOUT,ENACL,ENCNT,ENDA,ENDAC,ENI,ENIC,ENJ,ENC,END,ENERR,ENNOD0,ENX,ENZ,X,X1,Y
Q
MSG2(ENDA) ;error message on signing failure
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 not active ",!?5,"and was not signed."
Q
;
;ENTIRS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTIRS 2626 printed Dec 13, 2024@01:55:59 Page 2
ENTIRS ;WOIFO/LKG - SIGN RESPONSIBILITIES ;2/5/08 14:57
+1 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
IN ;Entry point
+1 KILL ^TMP($JOB,"SCR"),^TMP($JOB,"INDX"),ENACL
if '$GET(DT)
SET DT=$$DT^XLFDT()
+2 SET ENJ=""
SET ENC=0
+3 FOR
SET ENJ=$ORDER(^ENG(6916.3,"AOA",DUZ,ENJ))
if ENJ=""
QUIT
Begin DoDot:1
+4 SET ENI=""
+5 FOR
SET ENI=$ORDER(^ENG(6916.3,"AOA",DUZ,ENJ,ENI))
if ENI=""
QUIT
Begin DoDot:2
+6 SET ENNOD0=$GET(^ENG(6916.3,ENI,0))
if ENNOD0=""
QUIT
+7 if $PIECE(ENNOD0,U,8)'=""
QUIT
+8 IF $PIECE(ENNOD0,U,5)
IF $$FMDIFF^XLFDT(DT,$PIECE(ENNOD0,U,5))<360
QUIT
+9 SET ENIC=ENI_","
KILL END,ENERR
DO GETS^DIQ(6916.3,ENIC,".01;1;20","E","END","ENERR")
+10 SET ENDAC=$PIECE(ENNOD0,U)_","
DO GETS^DIQ(6914,ENDAC,"3;4;5","E","END","ENERR")
+11 SET ENC=ENC+1
+12 SET ^TMP($JOB,"SCR",ENC)=$GET(END(6916.3,ENIC,.01,"E"))_U_$EXTRACT($GET(END(6914,ENDAC,3,"E")),1,20)_U_$GET(END(6914,ENDAC,4,"E"))_U_$GET(END(6914,ENDAC,5,"E"))
+13 SET ^TMP($JOB,"INDX",ENC)=ENI
End DoDot:2
End DoDot:1
+14 IF 'ENC
WRITE !!,"There are no assignment to sign."
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO EX
+15 SET ^TMP($JOB,"SCR")=ENC_"^IT RESPONSIBILITIES REQUIRING SIGNATURE BY "_$GET(END(6916.3,ENIC,1,"E"))
+16 SET ^TMP($JOB,"SCR",0)="5;9;ENTRY #^15;20;MFG EQUIP NAME^37;25;MODEL^65;14;SERIAL#"
+17 DO EN2^ENPLS2(1)
if '$DATA(ENACL)
GOTO EX
+18 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="OK to continue"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+19 if 'Y!$DATA(DIRUT)
GOTO EX
+20 NEW L,DIC,FLDS,FR,TO,BY,IOP,DHD
+21 SET ENDA=$ORDER(^ENG(6916.2,"@"),-1)
+22 IF '$$CMP^XUSESIG1($PIECE($GET(^ENG(6916.2,ENDA,0)),U,3),$NAME(^ENG(6916.2,ENDA,1)))
WRITE !!,"Hand receipt text is corrupted - Please contact EPS AEMS/MERS support"
GOTO EX
+23 SET L=0
SET DIC=6916.2
SET FLDS=1
SET FR=ENDA
SET TO=ENDA
SET BY="@NUMBER"
SET IOP="HOME"
SET DHD="@"
+24 DO EN1^DIP
+25 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="OK to sign"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+26 if 'Y!$DATA(DIRUT)
GOTO EX
+27 DO SIG^XUSESIG
IF X1=""
WRITE !,"<Invalid Electronic Signature> Signing Aborted."
GOTO EX
+28 SET ENCNT=0
SET ENX=""
+29 FOR
SET ENX=$ORDER(ENACL(ENX))
if ENX=""
QUIT
Begin DoDot:1
+30 NEW ENXSTR
SET ENXSTR=$GET(ENACL(ENX))
if ENXSTR=""
QUIT
+31 IF $LENGTH(ENXSTR,",")>0
Begin DoDot:2
+32 FOR ENJ=1:1
SET ENI=$PIECE(ENXSTR,",",ENJ)
if +ENI'>0
QUIT
Begin DoDot:3
+33 SET ENDA=^TMP($JOB,"INDX",ENI)
LOCK +^ENG(6916.3,ENDA):$SELECT($GET(DILOCKTM)>5:DILOCKTM,1:5)
IF '$TEST
DO MSG^ENTIRT(ENDA,"Signature")
QUIT
+34 SET ENZ=$$SIGN^ENTIUTL1(ENDA)
+35 if ENZ
SET ENCNT=ENCNT+1
if 'ENZ
DO MSG2(ENDA)
+36 LOCK -^ENG(6916.3,ENDA)
End DoDot:3
End DoDot:2
End DoDot:1
+37 WRITE !!,ENCNT," assignment records were signed."
EX ;
+1 KILL ^TMP($JOB,"SCR"),^TMP($JOB,"INDX"),DIROUT,DIRUT,DTOUT,DUOUT,ENACL,ENCNT,ENDA,ENDAC,ENI,ENIC,ENJ,ENC,END,ENERR,ENNOD0,ENX,ENZ,X,X1,Y
+2 QUIT
MSG2(ENDA) ;error message on signing failure
+1 NEW END,ENERR,ENDAC
SET ENDAC=ENDA_","
+2 DO GETS^DIQ(6916.3,ENDAC,".01;1","E","END","ENERR")
+3 WRITE !,"Assignment Equip Entry# ",$GET(END(6916.3,ENDAC,.01,"E"))," for ",$GET(END(6916.3,ENDAC,1,"E"))," is not active ",!?5,"and was not signed."
+4 QUIT
+5 ;
+6 ;ENTIRS
