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