source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFAR9.m@ 1450

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1ENFAR9 ;WIRMFO/SAB-FAP DOCUMENT HISTORY OF EQUIPMENT ;7.21.97
2 ;;7.0;ENGINEERING;**29,39**;AUG 17, 1993
3 ;
4EN ; entry
5 ; ask equipment
6 D GETEQ^ENUTL G:Y'>0 EXIT
7 S ENDA("EQ")=+Y
8 ; ask detailed
9 S DIR(0)="Y",DIR("A")="Include transaction details",DIR("B")="YES"
10 D ^DIR K DIR G:$D(DIRUT) EXIT
11 S ENDETAIL=+Y
12 ; ask device
13 S %ZIS="QM" D ^%ZIS G:POP EXIT
14 I $D(IO("Q")) D G EN
15 . S ZTRTN="QEN^ENFAR9",ZTDESC="FAP Document History of Equipment"
16 . S ZTSAVE("ENDA(""EQ"")")="",ZTSAVE("ENDETAIL")=""
17 . D ^%ZTLOAD,HOME^%ZIS K ZTSK
18QEN ; queued entry
19 U IO
20 ; find FAP documents
21 K ENDOC
22 S ENVALFA=0,ENVALFB=0
23 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDTR=Y
24 D HD
25 F ENFILE=6915.2:.1:6915.6 D
26 . S ENDA("F?")=0
27 . F S ENDA("F?")=$O(^ENG(ENFILE,"B",ENDA("EQ"),ENDA("F?"))) Q:'ENDA("F?") D
28 . . S ENDT=$$GET1^DIQ(ENFILE,ENDA("F?"),1,"I")
29 . . S:ENDT ENDOC(ENDT,ENFILE,ENDA("F?"))=""
30 I '$D(ENDOC) W !!," NO FAP DOCUMENTS FOUND"
31 I $D(ENDOC) D
32 . ; load FA Type -> SGL table
33 . K ENFATT S I=0 F S I=$O(^ENG(6914.3,I)) Q:'I S X=^(I,0) I $P(X,U)]"",$P(X,U,3)]"" S ENFATT($P(X,U,3))=$P(X,U)
34 . I ENDETAIL D ; for calls to ENFARC2
35 . . S ENTAG("HD")="HD^ENFAR9"
36 . . S ENTAG("HDC")="HDC^ENFAR9"
37 . . S ENTAG("FT")="FT^ENFAR9"
38 . ; print data
39 . S ENDT="" F S ENDT=$O(ENDOC(ENDT)) Q:ENDT="" D Q:END
40 . . S ENFILE="" F S ENFILE=$O(ENDOC(ENDT,ENFILE)) Q:ENFILE="" D Q:END
41 . . . S ENDA("F?")=$O(ENDOC(ENDT,ENFILE,0))
42 . . . D @("DOC"_$P(ENFILE,".",2))
43 . . . I 'ENDETAIL,$Y+6>IOSL D FT,HD Q:END
44 . . . I ENDETAIL,$Y+11>IOSL D FT,HD Q:END
45 . . . W !,ENTRC,?6,ENTRN,?16,$TR($$FMTE^XLFDT(ENDT,"2DF")," ",0),?26,ENSN
46 . . . W:ENFAT]"" ?33,$G(ENFATT(ENFAT))
47 . . . W:ENVAL]"" ?38,$J("$"_$FN(ENVAL,",",2),14)
48 . . . W ?54,$E($P($$GET1^DIQ(ENFILE,ENDA("F?"),1.5),","),1,10)
49 . . . W ?65,$J("$"_$FN(ENVALFA+ENVALFB,",",2),14)
50 . . . I ENDETAIL W:ENFILE'[".6" ! D @("F"_$P(ENFILE,".",2)_"^ENFARC2") W !
51 I 'END D FT
52 D ^%ZISC
53 I $E(IOST,1,2)="C-" W ! G EN
54EXIT I $D(ZTQUEUED) S ZTREQ="@"
55 K END,ENDA,ENDETAIL,ENDOC,ENDT,ENDTR,ENFAT,ENFATT,ENFILE
56 K ENPG,ENSN,ENTAG,ENTRC,ENTRN,ENVAL,ENVALFA,ENVALFB,I,X,Y
57 Q
58HD ; header
59 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
60 I $E(IOST,1,2)="C-"!ENPG W @IOF S $X=0
61 S ENPG=ENPG+1
62 W "FAP DOCUMENT HISTORY FOR EQUIPMENT",?49,ENDTR,?72,"page ",ENPG
63 W !," ENTRY #: ",ENDA("EQ")
64 W " CURRENT VALUE: $",$FN($$GET1^DIQ(6914,ENDA("EQ"),12),",",2)
65 W !!,"TRANSACTION",?26,"STA",?33,"SGL",?38,"DOCUMENT VALUE",?54,"SENDER",?65,"ASSET VALUE"
66 W !,"CODE*",?6,"NUMBER",?16,"DATE",?26,"NBR",?65,"AFTER DOCUMENT"
67 W !,"-----",?6,"---------",?16,"--------",?26,"-----",?33,"----"
68 W ?38,"--------------",?54,"----------",?65,"--------------"
69 Q
70HDC ; header for continued transaction
71 W !,?5,"Transaction: ",$E(ENTRC,1,2),"-",ENTRN," (continued)"
72 Q
73FT ; footer
74 W !!," * Betterment # follows FB and FC. T (Turn-In) or D (Final Disp.) follows FD."
75 Q
76DOC2 ; FA document
77 S ENTRC="FA 00"
78 S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
79 S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),24),1,5)
80 S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),25)
81 S ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),53)
82 S ENVALFA=ENVAL,ENVALFB=0
83 S ENDA("FA")=ENDA("F?")
84 Q
85DOC3 ; FB document
86 S ENTRC="FB "_$$GET1^DIQ(ENFILE,ENDA("F?"),23)
87 S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
88 S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),21),1,5)
89 S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),22)
90 S ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),36)
91 S ENVALFB=ENVALFB+ENVAL
92 Q
93DOC4 ; FC document
94 S ENTRC="FC "_$$GET1^DIQ(ENFILE,ENDA("F?"),27)
95 S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
96 S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),25),1,5)
97 S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),26)
98 S ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),54)
99 I ENTRC["00",ENVAL]"" S ENVALFA=ENVAL
100 I ENTRC'["00",ENVAL]"" S ENVALFB=ENVALFB+(ENVAL-$$GET1^DIQ(ENFILE,ENDA("F?"),103))
101 Q
102DOC5 ; FD document
103 S ENTRC="FD "_$$GET1^DIQ(ENFILE,ENDA("F?"),100,"I")
104 S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
105 S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),27),1,5)
106 S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),28)
107 S ENVAL=""
108 Q
109DOC6 ; FR document
110 S ENTRC="FR"
111 S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
112 S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),24),1,5)
113 S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),25)
114 S ENVAL=""
115 Q
116 ;ENFAR9
Note: See TracBrowser for help on using the repository browser.