source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVUTL6.m@ 1361

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

initial load of WorldVistAEHR

File size: 5.3 KB
RevLine 
[613]1WVUTL6 ;HCIOFO/FT,JR-UTIL: TEXT VALS, DEF PRINT DATE; ;10/11/99 14:03
2 ;;1.0;WOMEN'S HEALTH;**3,7**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; UTILITY: TEXT FOR PROVIDER, PROCEDURE, HOSP LOC, INSTIT, & ECC.
6 ;; PROC SPECIAL VALUE (PAP, MAM, COLP). COMPUTE DEFAULT PRINT DATE.
7 ;
8 ;
9PROV() ;EP
10 ;---> RETURN TEXT OF PROVIDER'S NAME.
11 ;---> REQUIRED VARIABLE: X=IEN IN NEW PERSON FILE #200.
12 N WVNAME
13 Q:'$D(X) ""
14 Q:'X "UNKNOWN"
15 S WVNAME=$$GET1^DIQ(200,X,.01,"E")
16 Q $S(WVNAME'="":WVNAME,1:"UNKNOWN POINTER")
17 ;
18 ;
19PCDNAM() ;EP
20 ;---> RETURN TEXT OF PROCEDURE TYPE.
21 ;---> REQUIRED VARIABLE: X=IEN IN WV PROCEDURE TYPE FILE #790.2.
22 Q:'$D(X) ""
23 Q:'X "UNKNOWN"
24 Q:'$D(^WV(790.2,X,0)) "UNKNOWN POINTER"
25 Q $P(^WV(790.2,X,0),U)
26 ;
27HOSPLC() ;EP
28 ;---> RETURN TEXT OF HOSPITAL LOCATION NAME.
29 ;---> REQUIRED VARIABLE: X=IEN IN HOSPITAL LOCATION FILE #44.
30 Q:'$D(X) ""
31 Q:'X "UNKNOWN"
32 Q:'$D(^SC(X,0)) "UNKNOWN POINTER"
33 Q $P(^SC(X,0),U)
34 ;
35INSTIT() ;EP
36 ;---> RETURN IEN OF INSTITUTION (FACILITY) FILE 4, FOR THIS HOSPITAL
37 ;---> LOCATION ENTRY IN HOSPITAL LOCATION FILE 44.
38 ;---> ALSO CONCATENATE "`" TO THE FRONT OF IEN FOR USE IN DR STRINGS.
39 Q:'$D(X) ""
40 Q:X="" ""
41 Q:'$D(^SC(X,0)) ""
42 Q:$P(^SC(X,0),U,4)']"" ""
43 Q "`"_$P(^SC(X,0),U,4)
44 ;
45INSTTX(FACILITY) ;EP
46 ;---> RETURN TEXT OF INSTITUTION (FACILITY) NAME.
47 ;---> REQUIRED VARIABLE: X=IEN IN INSTITUTION FILE #4.
48 Q:'$G(FACILITY) ""
49 N WVDIC4
50 S WVDIC4=$$GET1^DIQ(4,FACILITY,.01,"E")
51 Q $S(WVDIC4]"":WVDIC4,1:"UNKNOWN POINTER")
52 ;
53ECCDYS() ;EP
54 ;---> RETURN TEXT FROM SET OF CODES FOR ECC DYSPLASIA, FIELD .25,
55 ;---> OF PROCEDURE FILE 790.1.
56 ;---> REQUIRED VARIABLE: X=CODE FOR TEXT OF ECC DYSPLASIA.
57 Q:'$D(X) ""
58 Q:X="" ""
59 I '$$VFIELD^DILFD(790.1,.25) Q "^DD MISSING"
60 Q $$EXTERNAL^DILFD(790.1,.25,"",X)
61 ;
62PNOCX(IEN) ;EP
63 ;---> RETURN 1 IF THIS PROCEDURE IS NOT ANY TYPE OF CERVICAL TX.
64 Q:'$G(IEN) 1
65 Q:'$D(^WV(790.2,IEN,0)) 1
66 Q:$$PMAM(IEN) 1
67 Q:IEN=27 1 Q:IEN=29 1 Q:IEN=30 1 Q:IEN=31 1 Q:IEN=32 1
68 Q:IEN=33 1 Q:IEN=34 1 Q:IEN=35 1
69 Q 0
70 ;
71 ;
72PMAM(IEN) ;EP
73 ;---> RETURN 1 IF THIS PROCEDURE IS ANY TYPE OF MAMMOGRAM, RETURN 0
74 ;---> IF NOT.
75 ;---> REQUIRED VARIABLE: IEN=IEN IN PROCEDURE TYPE FILE #790.2.
76 ;---> 25, 26, AND 27 ARE IENS OF MAMS IN ^WV(790.2,.
77 Q:'$G(IEN) 0
78 Q:IEN=25 1 Q:IEN=26 1 Q:IEN=28 1
79 Q 0
80 ;
81 ;
82PRTDATE ;EP
83 ;---> CALL BY WV NOTIF-EDITBLK-1 TO COMPUTE AND STUFF DATE NOTIFICATION
84 ;---> LETTER WILL BE PRINTED, "Print Date" FIELD. CALLED FROM
85 ;---> "TYPE OF NOTIFICATION" FIELD ORDER, "POST ACTION ON CHANGE".
86 ;--->
87 ;---> IF THE "TYPE OF NOTIFICATION" IS PRINTABLE (LETTER), AS STORED
88 ;---> IN #.02 FIELD OF FILE #790.403, THIS COMPUTES PRINT DATE AND
89 ;---> STUFFS A DEFAULT "COMPLETE BY DATE" (FIELD #.13) AS WELL.
90 ;---> "PRINT DATE" WILL BE CX/BR NEED DUE DATE - SITE PARAMETER, AS
91 ;---> STORED IN #.06 FIELD OF FILE #790.02, OR -30 DAYS IF
92 ;---> PARAMETER NOT SET. (SEE PRTDAT^WVUTL2-ABOVE.)
93 ;---> "COMPLETE BY DATE" WILL BE "PRINT DATE"+30. SEE NDELQ1^WVUTL4.
94 ;--->
95 ;---> IF THE "TYPE OF NOTIFICATION" IS NOT PRINTABLE (PHONE), THIS
96 ;---> SETS "PRINT DATE"="" AND RECOMPUTES "COMPLETE BY DATE" BASED ON
97 ;---> DATE NOTIFICATION WAS OPENED (FIELD #.02) +30 DAYS.
98 ;
99 ;---> (NOTE: FOR UNIFORMITY, EXECUTABLE DEFAULT FOR "PRINT DATE"
100 ;---> CALLS THIS CODE TO SET ITS STORED VALUE, THEN SETS ITS DEFAULT
101 ;---> EQUAL TO ITS STORED VALUE.)
102 ;--->
103 ;---> REQUIRED VARIABLES: WVDFN=IEN OF PATIENT
104 ;---> DUZ(2)=SITE
105 ;---> WVTYPE=IEN TYPE OF NOTIFICATION (LETTER, ETC)
106 ;---> WVPURP=IEN PURPOSE OF NOTIFICATION
107 ;
108 N WVTYPE,WVPURP,X,Y
109 S WVTYPE=$$GET^DDSVAL(DIE,DA,.03)
110 I 'WVTYPE D PUT^DDSVAL(DIE,DA,.11,"") Q
111 ;---> IF NOT PRINTABLE, SET PRINT DATE="".
112 I '$P(^WV(790.403,WVTYPE,0),U,2) D Q
113 .D PUT^DDSVAL(DIE,DA,.11,"")
114 .S X=$$NDELQ^WVUTL4 D PUT^DDSVAL(DIE,DA,.13,X)
115 S WVPURP=$$GET^DDSVAL(DIE,DA,.04)
116 ;---> COMPUTE AND STUFF PRINT DATE.
117 D PRTDAT(WVDFN,DUZ(2),WVTYPE,WVPURP,.X)
118 D PUT^DDSVAL(DIE,DA,.11,X)
119 ;---> COMPUTE AND STUFF COMPLETE BY DATE.
120 S X=$$NDELQ1^WVUTL4 D PUT^DDSVAL(DIE,DA,.13,X)
121 Q
122 ;
123 ;
124PRTDAT(DFN,DUZ2,TYPE,PURP,DATE) ;EP
125 ;---> YIELD PATIENT'S LETTER PRINT DATE, BASED ON CX/BR NEED.
126 ;---> DUE DATE MINUS SITE PARAMETER (OR 30 DAYS, IF NOT SET).
127 ;---> TYPE OF NOTIFICATION MUST BE "PRINTABLE" (#.02 OF #790.403).
128 ;---> REQUIRED VARIABLES: DFN=IEN OF PATIENT
129 ;---> DUZ2=DUZ(2)
130 ;---> TYPE=IEN TYPE OF NOTIFICATION
131 ;---> PURP=IEN PURPOSE OF NOTIFICATION
132 ;---> RETURNS VARIABLES: DATE=DEFAULT DATE LETTER SHOULD BE PRINTED
133 ;
134 N P,Q,X,X1,X2
135 S DATE=""
136 Q:'TYPE!('PURP)
137 ;---> QUIT IF THIS "TYPE OF NOTIFICATION" IS NOT "PRINTABLE" (PIECE 2).
138 Q:'$P(^WV(790.403,TYPE,0),U,2)
139 S X2=$P($G(^WV(790.02,DUZ2,0)),U,6)
140 S X2=$S(X2:-X2,1:-30)
141 Q:'$D(^WV(790,DFN,0))
142 ;---> IF THIS PURPOSE IS A RESULT LETTER, SET PRINT DATE=TODAY, QUIT.
143 Q:'$D(^WV(790.404,PURP,0))
144 I $P(^WV(790.404,PURP,0),U,6) S DATE=DT Q
145 ;---> IF THIS IS NOT ASSOCIATED WITH BR/CX NEEDS, QUIT WITH DATE="".
146 Q:$P(^WV(790.404,PURP,0),U,5)=""
147 S:$P(^WV(790.404,PURP,0),U,5)="CX" P=11,Q=12
148 S:$P(^WV(790.404,PURP,0),U,5)="BR" P=18,Q=19
149 ;---> QUIT IF THIS PATIENT HAS NO BR/CX NEED ENTERED.
150 Q:'$P(^WV(790,DFN,0),U,P)
151 ;---> QUIT IF THIS PATIENT HAS NO BR/CX NEED DUE DATE.
152 S X=$P(^WV(790,DFN,0),U,Q) Q:'X
153 S:'$E(X,7) $E(X,7)=1
154 S X1=X D C^%DTC
155 S DATE=X
156 Q
Note: See TracBrowser for help on using the repository browser.