source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVUTL4.m@ 1008

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

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1WVUTL4 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: DATE DEFAULTS, OTH VALUES; ;7/16/98 09:44
2 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; UTILITY: DEFAULT "COMPLETE BY" DATES FOR NOTIFS AND PROCEDURES,
5 ;; STATUS TEXT, DIAG TEXT, NORMAL VALUE, COLP VALUE, MARGIN? VALUE.
6 ;
7 ;
8NDELQ() ;EP
9 ;---> FOR NOTIFICATIONS:
10 ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
11 ;---> NOTIFICATION BECOMES DELINQUENT. CALLED BY WV NOTIF-EDITBLK-1.
12 ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
13 ;---> CODE HERE SETS X=EITHER 1: PRINT DATE (IF PRINTABLE), OR
14 ;---> 2: DATE NOTIFICATION OPENED, OR
15 ;---> 3: TODAY'S DATE
16 ;---> THEN $$NDELQ1() IS CALLED TO ADD 30 DAYS UNTIL DELINQUENT.
17 ;---> REQUIRED VARIABLE: DA (IEN OF NOTIFICATION).
18 N X
19 Q:'$D(DA) ""
20 Q:'DA ""
21 Q:'$D(^WV(790.4,DA,0)) ""
22 S X=$P(^WV(790.4,DA,0),U,11)
23 S:'X X=$P(^WV(790.4,DA,0),U,2)
24 S:'X X=DT
25 Q $$NDELQ1
26 ;
27NDELQ1() ;EP
28 ;---> FOR NOTIFICATIONS:
29 ;---> COMPUTE "COMPLETE BY (DATE)". CALLED BY UPDATE/EDIT OF
30 ;---> "PRINT DATE:" IN WV NOTIF-EDITBLK-1.
31 ;---> X1=EITHER NEW PRINT DATE, OR DATE NOTIF OPENED, OR TODAY.
32 ;---> X2=30 DAYS ADDED TILL NOTIFICATION BECOMES DELINQUENT.
33 ;---> REQUIRED VARIABLE: X=PRINT DATE, OR DATE OPENED, OR TODAY.
34 N %H,X1,X2
35 Q:'$D(X) ""
36 Q:'X ""
37 S X1=X,X2=30
38 D C^%DTC
39 Q X
40 ;
41PDELQ(DA,DUZ2) ;EP
42 ;---> FOR PROCEDURES:
43 ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
44 ;---> PROCEDURE BECOMES DELINQUENT. CALLED BY WV PROC-EDITBLK-1.
45 ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
46 ;---> CODE HERE FIRST RETRIEVES STORED DATE OF PROCEDURE, THEN CALLS
47 ;---> $$DELQ1 TO COMPUTE "COMPLETE BY (DATE)".
48 ;---> REQUIRED VARIABLE: DA (IEN OF PROCEDURE), DUZ2=DUZ(2).
49 Q:'$G(DA)!('$G(DUZ2)) ""
50 Q:'$D(^WV(790.1,DA,0)) ""
51 Q:'$P(^WV(790.1,DA,0),U,12) ""
52 Q $$PDELQ1(DA,$P(^WV(790.1,DA,0),U,12),DUZ2)
53 ;
54PDELQ1(WVDA,WVDT,WVDUZ2) ;EP
55 ;---> FOR PROCEDURES:
56 ;---> COMPUTE "COMPLETE BY (WVDT)". CALLED BY UPWVDT/EDIT OF
57 ;---> "WVDT OF PROCEDURE" IN WV PROC-EDITBLK-1.
58 ;---> X1=WVDT OF PROCEDURE, X2=DEFAULT NUMBER OF WVDAYS THE
59 ;---> PROCEDURE IS ALLOWED TO REMAIN OPEN BEFORE BECOMING DELINQUENT.
60 ;---> REQUIRED VARIABLE: WVDA=IEN OF PROCEDURE, WVDT=DATE OF PROCEDURE,
61 ;---> WVDUZ2=DUZ(2).
62 N %H,X,X1,X2
63 Q:'$G(WVDA)!('$G(WVDT)) ""
64 Q:'$D(^WV(790.1,WVDA,0)) ""
65 S X2=$P(^WV(790.1,WVDA,0),U,4),X1=WVDT
66 Q:'X2 ""
67 Q:'$D(^WV(790.02,WVDUZ2,X2)) ""
68 S X2=$P(^WV(790.02,WVDUZ2,X2),U,3)
69 D C^%DTC
70 Q X
71 ;
72STATUS() ;EP
73 ;---> PROVIDES STATUS (OPEN, DELINQUENT, OR CLOSED).
74 ;---> Y MUST EQUAL ZERO NODE OF NOTIFICATION.
75 ;---> REQUIRED VARIABLE: Y=ZERO NODE OF PROCEDURE, DT=FFDATE
76 Q:'$D(Y) "UNKNOWN"
77 Q:$P(Y,U,14)="c" "CLOSED"
78 Q:$P(Y,U,13)]""&($P(Y,U,13)<DT) "DELINQ"
79 Q "OPEN"
80 ;
81DIAG(IEN) ;EP
82 ;---> RETURN TEXT OF RESULT/DIAGNOSIS.
83 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE 790.31.
84 Q:'$G(IEN) "NOT ENTERED"
85 Q:'$D(^WV(790.31,IEN,0)) "UNKNOWN POINTER"
86 Q $P(^WV(790.31,IEN,0),U)
87 ;
88PRIOR() ;EP
89 ;---> PROVIDE PRIORITY FOR THIS RESULT/DIAGNOSIS (DEFAULT=10).
90 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
91 Q:'$D(X)!(X']"") 10
92 Q:'$D(^WV(790.31,X,0)) 10
93 Q:'$P(^WV(790.31,X,0),U,2) 10
94 Q $P(^WV(790.31,X,0),U,2)
95 ;
96NORMAL(X) ;EP
97 ;---> PROVIDE NORMAL/ABNORMAL FOR THIS RESULT/DIAGNOSIS.
98 ;---> WILL RETURN 0 IF NORMAL, 1 IF ABNORMAL (DEFAULT=1),
99 ;---> 2 IF NO RESULT (EITHER THE PROCEDURE HAS NO RESULT OR
100 ;---> THE RESULT/DIAGNOSIS HAS "NO RESULT" FOR FIELD #.21).
101 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
102 Q:'$D(X)!(X']"") 2
103 Q:'$D(^WV(790.31,X,0)) 2
104 Q:$P(^WV(790.31,X,0),U,21)="" 2
105 Q $P(^WV(790.31,X,0),U,21)
106 ;
107COLP(DA) ;EP
108 ;---> DETERMINE WHETHER OR NOT THE CURRENT PROCEDURE REQUIRES
109 ;---> PAGE 2 OF PROCEDURE EDIT SCREENS FOR COLPOSCOPY RESULTS.
110 ;---> RETURNS 1 IF COLP-TYPE RESULTS, OTHERWISE 0.
111 ;---> DA=IEN OF PROCEDURE IN PROC FILE #790.1.
112 N Y
113 Q:'$G(DA) 0
114 Q:'$D(^WV(790.1,DA,0)) 0
115 S Y=$P(^WV(790.1,DA,0),U,4)
116 Q:'Y 0
117 Q:'$D(^WV(790.2,Y,0)) 0
118 Q:$P(^WV(790.2,Y,0),U,3)<1 0
119 Q 1
120 ;
121COLPA(DA) ;EP
122 ;---> LOOK FOR ASSOCIATED COLPOSCOPY, RETURN ITS ACC# AND DATE.
123 N X,Y
124 Q:'$G(DA) ""
125 S Y=$$COLP0(DA)
126 Q:Y="" "None"
127 S X=$P(Y,U)_" on "_$$SLDT2^WVUTL5($P(Y,U,12))
128 I $P(Y,U,5) Q X_"^"_$P(^WV(790.31,$P(Y,U,5),0),U)
129 Q X_"^"_"Not entered"
130 ;
131COLP0(DA) ;EP
132 ;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
133 N Y
134 Q:'$G(DA) ""
135 Q:'$D(^WV(790.1,DA,0)) ""
136 Q:'$D(^WV(790.1,"ACOLP",DA)) ""
137 S Y=$O(^WV(790.1,"ACOLP",DA,0)),Y=$O(^WV(790.1,"ACOLP",DA,Y,0))
138 Q:'$D(^WV(790.1,Y,0)) ""
139 Q ^WV(790.1,Y,0)
140 ;
141MARGIN(DA) ;EP
142 ;---> DETERMINE WHETHER THE "MARGINS CLEAR?" QUESTION (PAGE 2 OF
143 ;---> PROCEDURE EDIT) SHOULD BE ASKED FOR THIS PROCEDURE.
144 N Y
145 Q:'$G(DA) 0
146 Q:'$D(^WV(790.1,DA,0)) 0
147 S Y=$P(^WV(790.1,DA,0),U,4)
148 Q:'Y 0
149 Q:'$D(^WV(790.2,Y,0)) 0
150 Q:$P(^WV(790.2,Y,0),U,11)<1 0
151 Q 1
152 ;
153STAGE(STAGE) ;EP
154 ;---> RETURN THE TEXT OF THE STAGE OF CARCINOMA.
155 Q:'$G(STAGE) ""
156 Q:'$D(^DD(790.1,.31,0)) "^DD MISSING"
157 Q $P($P(^DD(790.1,.31,0),STAGE_":",2),";")
Note: See TracBrowser for help on using the repository browser.