ENTIRRH1 ;WOIFO/LKG - Print hand receipt (Continued) ;3/4/08 15:02
;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
HDR1 ;Logic to print report heading
G HDR1^ENTIRRH
Q
;
ITST2 ;IT personnel entry point for printing signed hand receipts
N ENDA,ENDATE
N DIC,DTOUT,DUOUT S DIC=200,DIC(0)="AEMQ",DIC("S")="I $D(^ENG(6916.3,""C"",Y))"
D ^DIC I Y<1!$D(DTOUT)!$D(DUOUT) Q
S ENDA=+Y
S ENDATE=$$DATES() I ENDATE="" Q
S %ZIS="Q" D ^%ZIS I POP K POP Q
I $D(IO("Q")) S ZTRTN="IN2^ENTIRRH1",ZTDESC="IT Equipment Hand Receipt Print",ZTSAVE("ENDA")="",ZTSAVE("ENDATE")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q") Q
G IN2
USER ;User entry point for printing signed hand receipts
I '$D(^ENG(6916.3,"C",DUZ)) W !,"You have no IT assignments, either active or ended." K DIR S DIR(0)="E" D ^DIR K DIR Q
N ENDA,ENDATE S ENDA=DUZ
S ENDATE=$$DATES() I ENDATE="" Q
S %ZIS="Q" D ^%ZIS I POP K POP Q
I $D(IO("Q")) S ZTRTN="IN2^ENTIRRH1",ZTDESC="IT Equipment Hand Receipt Print",ZTSAVE("ENDA")="",ZTSAVE("ENDATE")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q") Q
G IN2
IN2 ;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,ENI,ENJ,ENL,ENNBR,ENV,ENVR,ENX
S ENI=0
F S ENI=$O(^ENG(6916.3,"C",ENDA,ENI)) Q:+ENI'=ENI D
. S ENX=$G(^ENG(6916.3,ENI,0)) Q:ENX=""
. S:$P($P(ENX,U,5),".")=ENDATE ENNBR=$P(ENX,U),ENV=$P(ENX,U,6),ENL(ENV)=$G(ENL(ENV))+1,^TMP($J,"ENITRRH","LIST","V"_ENV,ENNBR,ENI)=""
. S ENJ=0
. F S ENJ=$O(^ENG(6916.3,ENI,3,ENJ)) Q:+ENJ'>0 D
. . S ENX=$G(^ENG(6916.3,ENI,3,ENJ,0)) Q:ENX=""
. . I $P($P(ENX,U),".")=ENDATE D
. . . S ENNBR=$P(^ENG(6916.3,ENI,0),U),ENV=$P(ENX,U,2)
. . . S:'$D(^TMP($J,"ENITRRH","LIST","V"_ENV,ENNBR,ENI)) ENL(ENV)=$G(ENL(ENV))+1,^TMP($J,"ENITRRH","LIST","V"_ENV,ENNBR,ENI)=ENJ
S ENI=""
F S ENI=$O(^TMP($J,"ENITRRH","LIST",ENI)) Q:ENI="" S ENVR=$P(ENI,"V",2) D PRT
G EX2
PRT U IO
N END,ENDAC,ENERR,ENI,ENLNCNT,ENMFGN,ENMODEL,ENNOW,ENEQPT,ENPG,ENRDA,ENRDA1,ENX,ENNBR,ENSERNBR,ENSIG,ENSIGNDT,ENNAME,ENV,ENSTN,X,Y S ENPG=0,ENEQPT=1
S ENNAME=$$GET1^DIQ(200,ENDA_",",.01),ENNOW=$$FMTE^XLFDT($$NOW^XLFDT(),"2M")
S ENSTN=+$O(^DIC(6910,0)),ENSTN=$$GET1^DIQ(6910,ENSTN_",",1)
D HDR1 Q:$D(DIRUT)
I '$$CMP^XUSESIG1($P($G(^ENG(6916.2,ENVR,0)),U,3),$NAME(^ENG(6916.2,ENVR,1))) W !!!,"Hand receipt v",$P($G(^ENG(6916.2,ENVR,0)),U)," text is corrupted.",!?5," - Please contact EPS AEMS/MERS support" Q
S ENNBR=0,ENV="V"_ENVR
F S ENNBR=$O(^TMP($J,"ENITRRH","LIST",ENV,ENNBR)) Q:ENNBR="" D Q:$D(DIRUT)
. S ENI=0
. F S ENI=$O(^TMP($J,"ENITRRH","LIST",ENV,ENNBR,ENI)) Q:ENI="" D Q:$D(DIRUT)
. . N END,ENERR,ENERR1,ENERR2,ENERR3,ENERR4,X1,X2
. . S ENDAC=ENNBR_"," D GETS^DIQ(6914,ENDAC,"3;4;5","E","END","ENERR")
. . S ENMFGN=$G(END(6914,ENDAC,3,"E")),ENMODEL=$G(END(6914,ENDAC,4,"E")),ENSERNBR=$G(END(6914,ENDAC,5,"E"))
. . I IOSL-1'>ENLNCNT D HDR1 Q:$D(DIRUT)
. . W !,ENNBR,?11,$E(ENMFGN,1,20),?35,ENMODEL,?65,ENSERNBR S ENLNCNT=ENLNCNT+1
. . S ENRDA=ENI,ENRDA1=$P(^TMP($J,"ENITRRH","LIST",ENV,ENNBR,ENI),U)
. . K ENERR,ENSIG,ENSIGNDT
. . S X=$S(ENRDA1>0:$G(^ENG(6916.3,ENRDA,3,ENRDA1,1)),1:$G(^ENG(6916.3,ENRDA,1)))
. . I X'="" D
. . . S X1=ENRDA,X2=1 D DE^XUSHSHP S ENSIG=$P(X,U),ENSIGNDT=$$FMTE^XLFDT($P(X,U,4))
. . . S:$P(X,U,8)'=$P($G(^ENG(6916.2,ENVR,0)),U,3) ENERR1=1
. . . S:$P(X,U,5)'=ENNBR ENERR2=1
. . . S:$P(X,U,6)'=$P($G(^ENG(6916.3,ENRDA,0)),U,2) ENERR3=1
. . . S:$P(X,U,4)'=$S(ENRDA1>0:$P($G(^ENG(6916.3,ENRDA,3,ENRDA1,0)),U),1:$P($G(^ENG(6916.3,ENRDA,0)),U,5)) ENERR4=1
. . I $D(ENSIGNDT) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?4,"Signed: ",ENSIGNDT,?35,"Signature: /ES/",$G(ENSIG) S ENLNCNT=ENLNCNT+1
. . I '$D(ENSIGNDT) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) D
. . . W !,?4,"Signed: "_$S(ENRDA1>0:$$GET1^DIQ(6916.31,ENRDA1_","_ENRDA_",",.01),1:$$GET1^DIQ(6916.3,ENRDA_",",4))
. . . W ?35,"Certified by: "_$S(ENRDA1>0:$$GET1^DIQ(6916.31,ENRDA1_","_ENRDA_",",3),1:$$GET1^DIQ(6916.3,ENRDA_",",6))
. . . S ENLNCNT=ENLNCNT+1
. . I $G(ENERR1) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Hand Receipt Text Altered **" S ENLNCNT=ENLNCNT+1
. . I $G(ENERR2) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Assigned Equipment Altered **" S ENLNCNT=ENLNCNT+1
. . I $G(ENERR3) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Assigned Person Altered **" S ENLNCNT=ENLNCNT+1
. . I $G(ENERR4) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Date Signed Altered **" S ENLNCNT=ENLNCNT+1
. . D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?4,"Current Status: ",$$GET1^DIQ(6916.3,ENI_",",20),?35,"Date: ",$$GET1^DIQ(6916.3,ENI_",",21) S ENLNCNT=ENLNCNT+1
Q:$D(DIRUT) S ENEQPT=0
I IOSL-3'>ENLNCNT D HDR1 Q:$D(DIRUT)
I ENLNCNT>3 W !! S ENLNCNT=ENLNCNT+2
S ENI=0 F S ENI=$O(^ENG(6916.2,ENVR,1,ENI)) Q:+ENI'=ENI D Q:$D(DIRUT)
. I IOSL-1'>ENLNCNT D HDR1 Q:$D(DIRUT)
. W !,$G(^ENG(6916.2,ENVR,1,ENI,0)) S ENLNCNT=ENLNCNT+1
Q:$D(DIRUT)
I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR
Q
EX2 S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
K ^TMP($J,"ENITRRH"),ENDA,ENDATE
Q
DATES() ;Signature Dates for User
K ^TMP($J,"ENITRRH","DATES") N ENCNT,ENDATE,ENI,ENJ,ENL,ENX,DIRUT,DIROUT,DTOUT,DUOUT,X,Y S ENDATE="" S:'$G(DT) DT=$$DT^XLFDT()
S ENI=0
F S ENI=$O(^ENG(6916.3,"C",ENDA,ENI)) Q:+ENI'=ENI D
. S ENX=$P($P($G(^ENG(6916.3,ENI,0)),U,5),".") Q:ENX=""
. S:'$D(^TMP($J,"ENITRRH","DATES",ENX)) ^TMP($J,"ENITRRH","DATES",ENX)=$$FMTE^XLFDT(ENX)
. S ENJ=0
. F S ENJ=$O(^ENG(6916.3,ENI,3,ENJ)) Q:+ENJ'=ENJ D
. . S ENX=$P($P($G(^ENG(6916.3,ENI,3,ENJ,0)),U),".") Q:ENX=""
. . S:'$D(^TMP($J,"ENITRRH","DATES",ENX)) ^TMP($J,"ENITRRH","DATES",ENX)=$$FMTE^XLFDT(ENX)
W @IOF,?5,"Signature Dates" S ENL=1
S ENI="",ENCNT=0
F S ENI=$O(^TMP($J,"ENITRRH","DATES",ENI),-1) Q:ENI="" D Q:$D(DIRUT)
. I IOSL-2'>ENL K DIR S DIR(0)="E" D ^DIR K DIR S ENL=0 Q:$D(DIRUT)
. W !?5,$P(^TMP($J,"ENITRRH","DATES",ENI),U) S ENL=ENL+1,ENCNT=ENCNT+1
I 'ENCNT W !?3,"* No Signed Assignments *" K DIR S DIR(0)="E" D ^DIR K DIR Q ""
K DIRUT,DIROUT,DTOUT,DUOUT W !
K DIR S DIR(0)="DA^3061001:"_DT_"^I '$D(^TMP($J,""ENITRRH"",""DATES"",Y)) K X",DIR("A")="Date of Hand Receipt Signature: ",DIR("?")="Enter date from list."
S:ENCNT=1 DIR("B")=$$FMTE^XLFDT($O(^TMP($J,"ENITRRH","DATES","")))
D ^DIR K DIR I $D(DIRUT)!$D(DIROUT)!(Y'?7N) S Y=""
S ENDATE=Y K ^TMP($J,"ENITRRH","DATES")
Q ENDATE
;
;ENTIRRH1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTIRRH1 6321 printed Sep 23, 2025@19:31:58 Page 2
ENTIRRH1 ;WOIFO/LKG - Print hand receipt (Continued) ;3/4/08 15:02
+1 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
HDR1 ;Logic to print report heading
+1 GOTO HDR1^ENTIRRH
+2 QUIT
+3 ;
ITST2 ;IT personnel entry point for printing signed hand receipts
+1 NEW ENDA,ENDATE
+2 NEW DIC,DTOUT,DUOUT
SET DIC=200
SET DIC(0)="AEMQ"
SET DIC("S")="I $D(^ENG(6916.3,""C"",Y))"
+3 DO ^DIC
IF Y<1!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+4 SET ENDA=+Y
+5 SET ENDATE=$$DATES()
IF ENDATE=""
QUIT
+6 SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL POP
QUIT
+7 IF $DATA(IO("Q"))
SET ZTRTN="IN2^ENTIRRH1"
SET ZTDESC="IT Equipment Hand Receipt Print"
SET ZTSAVE("ENDA")=""
SET ZTSAVE("ENDATE")=""
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK,IO("Q")
QUIT
+8 GOTO IN2
USER ;User entry point for printing signed hand receipts
+1 IF '$DATA(^ENG(6916.3,"C",DUZ))
WRITE !,"You have no IT assignments, either active or ended."
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+2 NEW ENDA,ENDATE
SET ENDA=DUZ
+3 SET ENDATE=$$DATES()
IF ENDATE=""
QUIT
+4 SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL POP
QUIT
+5 IF $DATA(IO("Q"))
SET ZTRTN="IN2^ENTIRRH1"
SET ZTDESC="IT Equipment Hand Receipt Print"
SET ZTSAVE("ENDA")=""
SET ZTSAVE("ENDATE")=""
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK,IO("Q")
QUIT
+6 GOTO IN2
IN2 ;
+1 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,ENI,ENJ,ENL,ENNBR,ENV,ENVR,ENX
+2 SET ENI=0
+3 FOR
SET ENI=$ORDER(^ENG(6916.3,"C",ENDA,ENI))
if +ENI'=ENI
QUIT
Begin DoDot:1
+4 SET ENX=$GET(^ENG(6916.3,ENI,0))
if ENX=""
QUIT
+5 if $PIECE($PIECE(ENX,U,5),".")=ENDATE
SET ENNBR=$PIECE(ENX,U)
SET ENV=$PIECE(ENX,U,6)
SET ENL(ENV)=$GET(ENL(ENV))+1
SET ^TMP($JOB,"ENITRRH","LIST","V"_ENV,ENNBR,ENI)=""
+6 SET ENJ=0
+7 FOR
SET ENJ=$ORDER(^ENG(6916.3,ENI,3,ENJ))
if +ENJ'>0
QUIT
Begin DoDot:2
+8 SET ENX=$GET(^ENG(6916.3,ENI,3,ENJ,0))
if ENX=""
QUIT
+9 IF $PIECE($PIECE(ENX,U),".")=ENDATE
Begin DoDot:3
+10 SET ENNBR=$PIECE(^ENG(6916.3,ENI,0),U)
SET ENV=$PIECE(ENX,U,2)
+11 if '$DATA(^TMP($JOB,"ENITRRH","LIST","V"_ENV,ENNBR,ENI))
SET ENL(ENV)=$GET(ENL(ENV))+1
SET ^TMP($JOB,"ENITRRH","LIST","V"_ENV,ENNBR,ENI)=ENJ
End DoDot:3
End DoDot:2
End DoDot:1
+12 SET ENI=""
+13 FOR
SET ENI=$ORDER(^TMP($JOB,"ENITRRH","LIST",ENI))
if ENI=""
QUIT
SET ENVR=$PIECE(ENI,"V",2)
DO PRT
+14 GOTO EX2
PRT USE IO
+1 NEW END,ENDAC,ENERR,ENI,ENLNCNT,ENMFGN,ENMODEL,ENNOW,ENEQPT,ENPG,ENRDA,ENRDA1,ENX,ENNBR,ENSERNBR,ENSIG,ENSIGNDT,ENNAME,ENV,ENSTN,X,Y
SET ENPG=0
SET ENEQPT=1
+2 SET ENNAME=$$GET1^DIQ(200,ENDA_",",.01)
SET ENNOW=$$FMTE^XLFDT($$NOW^XLFDT(),"2M")
+3 SET ENSTN=+$ORDER(^DIC(6910,0))
SET ENSTN=$$GET1^DIQ(6910,ENSTN_",",1)
+4 DO HDR1
if $DATA(DIRUT)
QUIT
+5 IF '$$CMP^XUSESIG1($PIECE($GET(^ENG(6916.2,ENVR,0)),U,3),$NAME(^ENG(6916.2,ENVR,1)))
WRITE !!!,"Hand receipt v",$PIECE($GET(^ENG(6916.2,ENVR,0)),U)," text is corrupted.",!?5," - Please contact EPS AEMS/MERS support"
QUIT
+6 SET ENNBR=0
SET ENV="V"_ENVR
+7 FOR
SET ENNBR=$ORDER(^TMP($JOB,"ENITRRH","LIST",ENV,ENNBR))
if ENNBR=""
QUIT
Begin DoDot:1
+8 SET ENI=0
+9 FOR
SET ENI=$ORDER(^TMP($JOB,"ENITRRH","LIST",ENV,ENNBR,ENI))
if ENI=""
QUIT
Begin DoDot:2
+10 NEW END,ENERR,ENERR1,ENERR2,ENERR3,ENERR4,X1,X2
+11 SET ENDAC=ENNBR_","
DO GETS^DIQ(6914,ENDAC,"3;4;5","E","END","ENERR")
+12 SET ENMFGN=$GET(END(6914,ENDAC,3,"E"))
SET ENMODEL=$GET(END(6914,ENDAC,4,"E"))
SET ENSERNBR=$GET(END(6914,ENDAC,5,"E"))
+13 IF IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
+14 WRITE !,ENNBR,?11,$EXTRACT(ENMFGN,1,20),?35,ENMODEL,?65,ENSERNBR
SET ENLNCNT=ENLNCNT+1
+15 SET ENRDA=ENI
SET ENRDA1=$PIECE(^TMP($JOB,"ENITRRH","LIST",ENV,ENNBR,ENI),U)
+16 KILL ENERR,ENSIG,ENSIGNDT
+17 SET X=$SELECT(ENRDA1>0:$GET(^ENG(6916.3,ENRDA,3,ENRDA1,1)),1:$GET(^ENG(6916.3,ENRDA,1)))
+18 IF X'=""
Begin DoDot:3
+19 SET X1=ENRDA
SET X2=1
DO DE^XUSHSHP
SET ENSIG=$PIECE(X,U)
SET ENSIGNDT=$$FMTE^XLFDT($PIECE(X,U,4))
+20 if $PIECE(X,U,8)'=$PIECE($GET(^ENG(6916.2,ENVR,0)),U,3)
SET ENERR1=1
+21 if $PIECE(X,U,5)'=ENNBR
SET ENERR2=1
+22 if $PIECE(X,U,6)'=$PIECE($GET(^ENG(6916.3,ENRDA,0)),U,2)
SET ENERR3=1
+23 if $PIECE(X,U,4)'=$SELECT(ENRDA1>0
SET ENERR4=1
End DoDot:3
+24 IF $DATA(ENSIGNDT)
if IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
WRITE !?4,"Signed: ",ENSIGNDT,?35,"Signature: /ES/",$GET(ENSIG)
SET ENLNCNT=ENLNCNT+1
+25 IF '$DATA(ENSIGNDT)
if IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
Begin DoDot:3
+26 WRITE !,?4,"Signed: "_$SELECT(ENRDA1>0:$$GET1^DIQ(6916.31,ENRDA1_","_ENRDA_",",.01),1:$$GET1^DIQ(6916.3,ENRDA_",",4))
+27 WRITE ?35,"Certified by: "_$SELECT(ENRDA1>0:$$GET1^DIQ(6916.31,ENRDA1_","_ENRDA_",",3),1:$$GET1^DIQ(6916.3,ENRDA_",",6))
+28 SET ENLNCNT=ENLNCNT+1
End DoDot:3
+29 IF $GET(ENERR1)
if IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
WRITE !?19,"** Hand Receipt Text Altered **"
SET ENLNCNT=ENLNCNT+1
+30 IF $GET(ENERR2)
if IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
WRITE !?19,"** Assigned Equipment Altered **"
SET ENLNCNT=ENLNCNT+1
+31 IF $GET(ENERR3)
if IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
WRITE !?19,"** Assigned Person Altered **"
SET ENLNCNT=ENLNCNT+1
+32 IF $GET(ENERR4)
if IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
WRITE !?19,"** Date Signed Altered **"
SET ENLNCNT=ENLNCNT+1
+33 if IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
WRITE !?4,"Current Status: ",$$GET1^DIQ(6916.3,ENI_",",20),?35,"Date: ",$$GET1^DIQ(6916.3,ENI_",",21)
SET ENLNCNT=ENLNCNT+1
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+34 if $DATA(DIRUT)
QUIT
SET ENEQPT=0
+35 IF IOSL-3'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
+36 IF ENLNCNT>3
WRITE !!
SET ENLNCNT=ENLNCNT+2
+37 SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6916.2,ENVR,1,ENI))
if +ENI'=ENI
QUIT
Begin DoDot:1
+38 IF IOSL-1'>ENLNCNT
DO HDR1
if $DATA(DIRUT)
QUIT
+39 WRITE !,$GET(^ENG(6916.2,ENVR,1,ENI,0))
SET ENLNCNT=ENLNCNT+1
End DoDot:1
if $DATA(DIRUT)
QUIT
+40 if $DATA(DIRUT)
QUIT
+41 IF $EXTRACT(IOST,1,2)="C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+42 QUIT
EX2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
+1 KILL ^TMP($JOB,"ENITRRH"),ENDA,ENDATE
+2 QUIT
DATES() ;Signature Dates for User
+1 KILL ^TMP($JOB,"ENITRRH","DATES")
NEW ENCNT,ENDATE,ENI,ENJ,ENL,ENX,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
SET ENDATE=""
if '$GET(DT)
SET DT=$$DT^XLFDT()
+2 SET ENI=0
+3 FOR
SET ENI=$ORDER(^ENG(6916.3,"C",ENDA,ENI))
if +ENI'=ENI
QUIT
Begin DoDot:1
+4 SET ENX=$PIECE($PIECE($GET(^ENG(6916.3,ENI,0)),U,5),".")
if ENX=""
QUIT
+5 if '$DATA(^TMP($JOB,"ENITRRH","DATES",ENX))
SET ^TMP($JOB,"ENITRRH","DATES",ENX)=$$FMTE^XLFDT(ENX)
+6 SET ENJ=0
+7 FOR
SET ENJ=$ORDER(^ENG(6916.3,ENI,3,ENJ))
if +ENJ'=ENJ
QUIT
Begin DoDot:2
+8 SET ENX=$PIECE($PIECE($GET(^ENG(6916.3,ENI,3,ENJ,0)),U),".")
if ENX=""
QUIT
+9 if '$DATA(^TMP($JOB,"ENITRRH","DATES",ENX))
SET ^TMP($JOB,"ENITRRH","DATES",ENX)=$$FMTE^XLFDT(ENX)
End DoDot:2
End DoDot:1
+10 WRITE @IOF,?5,"Signature Dates"
SET ENL=1
+11 SET ENI=""
SET ENCNT=0
+12 FOR
SET ENI=$ORDER(^TMP($JOB,"ENITRRH","DATES",ENI),-1)
if ENI=""
QUIT
Begin DoDot:1
+13 IF IOSL-2'>ENL
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET ENL=0
if $DATA(DIRUT)
QUIT
+14 WRITE !?5,$PIECE(^TMP($JOB,"ENITRRH","DATES",ENI),U)
SET ENL=ENL+1
SET ENCNT=ENCNT+1
End DoDot:1
if $DATA(DIRUT)
QUIT
+15 IF 'ENCNT
WRITE !?3,"* No Signed Assignments *"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT ""
+16 KILL DIRUT,DIROUT,DTOUT,DUOUT
WRITE !
+17 KILL DIR
SET DIR(0)="DA^3061001:"_DT_"^I '$D(^TMP($J,""ENITRRH"",""DATES"",Y)) K X"
SET DIR("A")="Date of Hand Receipt Signature: "
SET DIR("?")="Enter date from list."
+18 if ENCNT=1
SET DIR("B")=$$FMTE^XLFDT($ORDER(^TMP($JOB,"ENITRRH","DATES","")))
+19 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y'?7N)
SET Y=""
+20 SET ENDATE=Y
KILL ^TMP($JOB,"ENITRRH","DATES")
+21 QUIT ENDATE
+22 ;
+23 ;ENTIRRH1
