| 1 | ENTIRRH ;WOIFO/LKG - Print hand receipt ;3/19/08 15:48
|
|---|
| 2 | ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
|
|---|
| 3 | ASK ;Main entry point
|
|---|
| 4 | N ENOPT D OP^XQCHK S ENOPT=$P(XQOPT,U)
|
|---|
| 5 | K DIR S DIR(0)="S^D:DATE OF SIGNATURE;S:SIGNED;U:UNSIGNED",DIR("A")="Print Hand Receipt for Unsigned or Signed IT assignments",DIR("B")="UNSIGNED"
|
|---|
| 6 | S DIR("?",1)="'D' selects assignments signed electronically or via wet signature on a"
|
|---|
| 7 | S DIR("?",2)=" given date, regardless of current status."
|
|---|
| 8 | S DIR("?",3)="'S' selects active assignments signed electronically or via wet signature."
|
|---|
| 9 | S DIR("?",4)="'U' selects active assignments not signed, either electronically or via wet"
|
|---|
| 10 | S DIR("?",5)=" signature or signed documents where the signature date is more than"
|
|---|
| 11 | S DIR("?")=" 359 days ago. Assignments must be re-signed annually."
|
|---|
| 12 | D ^DIR K DIR I $D(DIRUT) K DIRUT,DIROUT,DTOUT,DUOUT Q
|
|---|
| 13 | G:Y="D" USER^ENTIRRH1:ENOPT="ENIT PRINT HAND RCPT (COM)",ITST2^ENTIRRH1:ENOPT="ENIT PRINT HAND RCPT (IT)"
|
|---|
| 14 | G:Y="U" USTART:ENOPT="ENIT PRINT HAND RCPT (COM)",ITSTART:ENOPT="ENIT PRINT HAND RCPT (IT)"
|
|---|
| 15 | G:Y="S" USER:ENOPT="ENIT PRINT HAND RCPT (COM)",ITST2:ENOPT="ENIT PRINT HAND RCPT (IT)"
|
|---|
| 16 | W !,"UNKNOWN" Q
|
|---|
| 17 | ITSTART ;Entry point for IT
|
|---|
| 18 | N ENDA,ENVR S ENVR=$O(^ENG(6916.2,"@"),-1) I ENVR'>0 W !,"There are no hand receipt templates on file." K DIR S DIR(0)="E" D ^DIR K DIR Q
|
|---|
| 19 | N DIC,DTOUT,DUOUT S DIC=200,DIC(0)="AEMQ",DIC("A")="IT Responsible Person: ",DIC("S")="I $D(^ENG(6916.3,""AOA"",Y))"
|
|---|
| 20 | D ^DIC I Y<1!$D(DTOUT)!$D(DUOUT) Q
|
|---|
| 21 | S ENDA=+Y
|
|---|
| 22 | S %ZIS="Q" D ^%ZIS I POP K POP Q
|
|---|
| 23 | I $D(IO("Q")) S ZTRTN="IN^ENTIRRH",ZTDESC="IT Equipment Hand Receipt Print",ZTSAVE("ENDA")="",ZTSAVE("ENVR")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q") Q
|
|---|
| 24 | G IN
|
|---|
| 25 | USTART ;User entry point
|
|---|
| 26 | N ENDA,ENVR S ENVR=$O(^ENG(6916.2,"@"),-1) I ENVR'>0 W !,"There are no hand receipt templates on file." K DIR S DIR(0)="E" D ^DIR K DIR Q
|
|---|
| 27 | I '$D(^ENG(6916.3,"AOA",DUZ)) W !,"You have no active IT assignments." K DIR S DIR(0)="E" D ^DIR K DIR Q
|
|---|
| 28 | S ENDA=DUZ
|
|---|
| 29 | S %ZIS="Q" D ^%ZIS I POP K POP Q
|
|---|
| 30 | I $D(IO("Q")) S ZTRTN="IN^ENTIRRH",ZTDESC="IT Equipment Hand Receipt Print",ZTSAVE("ENDA")="",ZTSAVE("ENVR")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q") Q
|
|---|
| 31 | G IN
|
|---|
| 32 | IN ;
|
|---|
| 33 | U IO
|
|---|
| 34 | N DIR,DIRUT,DIROUT,DTOUT,DUOUT,END,ENDAC,ENERR,ENI,ENLNCNT,ENMFGN,ENMODEL,ENNOW,ENPG,ENEQPT,ENX,ENNBR,ENSERNBR,ENNAME,ENSTN,X,Y
|
|---|
| 35 | S ENNAME=$$GET1^DIQ(200,ENDA_",",.01),ENNOW=$$FMTE^XLFDT($$NOW^XLFDT(),"2M"),ENPG=0,ENEQPT=1 S:'$G(DT) DT=$$DT^XLFDT()
|
|---|
| 36 | S ENSTN=+$O(^DIC(6910,0)),ENSTN=$$GET1^DIQ(6910,ENSTN_",",1)
|
|---|
| 37 | D HDR1 G:$D(DIRUT) EX
|
|---|
| 38 | K ^TMP($J,"ENITRRH"),ENERR
|
|---|
| 39 | D FIND^DIC(6916.3,"","@;.01;1;20","PQ",ENDA,"","AOA","I $P(^(0),U,8)="""",$S($P(^(0),U,5)="""":1,$$FMDIFF^XLFDT(DT,$P(^(0),U,5))>359:1,1:0)","","^TMP($J,""ENITRRH"")","ENERR")
|
|---|
| 40 | I $P($G(^TMP($J,"ENITRRH","DILIST",0)),U)'>0 W !,"The are no unsigned IT assignments." G EX
|
|---|
| 41 | I '$$CMP^XUSESIG1($P($G(^ENG(6916.2,ENVR,0)),U,3),$NAME(^ENG(6916.2,ENVR,1))) W !!!,"Hand receipt text is corrupted - Please contact EPS AEMS/MERS support" G EX
|
|---|
| 42 | S ENI=0
|
|---|
| 43 | F S ENI=$O(^TMP($J,"ENITRRH","DILIST",ENI)) Q:+ENI'=ENI D Q:$D(DIRUT)
|
|---|
| 44 | . S ENX=$G(^TMP($J,"ENITRRH","DILIST",ENI,0))
|
|---|
| 45 | . S ENDAC=$P(ENX,U,2)_"," D GETS^DIQ(6914,ENDAC,"3;4;5","E","END","ENERR")
|
|---|
| 46 | . S ENNBR=$P(ENX,U,2),ENMFGN=$G(END(6914,ENDAC,3,"E")),ENMODEL=$G(END(6914,ENDAC,4,"E")),ENSERNBR=$G(END(6914,ENDAC,5,"E"))
|
|---|
| 47 | . I IOSL-1'>ENLNCNT D HDR1 Q:$D(DIRUT)
|
|---|
| 48 | . W !,ENNBR,?11,$E(ENMFGN,1,20),?35,ENMODEL,?65,ENSERNBR S ENLNCNT=ENLNCNT+1
|
|---|
| 49 | G:$D(DIRUT) EX
|
|---|
| 50 | S ENEQPT=0
|
|---|
| 51 | I IOSL-1'>ENLNCNT D HDR1 G:$D(DIRUT) EX
|
|---|
| 52 | I ENLNCNT>3 W !! S ENLNCNT=ENLNCNT+2
|
|---|
| 53 | S ENI=0 F S ENI=$O(^ENG(6916.2,ENVR,1,ENI)) Q:+ENI'=ENI D Q:$D(DIRUT)
|
|---|
| 54 | . I IOSL-1'>ENLNCNT D HDR1 Q:$D(DIRUT)
|
|---|
| 55 | . W !,$G(^ENG(6916.2,ENVR,1,ENI,0)) S ENLNCNT=ENLNCNT+1
|
|---|
| 56 | G:$D(DIRUT) EX
|
|---|
| 57 | I IOSL-6'>ENLNCNT D HDR1 G:$D(DIRUT) EX
|
|---|
| 58 | W !!! S ENLNCNT=ENLNCNT+3
|
|---|
| 59 | W !,"Signature:______________________________ Date:________________"
|
|---|
| 60 | W !,?12,$P($$ESBLOCK^XUSESIG1(ENDA),U)
|
|---|
| 61 | I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR
|
|---|
| 62 | EX S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
|
|---|
| 63 | K ^TMP($J,"ENITRRH"),ENDA,ENVR
|
|---|
| 64 | Q
|
|---|
| 65 | HDR1 ;Logic to print report heading
|
|---|
| 66 | I $E(IOST,1,2)="C-",ENPG K DIR S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)
|
|---|
| 67 | W:$E(IOST,1,2)="C-"!ENPG @IOF S ENPG=ENPG+1
|
|---|
| 68 | W $S($G(ENPRT)="SIGNED":"IT HAND RECEIPT/LOAN FORM FOR GOVERNMENT FURNISHED EQUIPMENT (GFE) Page ",1:"INFORMATION TECHNOLOGY HAND RECEIPT FOR GOVERNMENT FURNISHED EQUIPMENT Page "),ENPG
|
|---|
| 69 | W:$G(ENPRT)="SIGNED" !,"Electronic Accepted Substitute for VA Form 0887(a/b)"
|
|---|
| 70 | W !,"STATION: ",ENSTN,?14,"ASSIGNED TO: ",$E(ENNAME,1,30),?58,"Printed ",ENNOW,! S ENLNCNT=$S($G(ENPRT)="SIGNED":4,1:3)
|
|---|
| 71 | I ENEQPT W !,"ENTRY #",?11,"MFG EQUIP NAME",?35,"MODEL",?65,"SERIAL#",!,"---------",?11,"--------------------",?35,"--------------------------",?65,"----------" S ENLNCNT=ENLNCNT+2
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | ITST2 ;IT personnel entry point for printing signed hand receipts
|
|---|
| 75 | N ENDA
|
|---|
| 76 | N DIC,DTOUT,DUOUT S DIC=200,DIC(0)="AEMQ",DIC("S")="I $D(^ENG(6916.3,""AOA"",Y))"
|
|---|
| 77 | D ^DIC I Y<1!$D(DTOUT)!$D(DUOUT) Q
|
|---|
| 78 | S ENDA=+Y
|
|---|
| 79 | I '$$SIGNED(ENDA) W !,"There are no active, Signed/Certified IT assignments for "_$$GET1^DIQ(200,ENDA_",",.01)_"." K DIR S DIR(0)="E" D ^DIR K DIR Q
|
|---|
| 80 | S %ZIS="Q" D ^%ZIS I POP K POP Q
|
|---|
| 81 | I $D(IO("Q")) S ZTRTN="IN2^ENTIRRH",ZTDESC="IT Equipment Hand Receipt Print",ZTSAVE("ENDA")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q") Q
|
|---|
| 82 | G IN2
|
|---|
| 83 | USER ;User entry point for printing signed hand receipts
|
|---|
| 84 | I '$D(^ENG(6916.3,"AOA",DUZ)) W !,"You have no active IT assignments." K DIR S DIR(0)="E" D ^DIR K DIR Q
|
|---|
| 85 | N ENDA S ENDA=DUZ
|
|---|
| 86 | I '$$SIGNED(ENDA) W !,"You do not have any active, Signed/Certified IT assignments." K DIR S DIR(0)="E" D ^DIR K DIR Q
|
|---|
| 87 | S %ZIS="Q" D ^%ZIS I POP K POP Q
|
|---|
| 88 | I $D(IO("Q")) S ZTRTN="IN2^ENTIRRH",ZTDESC="IT Equipment Hand Receipt Print",ZTSAVE("ENDA")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q") Q
|
|---|
| 89 | G IN2
|
|---|
| 90 | IN2 ;
|
|---|
| 91 | N DIR,DIRUT,DIROUT,DTOUT,DUOUT,ENVR,ENPRT S ENPRT="SIGNED"
|
|---|
| 92 | S ENVR=0 F S ENVR=$O(^ENG(6916.2,ENVR)) Q:+ENVR'=ENVR D PRT Q:$D(DIRUT)
|
|---|
| 93 | G EX2
|
|---|
| 94 | PRT U IO
|
|---|
| 95 | N END,ENDAC,ENERR,ENI,ENLNCNT,ENMFGN,ENMODEL,ENNOW,ENEQPT,ENPG,ENRDA,ENX,ENNBR,ENSERNBR,ENSIG,ENSIGNDT,ENNAME,ENSTN,ENVAL,X,Y S ENPG=0,ENEQPT=1
|
|---|
| 96 | S ENNAME=$$GET1^DIQ(200,ENDA_",",.01),ENNOW=$$FMTE^XLFDT($$NOW^XLFDT(),"2M")
|
|---|
| 97 | S ENSTN=+$O(^DIC(6910,0)),ENSTN=$$GET1^DIQ(6910,ENSTN_",",1)
|
|---|
| 98 | K ^TMP($J,"ENITRRH"),ENERR
|
|---|
| 99 | D FIND^DIC(6916.3,"","@;.01;1;20","PQ",ENDA,"","AOA","I $P(^(0),U,6)=ENVR,"";SIGNED;CERTIFIED;""[("";""_$$GET1^DIQ(6916.3,Y_"","",20)_"";"")","","^TMP($J,""ENITRRH"")","ENERR")
|
|---|
| 100 | I $P($G(^TMP($J,"ENITRRH","DILIST",0)),U)'>0 K ^TMP($J,"ENITRRH") Q
|
|---|
| 101 | D HDR1 Q:$D(DIRUT)
|
|---|
| 102 | 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
|
|---|
| 103 | S ENI=0
|
|---|
| 104 | F S ENI=$O(^TMP($J,"ENITRRH","DILIST",ENI)) Q:+ENI'=ENI D Q:$D(DIRUT)
|
|---|
| 105 | . N END,ENERR,ENERR1,ENERR2,ENERR3,ENERR4,X1,X2
|
|---|
| 106 | . S ENX=$G(^TMP($J,"ENITRRH","DILIST",ENI,0))
|
|---|
| 107 | . S ENDAC=$P(ENX,U,2)_"," D GETS^DIQ(6914,ENDAC,"3;4;5","E","END","ENERR")
|
|---|
| 108 | . S ENNBR=$P(ENX,U,2),ENMFGN=$G(END(6914,ENDAC,3,"E")),ENMODEL=$G(END(6914,ENDAC,4,"E")),ENSERNBR=$G(END(6914,ENDAC,5,"E"))
|
|---|
| 109 | . I IOSL-1'>ENLNCNT D HDR1 Q:$D(DIRUT)
|
|---|
| 110 | . W !,ENNBR,?11,$E(ENMFGN,1,20),?35,ENMODEL,?65,ENSERNBR S ENLNCNT=ENLNCNT+1
|
|---|
| 111 | . S ENRDA=$P(ENX,U) K ENERR,ENSIG,ENSIGNDT
|
|---|
| 112 | . S X=$G(^ENG(6916.3,ENRDA,1))
|
|---|
| 113 | . I X'="" D
|
|---|
| 114 | . . S X1=ENRDA,X2=1 D DE^XUSHSHP S ENSIG=$P(X,U),ENSIGNDT=$$FMTE^XLFDT($P(X,U,4))
|
|---|
| 115 | . . S:$P(X,U,8)'=$P($G(^ENG(6916.2,ENVR,0)),U,3) ENERR1=1
|
|---|
| 116 | . . S:$P(X,U,5)'=$P(ENX,U,2) ENERR2=1
|
|---|
| 117 | . . S:$P(X,U,6)'=$P($G(^ENG(6916.3,ENRDA,0)),U,2) ENERR3=1
|
|---|
| 118 | . . S:$P(X,U,4)'=$P($G(^ENG(6916.3,ENRDA,0)),U,5) ENERR4=1
|
|---|
| 119 | . I $D(ENSIGNDT) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?4,"Signed: ",ENSIGNDT,?35,"Signature: /ES/",$G(ENSIG) S ENLNCNT=ENLNCNT+1
|
|---|
| 120 | . I '$D(ENSIGNDT) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !,?4,"Signed: "_$$GET1^DIQ(6916.3,ENRDA_",",4),?35,"Certified by: ",$$GET1^DIQ(6916.3,ENRDA_",",6) S ENLNCNT=ENLNCNT+1
|
|---|
| 121 | . S ENVAL=$$LOAN($P(ENDAC,","))
|
|---|
| 122 | . W !,?2,"Issued By: ",$$ISSUEDBY(ENRDA),?49,"Contact #: ",$P(ENVAL,U,2) S ENLNCNT=ENLNCNT+1
|
|---|
| 123 | . W !,?2,"Equipment Return Date: ",$$DATEDUE($P(ENDAC,","),$P(ENVAL,U)) S ENLNCNT=ENLNCNT+1
|
|---|
| 124 | . I $G(ENERR1) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Hand Receipt Text Altered **" S ENLNCNT=ENLNCNT+1
|
|---|
| 125 | . I $G(ENERR2) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Assigned Equipment Altered **" S ENLNCNT=ENLNCNT+1
|
|---|
| 126 | . I $G(ENERR3) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Assigned Person Altered **" S ENLNCNT=ENLNCNT+1
|
|---|
| 127 | . I $G(ENERR4) D:IOSL-1'>ENLNCNT HDR1 Q:$D(DIRUT) W !?19,"** Date Signed Altered **" S ENLNCNT=ENLNCNT+1
|
|---|
| 128 | Q:$D(DIRUT) S ENEQPT=0
|
|---|
| 129 | I IOSL-3'>ENLNCNT D HDR1 Q:$D(DIRUT)
|
|---|
| 130 | I ENLNCNT>3 W !! S ENLNCNT=ENLNCNT+2
|
|---|
| 131 | S ENI=0 F S ENI=$O(^ENG(6916.2,ENVR,1,ENI)) Q:+ENI'=ENI D Q:$D(DIRUT)
|
|---|
| 132 | . I IOSL-1'>ENLNCNT D HDR1 Q:$D(DIRUT)
|
|---|
| 133 | . W !,$G(^ENG(6916.2,ENVR,1,ENI,0)) S ENLNCNT=ENLNCNT+1
|
|---|
| 134 | Q:$D(DIRUT)
|
|---|
| 135 | I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR
|
|---|
| 136 | Q
|
|---|
| 137 | EX2 S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
|
|---|
| 138 | K ^TMP($J,"ENITRRH"),ENDA
|
|---|
| 139 | Q
|
|---|
| 140 | SIGNED(ENDA) ;Returns how many signed/certified, active assignments exist for this person
|
|---|
| 141 | N ENERR,ENCNT
|
|---|
| 142 | K ^TMP($J,"ENITRRH")
|
|---|
| 143 | D FIND^DIC(6916.3,"","@","PQ",ENDA,"","AOA","I "";SIGNED;CERTIFIED;""[("";""_$$GET1^DIQ(6916.3,Y_"","",20)_"";"")","","^TMP($J,""ENITRRH"")","ENERR")
|
|---|
| 144 | S ENCNT=+$P($G(^TMP($J,"ENITRRH","DILIST",0)),U)
|
|---|
| 145 | K ^TMP($J,"ENITRRH")
|
|---|
| 146 | Q ENCNT
|
|---|
| 147 | ;
|
|---|
| 148 | ISSUEDBY(ENRDA) ;Name of person assigning responsibility
|
|---|
| 149 | N ENARR,ENDA,ENNAME S ENDA=$$GET1^DIQ(6916.3,ENRDA_",",3,"I")
|
|---|
| 150 | S ENARR("FILE")=200,ENARR("IENS")=ENDA_",",ENARR("FIELD")=".01"
|
|---|
| 151 | S ENNAME=$$NAMEFMT^XLFNAME(.ENARR,"G","L35")
|
|---|
| 152 | Q ENNAME
|
|---|
| 153 | ;
|
|---|
| 154 | DATEDUE(ENDA,ENADD) ;Returns Date Due for Return
|
|---|
| 155 | N ENINVDT,ENDT
|
|---|
| 156 | S ENINVDT=$$GET1^DIQ(6914,ENDA_",",23,"I") S:$G(ENADD)'>0 ENADD=90
|
|---|
| 157 | S ENDT=$S(ENINVDT="":DT,1:$$FMADD^XLFDT(ENINVDT,ENADD)),ENDT=$$FMTE^XLFDT(ENDT,"2M")
|
|---|
| 158 | Q ENDT
|
|---|
| 159 | ;
|
|---|
| 160 | LOAN(ENEQ) ;Loan Data for Equipment
|
|---|
| 161 | ;input ENDA (equipment ien file 6914)
|
|---|
| 162 | ;return value = number of days^loan form phone
|
|---|
| 163 | N ENCMR,ENRET,ENY1
|
|---|
| 164 | S ENRET="90^" ;default number of days is 90
|
|---|
| 165 | S ENCMR=$P($G(^ENG(6914,ENEQ,2)),U,9)
|
|---|
| 166 | S ENY1=$S(ENCMR:$G(^ENG(6914.1,ENCMR,1)),1:"")
|
|---|
| 167 | I $P(ENY1,U) S $P(ENRET,U)=$P(ENY1,U) ;days for CMR (if specified)
|
|---|
| 168 | I $P(ENY1,U,2)]"" S $P(ENRET,U,2)=$P(ENY1,U,2) ;loan form phone for CMR
|
|---|
| 169 | Q ENRET
|
|---|
| 170 | ;
|
|---|
| 171 | ;ENTIRRH
|
|---|
