- 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 Mar 13, 2025@21:00:39 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
