source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENTIRRH1.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1ENTIRRH1 ;WOIFO/LKG - Print hand receipt (Continued) ;3/4/08 15:02
2 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
3HDR1 ;Logic to print report heading
4 G HDR1^ENTIRRH
5 Q
6 ;
7ITST2 ;IT personnel entry point for printing signed hand receipts
8 N ENDA,ENDATE
9 N DIC,DTOUT,DUOUT S DIC=200,DIC(0)="AEMQ",DIC("S")="I $D(^ENG(6916.3,""C"",Y))"
10 D ^DIC I Y<1!$D(DTOUT)!$D(DUOUT) Q
11 S ENDA=+Y
12 S ENDATE=$$DATES() I ENDATE="" Q
13 S %ZIS="Q" D ^%ZIS I POP K POP Q
14 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
15 G IN2
16USER ;User entry point for printing signed hand receipts
17 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
18 N ENDA,ENDATE S ENDA=DUZ
19 S ENDATE=$$DATES() I ENDATE="" Q
20 S %ZIS="Q" D ^%ZIS I POP K POP Q
21 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
22 G IN2
23IN2 ;
24 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,ENI,ENJ,ENL,ENNBR,ENV,ENVR,ENX
25 S ENI=0
26 F S ENI=$O(^ENG(6916.3,"C",ENDA,ENI)) Q:+ENI'=ENI D
27 . S ENX=$G(^ENG(6916.3,ENI,0)) Q:ENX=""
28 . 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)=""
29 . S ENJ=0
30 . F S ENJ=$O(^ENG(6916.3,ENI,3,ENJ)) Q:+ENJ'>0 D
31 . . S ENX=$G(^ENG(6916.3,ENI,3,ENJ,0)) Q:ENX=""
32 . . I $P($P(ENX,U),".")=ENDATE D
33 . . . S ENNBR=$P(^ENG(6916.3,ENI,0),U),ENV=$P(ENX,U,2)
34 . . . 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
35 S ENI=""
36 F S ENI=$O(^TMP($J,"ENITRRH","LIST",ENI)) Q:ENI="" S ENVR=$P(ENI,"V",2) D PRT
37 G EX2
38PRT U IO
39 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
40 S ENNAME=$$GET1^DIQ(200,ENDA_",",.01),ENNOW=$$FMTE^XLFDT($$NOW^XLFDT(),"2M")
41 S ENSTN=+$O(^DIC(6910,0)),ENSTN=$$GET1^DIQ(6910,ENSTN_",",1)
42 D HDR1 Q:$D(DIRUT)
43 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
44 S ENNBR=0,ENV="V"_ENVR
45 F S ENNBR=$O(^TMP($J,"ENITRRH","LIST",ENV,ENNBR)) Q:ENNBR="" D Q:$D(DIRUT)
46 . S ENI=0
47 . F S ENI=$O(^TMP($J,"ENITRRH","LIST",ENV,ENNBR,ENI)) Q:ENI="" D Q:$D(DIRUT)
48 . . N END,ENERR,ENERR1,ENERR2,ENERR3,ENERR4,X1,X2
49 . . S ENDAC=ENNBR_"," D GETS^DIQ(6914,ENDAC,"3;4;5","E","END","ENERR")
50 . . S ENMFGN=$G(END(6914,ENDAC,3,"E")),ENMODEL=$G(END(6914,ENDAC,4,"E")),ENSERNBR=$G(END(6914,ENDAC,5,"E"))
51 . . I IOSL-1'>ENLNCNT D HDR1 Q:$D(DIRUT)
52 . . W !,ENNBR,?11,$E(ENMFGN,1,20),?35,ENMODEL,?65,ENSERNBR S ENLNCNT=ENLNCNT+1
53 . . S ENRDA=ENI,ENRDA1=$P(^TMP($J,"ENITRRH","LIST",ENV,ENNBR,ENI),U)
54 . . K ENERR,ENSIG,ENSIGNDT
55 . . S X=$S(ENRDA1>0:$G(^ENG(6916.3,ENRDA,3,ENRDA1,1)),1:$G(^ENG(6916.3,ENRDA,1)))
56 . . I X'="" D
57 . . . S X1=ENRDA,X2=1 D DE^XUSHSHP S ENSIG=$P(X,U),ENSIGNDT=$$FMTE^XLFDT($P(X,U,4))
58 . . . S:$P(X,U,8)'=$P($G(^ENG(6916.2,ENVR,0)),U,3) ENERR1=1
59 . . . S:$P(X,U,5)'=ENNBR ENERR2=1
60 . . . S:$P(X,U,6)'=$P($G(^ENG(6916.3,ENRDA,0)),U,2) ENERR3=1
61 . . . 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
62 . . I $D(ENSIGNDT) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?4,"Signed: ",ENSIGNDT,?35,"Signature: /ES/",$G(ENSIG) S ENLNCNT=ENLNCNT+1
63 . . I '$D(ENSIGNDT) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) D
64 . . . W !,?4,"Signed: "_$S(ENRDA1>0:$$GET1^DIQ(6916.31,ENRDA1_","_ENRDA_",",.01),1:$$GET1^DIQ(6916.3,ENRDA_",",4))
65 . . . W ?35,"Certified by: "_$S(ENRDA1>0:$$GET1^DIQ(6916.31,ENRDA1_","_ENRDA_",",3),1:$$GET1^DIQ(6916.3,ENRDA_",",6))
66 . . . S ENLNCNT=ENLNCNT+1
67 . . I $G(ENERR1) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Hand Receipt Text Altered **" S ENLNCNT=ENLNCNT+1
68 . . I $G(ENERR2) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Assigned Equipment Altered **" S ENLNCNT=ENLNCNT+1
69 . . I $G(ENERR3) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Assigned Person Altered **" S ENLNCNT=ENLNCNT+1
70 . . I $G(ENERR4) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Date Signed Altered **" S ENLNCNT=ENLNCNT+1
71 . . 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
72 Q:$D(DIRUT) S ENEQPT=0
73 I IOSL-3'>ENLNCNT D HDR1 Q:$D(DIRUT)
74 I ENLNCNT>3 W !! S ENLNCNT=ENLNCNT+2
75 S ENI=0 F S ENI=$O(^ENG(6916.2,ENVR,1,ENI)) Q:+ENI'=ENI D Q:$D(DIRUT)
76 . I IOSL-1'>ENLNCNT D HDR1 Q:$D(DIRUT)
77 . W !,$G(^ENG(6916.2,ENVR,1,ENI,0)) S ENLNCNT=ENLNCNT+1
78 Q:$D(DIRUT)
79 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR
80 Q
81EX2 S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
82 K ^TMP($J,"ENITRRH"),ENDA,ENDATE
83 Q
84DATES() ;Signature Dates for User
85 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()
86 S ENI=0
87 F S ENI=$O(^ENG(6916.3,"C",ENDA,ENI)) Q:+ENI'=ENI D
88 . S ENX=$P($P($G(^ENG(6916.3,ENI,0)),U,5),".") Q:ENX=""
89 . S:'$D(^TMP($J,"ENITRRH","DATES",ENX)) ^TMP($J,"ENITRRH","DATES",ENX)=$$FMTE^XLFDT(ENX)
90 . S ENJ=0
91 . F S ENJ=$O(^ENG(6916.3,ENI,3,ENJ)) Q:+ENJ'=ENJ D
92 . . S ENX=$P($P($G(^ENG(6916.3,ENI,3,ENJ,0)),U),".") Q:ENX=""
93 . . S:'$D(^TMP($J,"ENITRRH","DATES",ENX)) ^TMP($J,"ENITRRH","DATES",ENX)=$$FMTE^XLFDT(ENX)
94 W @IOF,?5,"Signature Dates" S ENL=1
95 S ENI="",ENCNT=0
96 F S ENI=$O(^TMP($J,"ENITRRH","DATES",ENI),-1) Q:ENI="" D Q:$D(DIRUT)
97 . I IOSL-2'>ENL K DIR S DIR(0)="E" D ^DIR K DIR S ENL=0 Q:$D(DIRUT)
98 . W !?5,$P(^TMP($J,"ENITRRH","DATES",ENI),U) S ENL=ENL+1,ENCNT=ENCNT+1
99 I 'ENCNT W !?3,"* No Signed Assignments *" K DIR S DIR(0)="E" D ^DIR K DIR Q ""
100 K DIRUT,DIROUT,DTOUT,DUOUT W !
101 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."
102 S:ENCNT=1 DIR("B")=$$FMTE^XLFDT($O(^TMP($J,"ENITRRH","DATES","")))
103 D ^DIR K DIR I $D(DIRUT)!$D(DIROUT)!(Y'?7N) S Y=""
104 S ENDATE=Y K ^TMP($J,"ENITRRH","DATES")
105 Q ENDATE
106 ;
107 ;ENTIRRH1
Note: See TracBrowser for help on using the repository browser.