source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRPCNO1.m

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1WVRPCNO1 ;HIOFO/FT-WV PRINT LETTERS. ;8/21/03 13:37
2 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #10063 - ^%ZTLOAD call (supported)
6 ; #10103 - ^XLFDT calls (supported)
7 ; #10104 - ^XLFSTR calls (supported)
8 ;
9 ; The following entry point(s) are documented by IAs:
10 ; LETTER - 4103 (private)
11 ;
12DEVICE(WVDA,WVPRINTR) ; Queue to TaskMan to print letter
13 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
14 S ZTDESC="Print Women's Health letter"
15 S ZTDTH=$$NOW^XLFDT()
16 S ZTIO=WVPRINTR
17 S ZTRTN="PRINT^WVRPCNO1"
18 S ZTSAVE("WVDA")=""
19 D ^%ZTLOAD
20 Q
21PRINT ; Print notification letter, update treatment needs & due dates
22 ; required variable: wvda=ien in ^WV(790.4,
23 I $D(ZTQUEUED) S ZTREQ="@"
24 N BY,DIWF,WVDFN,WVKDT,WVPURP
25 S IOP=ION
26 S WVDFN=$P(^WV(790.4,WVDA,0),U)
27 S WVPURP=$P(^WV(790.4,WVDA,0),U,4)
28 S:'$D(WVKDT) WVKDT=$P(^WV(790.4,WVDA,0),U,11)
29 ; if no purpose (deleted), kill "aprt" xref and quit.
30 I 'WVPURP D Q
31 .D KILLXREF^WVLETPR(WVDA,WVKDT)
32 S DIWF="^WV(790.404,WVPURP,1,"
33 S DIWF(1)=790
34 S BY="INTERNAL(#.01)="_WVDFN
35 ; Compute future appointments
36 D KAPPT^WVUTL9(WVDFN) ;kill off old computed appts.
37 D GAPPT^WVUTL9(WVDFN) ;get future appts
38 D SAPPT^WVUTL9(WVDFN) ;set appts in File 790
39 D KILLUG^WVUTL9 ;kill off Utility global off future appts
40 D KADD^WVUTL9(WVDFN) ;kill off old computed address
41 D GADD^WVUTL9(WVDFN) ;get current complete address
42 D SADD^WVUTL9(WVDFN) ;set complete address in File 790
43 D KVAR^WVUTL9 ;clean-up VADPT variables used
44 ; print the letter
45 D EN2^DIWF
46 ; don't stuff "date printed" if it already has a "date printed".
47 I $P(^WV(790.4,WVDA,0),U,10)]"" D KILLXREF^WVLETPR(WVDA,WVKDT) Q
48 ;
49 ; next lines kill "aprt" xref and set "date printed"=today.
50 ; ("aprt" xref indicate a notification is queued to be printed.)
51 D KILLXREF^WVLETPR(WVDA,WVKDT)
52 D DIE^WVFMAN(790.4,".1////"_DT,WVDA)
53 Q
54LETTER(RESULT,WVIEN) ; Returns the letter text for the purpose of
55 ; notification
56 ; Input: RESULT - array name to return data in [required]
57 ; WVIEN - FILE 790.404 IEN [required]
58 ;
59 ; Output: RESULT(0)=First line of letter text <OR>
60 ; -1^error message
61 ; RESULT(n)= remaining lines of letter text
62 I '$G(WVIEN) S RESULT(0)="-1^Purpose IEN not greater than 0" Q
63 I '$D(^WV(790.404,WVIEN,0)) D Q
64 .S RESULT(0)="-1^No such purpose of notification"
65 .Q
66 I '$O(^WV(790.404,WVIEN,1,0)) D Q
67 .S RESULT(0)="-1^No letter defined for this purpose"
68 .Q
69 N WVCNT,WVLOOP
70 S RESULT(0)="",(WVCNT,WVLOOP)=0
71 F S WVLOOP=$O(^WV(790.404,WVIEN,1,WVLOOP)) Q:'WVLOOP D
72 .S WVCNT=WVCNT+1
73 .S RESULT(WVCNT)=$G(^WV(790.404,WVIEN,1,WVLOOP,0))
74 .Q
75 Q
76 ;
77GETDXIEN(WVX) ; Function returns FILE 790.31 IEN
78 ; Input: WVX="A" for Abnormal
79 ; "N" for No Evidence of Malignancy
80 ; "U" for Unsatisfactory for Dx
81 ; Output: IEN of corresponding FILE 790.31 entry
82 S WVX=$G(WVX,"")
83 I WVX="" Q ""
84 S WVX=$$UP^XLFSTR(WVX)
85 I WVX="A" Q $O(^WV(790.31,"B","Abnormal",0))
86 I WVX="N" Q $O(^WV(790.31,"B","No Evidence of Malignancy",0))
87 I WVX="U" Q $O(^WV(790.31,"B","Unsatisfactory for Dx",0))
88 Q ""
89 ;
90GETYPIEN(WVX) ; Function returns FILE 790.403 IEN
91 ; Input: WVX="P" for CONTACT PHN
92 ; WVX="I" for CONVERSATION WITH PATIENT
93 ; WVX="L" for LETTER, FIRST
94 ; Output: IEN of corresponding FILE 790.403 entry
95 S WVX=$G(WVX,"")
96 I WVX="" Q ""
97 S WVX=$$UP^XLFSTR(WVX)
98 I WVX="P" Q $O(^WV(790.403,"B","CONTACT PHN",0))
99 I WVX="I" Q $O(^WV(790.403,"B","CONVERSATION WITH PATIENT",0))
100 I WVX="L" Q $O(^WV(790.403,"B","LETTER, FIRST",0))
101 Q ""
102 ;
103GETOIEN(WVX) ; Function returns FILE 790.405 IEN
104 ; Input: WVX = .01 value of FILE 790.405 entry (Outcome)
105 ; Output: IEN of that entry
106 S WVX=$G(WVX,"")
107 I WVX="" Q ""
108 Q $O(^WV(790.405,"B",WVX,0))
109 ;
Note: See TracBrowser for help on using the repository browser.