source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVUTL5.m@ 1042

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1WVUTL5 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: ACC#, TITLES, SL/TX DATES; ;1/29/99 15:15
2 ;;1.0;WOMEN'S HEALTH;**5**;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; UTILITY: SETVARS, GENERATE ACCESSION#, MENUT, TITLE, CENTERT,
5 ;; COPYLET, UPPERCASE XREF, SL/TX DATES.
6 ;
7 ;
8SETVARS ;EP
9 S:'$D(WVPOP) WVPOP=0
10 Q
11 ;**************
12 ;
13 ;
14ACCSSN(PCDTYPE) ;EP
15 ;---> GENERATE ACCESSION# FOR WV PROCEDURE FILE ENTRY.
16 ;---> REQUIRED VARIABLE: PCDTYPE=IEN OF PROCEDURE TYPE (#790.2)
17 N A,C,L,N,P,R,X
18 Q:'$D(PCDTYPE) ""
19 Q:'$D(^WV(790.2,PCDTYPE,0)) ""
20 S X=^WV(790.2,PCDTYPE,0) ;X=0-NODE OF PROC TYPE
21 S P=$P(X,U,4) ;P=PREFIX
22 S L=$P(X,U,6) ;L=LAST ASSIGNED ACCESSION# FOR THIS PROC
23 S A=$P(L,"-") ;A=ACC YEAR
24 S C=$P(L,"-",2) ;C=COUNTER
25 D NOW^%DTC
26 S N=($E(%I(3),1,3)+1700) ;N=YEAR NOW: 94
27 I A'=N S C=0
28 F L +^WV(790.2,PCDTYPE,0):1 Q:$T
29 F S C=C+1 S R=P_N_"-"_C Q:'$D(^WV(790.1,"B",R))
30 S $P(^WV(790.2,PCDTYPE,0),U,6)=N_"-"_C
31 L -^WV(790.2,PCDTYPE,0)
32 Q R ;R=RESULT(NEW ACCESSION#)
33 ;
34MENUT(TITLE) ;EP
35 ;---> DISPLAY MENU TITLE FROM WV MENU OPTIONS.
36 ;---> REQUIRED VARIABLES: TITLE=TEXT TO BE CENTERED AND DISPLAYED.
37 ;---> DUZ(2)=CURRENT LOCATION TO BE DISPLAYED.
38 N WVTTAB,WVFAC
39 S:'$D(TITLE) TITLE="* NO TITLE SUPPLIED *"
40 S TITLE="* "_TITLE_" *"
41 S WVTTAB=39-($L(TITLE)/2)
42 W @IOF
43 W !?3,"WOMEN'S HEALTH:"
44 W ?WVTTAB,TITLE
45 W ?60,$E($$INSTTX^WVUTL6(DUZ(2)),1,20)
46 Q
47 ;
48TITLE(TITLE) ;EP
49 ;---> DISPLAY A TITLE.
50 ;---> REQUIRED VARIABLES: TITLE=TEXT TO BE CENTERED AND DISPLAYED.
51 N WVTTAB
52 S:'$D(TITLE) TITLE="* NO TITLE SUPPLIED *"
53 S TITLE="* * * WOMEN'S HEALTH: "_TITLE_" * * *"
54 S WVTTAB=39-($L(TITLE)/2)
55 W @IOF
56 W !?WVTTAB,TITLE,!!
57 Q
58 ;
59CENTERT(TEXT) ;EP
60 ;---> ADD LEADING SPACES TO CENTER TEXT.
61 S:'$D(TEXT) TEXT="* NO TEXT SUPPLIED *"
62 N I
63 F I=1:1:(39-($L(TEXT)/2)) S TEXT=" "_TEXT
64 Q
65 ;
66UPPER() ;EP
67 S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
68 Q X
69 ;
70COPYLET ;EP
71 ;---> COPY TEXT OF GENERIC SAMPLE LETTER TO ONE OR MORE WV PURPOSES.
72 ;---> EDIT NEXT LINE TO INCLUDE IENS OF WV PURPOSES TO BE CHANGED.
73 ;F DA=15,16,18,19 D
74 S DA=0
75 F S DA=$O(^WV(790.404,DA)) Q:'DA D
76 .K ^WV(790.404,DA,1)
77 .S N=0
78 .F S N=$O(^WV(790.6,1,1,N)) Q:'N D
79 ..S ^WV(790.404,DA,1,N,0)=^WV(790.6,1,1,N,0)
80 .S ^WV(790.404,DA,1,0)=^WV(790.6,1,1,0)
81 Q
82 ;
83 ;
84UPXREF(X,WVGBL) ;EP
85 ;---> SET UPPERCASE XREF FOR X. CALLED FROM MUMPS XREFS ON MIXED CASE
86 ;---> FIELDS WHERE AN ALL UPPERCASE LOOKUP IS NEEDED.
87 ;---> REQUIRED VARIABLES: WVGBL=GLOBAL ROOT OF FILE, X=TEXT TO BE
88 ;---> CROSSREFERENCED IN ALL UPPERCASE, DA=IEN.
89 Q:'$D(WVGBL)!('$D(X))
90 N WVX S WVX=X,X=$$UPPER
91 S @(WVGBL_"""U"",$E(X,1,30),DA)")=""
92 S X=WVX K WVGBL
93 Q
94 ;
95KUPXREF(X,WVGBL) ;EP
96 ;---> KILL UPPERCASE XREF FOR X. CALLED FROM MUMPS XREFS ON MIXED CASE
97 ;---> FIELDS WHERE AN ALL UPPERCASE LOOKUP IS NEEDED.
98 ;---> REQUIRED VARIABLES: WVGBL=GLOBAL ROOT OF FILE, X=TEXT TO BE
99 ;---> CROSSREFERENCED IN ALL UPPERCASE, DA=IEN.
100 Q:'$D(WVGBL)!('$D(X))
101 N WVX S WVX=X,X=$$UPPER
102 K @(WVGBL_"""U"",$E(X,1,30),DA)")
103 S X=WVX K WVGBL
104 Q
105 ;
106AGENCY(SITE) ;EP
107 ;---> RETURN TYPE OF AGENCY ("i"=IHS, "s"=STATE, "v"=VA, ETC.).
108 ;---> REQUIRED VARIABLE: SITE=DUZ(2)
109 ;---> IF SITE NOT PASSED OR PARAMETER NOT SET, IT DEFAULTS TO VA.
110 Q:'$G(SITE) "v"
111 Q:'$D(^WV(790.02,SITE,0)) "v"
112 Q $P(^WV(790.02,SITE,0),U,15)
113 ;
114PNLAB() ;EP
115 ;---> RETURN TEXT FOR PATIENT NUMBER: " SSN: ".
116 Q " SSN: "
117 ;
118PNLB() ;EP
119 ;---> RETURN UPPERCASE TEXT FOR PATIENT NUMBER, NO COLON/SPACES.
120 Q "SSN"
121 ;
122SLDT2(DATE) ;EP
123 ;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT: MM/DD/YY.
124 ;---> DATE=DATE IN FILEMAN FORMAT.
125 Q:'$G(DATE) "NO DATE"
126 S DATE=$P(DATE,".")
127 Q:$L(DATE)'=7 DATE
128 Q:'$E(DATE,4,5) $E(DATE,1,3)+1700
129 Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3)
130 Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
131 ;
132 ;
133SLDT1(DATE) ;EP
134 ;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT: MM/DD/YY
135 ;---> PLUS TIME.
136 N Y
137 Q:'$D(DATE) "unknown"
138 S Y=DATE,DATE=$P(DATE,".")
139 Q:'DATE "NO DATE"
140 Q:$L(DATE)'=7 DATE
141 Q:'$E(DATE,4,5) $E(DATE,1,3)+1700
142 Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3)
143 D DD^%DT S:Y["@" Y=" @ "_$P($P(Y,"@",2),":",1,2)
144 Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)_Y
145 ;
146TXDT(DATE) ;EP
147 ;---> CONVERT FILEMAN INTERNAL DATE TO "TEXT" FORMAT: MMM DD,YYYY.
148 N Y
149 Q:'$D(DATE) "UNKNOWN"
150 S Y=DATE D DD^%DT
151 I Y[", " S Y=$P(Y,", ")_","_$P(Y,", ",2)
152 I Y["@" S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
153 Q Y
Note: See TracBrowser for help on using the repository browser.