source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVPROF2.m@ 975

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1WVPROF2 ;HCIOFO/FT,JR-DISPLAY PATIENT PROFILE; ;5/27/99 16:48
2 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; RETRIEVE AND SORT PROCEDURES, NOTIFICATIONS, PAP REGIMENS,
6 ;; AND PREGNANCIES FOR PATIENT PROFILE. CALLED BY WVPROF.
7 ;
8SORT ;EP
9 ;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
10 ;
11 K ^TMP("WV",$J)
12 ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
13 ;---> WVENDDT1=THE LAST SECOND OF END DATE.
14 ;S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999 ;---> XDATES
15 ;
16 D PATVARS^WVUTL3(WVDFN)
17 ;
18 ;*******************
19 ;---> GET PROCEDURES
20 S WVIEN=0
21 F S WVIEN=$O(^WV(790.1,"C",WVDFN,WVIEN)) Q:'WVIEN D
22 .;---> SET Y=THE ZERO NODE FOR THIS PROCEDURE.
23 .S Y=^WV(790.1,WVIEN,0)
24 .;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
25 .Q:WVERRORS&($P(Y,U,5)=8)
26 .;---> QUIT IF NOT WITHIN DATE RANGE.
27 .S (WVDATE,WVDATE1)=$P(Y,U,12)
28 .;Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1) ;---> XDATES
29 .S WVDATE1=$$SLDT2^WVUTL5(WVDATE1)
30 .S WVACC=$P(Y,U) ;---> ACCESSION#
31 .S WVPCD=$P(^WV(790.2,$P(Y,U,4),0),U,2) ;---> PROC TYPE
32 .S WVSTAT=$$STATUS^WVUTL4 ;---> STATUS
33 .S WVDIAG=$$DIAG^WVUTL4($P(Y,U,5)) ;---> RESULT/DIAG
34 .S WVPROV=$P(Y,U,7) D ;---> PROVIDER
35 ..I 'WVPROV S WVPROV="NOT ENTERED" Q
36 ..S WVPROV=$P($$GET1^DIQ(200,WVPROV,.01,"E"),",")
37 .;---> FOR PROCEDURES, SET 1ST PIECE AND 6TH SUBSCRIPT=1.
38 .S X=1_U_U_U_WVDATE1_U_WVPCD_U_WVACC_U_WVDIAG
39 .S X=X_U_WVPROV_U_WVSTAT_U_WVIEN
40 .S ^TMP("WV",$J,1,9999999.9999-WVDATE,WVACC,1,WVIEN)=X Q
41 ;
42 ;**********************
43 ;---> GET NOTIFICATIONS
44 Q:'WVD
45 S WVIEN=0
46 F S WVIEN=$O(^WV(790.4,"B",WVDFN,WVIEN)) Q:'WVIEN D
47 .S Y=^WV(790.4,WVIEN,0)
48 .;---> QUIT IF NOT WITHIN DATE RANGE. WVDATE1 PRESERVES NOTIF DATE.
49 .S (WVDATE,WVDATE1)=$P(Y,U,2)
50 .;Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1) ;---> XDATE
51 .S WVDATE1=$$SLDT2^WVUTL5(WVDATE1)
52 .S WVACC=$P(Y,U,6) D ;---> ACCESSION#
53 ..I WVACC="" S WVACC="NO ACC#" Q
54 ..;---> IF THIS NOTIFICATION PERTAINS TO A PROCEDURE (I.E., IT
55 ..;---> HAS AN ACCESSION#), RESET ITS DATE SO THAT IT WILL COLLATE
56 ..;---> UNDER ITS PROCEDURE IN THE DISPLAY.
57 ..S WVACC=$P(^WV(790.1,WVACC,0),U),WVDATE=$P(^(0),U,12)
58 .S WVSTAT=$$STATUS^WVUTL4 ;---> STATUS
59 .S WVTYPE=$P(Y,U,3) D ;---> TYPE
60 ..I WVTYPE="" S WVTYPE="NOT ENTERED" Q
61 ..S WVTYPE=$P(^WV(790.403,WVTYPE,0),U)
62 .S WVPURP=$P(Y,U,4) D ;---> PURPOSE
63 ..I WVPURP="" S WVPURP="NOT ENTERED" Q
64 ..S WVPURP=$P(^WV(790.404,WVPURP,0),U)
65 .S WVOUT=$P(Y,U,5) D ;---> OUTCOME
66 ..I WVOUT="" S WVOUT="NOT ENTERED" Q
67 ..S WVOUT=$P(^WV(790.405,WVOUT,0),U)
68 .;---> FOR NOTIFICATIONS, SET 1ST PIECE AND 6TH SUBSCRIPT=2.
69 .;S X=2_U_WVCHRT_U_WVNAME_U_WVDATE1_U_WVACC_U_WVTYPE_U_WVPURP
70 .S X=2_U_U_U_WVDATE1_U_WVACC_U_WVTYPE_U_WVPURP
71 .S X=X_U_WVOUT_U_WVSTAT_U_WVIEN
72 .S ^TMP("WV",$J,1,9999999.9999-WVDATE,WVACC,2,WVIEN)=X Q
73 ;
74 ;**********************
75 ;---> GET PAP REGIMENS
76 S WVIEN=0
77 F S WVIEN=$O(^WV(790.04,"C",WVDFN,WVIEN)) Q:'WVIEN D
78 .;---> SET Y=THE ZERO NODE FOR THIS PAP REGIMEN LOG ENTRY.
79 .S Y=^WV(790.04,WVIEN,0)
80 .;---> PIECE 1=START DATE FOR THE PAP REGIMEN.
81 .S (WVDATE,WVDATE1)=$P(Y,U) ;---> DATE
82 .;---> QUIT IF NOT WITHIN DATE RANGE.
83 .;Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1) ;---> XDATES
84 .S WVDATE1=$$SLDT2^WVUTL5(WVDATE1)
85 .S WVPAPRG1=$$PAPRG1^WVUTL1($P(Y,U,3)) ;---> PAP REGIMEN
86 .;---> FOR PAP REGIMENS, SET 1ST PIECE AND 6TH SUBSCRIPT=3.
87 .;S X=3_U_WVCHRT_U_WVNAME_U_WVDATE1_U_WVPAPRG1
88 .S X=3_U_U_U_WVDATE1_U_WVPAPRG1
89 .S ^TMP("WV",$J,1,9999999.9999-WVDATE,1,3,WVIEN)=X Q
90 ;
91 ;**********************
92 ;---> GET PREGNANCIES
93 S WVIEN=0
94 F S WVIEN=$O(^WV(790.05,"C",WVDFN,WVIEN)) Q:'WVIEN D
95 .;---> SET Y=THE ZERO NODE FOR THIS PREGNANCY LOG ENTRY.
96 .S Y=^WV(790.05,WVIEN,0)
97 .;---> PIECE 1=DATE PREGNANCY LOG ENTRY WAS MADE.
98 .S (WVDATE,WVDATE1)=$P(Y,U) ;---> DATE
99 .;---> QUIT IF NOT WITHIN DATE RANGE.
100 .;Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1) ;---> XDATES
101 .S WVDATE1=$$SLDT2^WVUTL5(WVDATE1)
102 .S WVPSTAT=$S($P(Y,U,3):"PREGNANT",1:"NOT PREGNANT") ;---> PREG STATUS
103 .S WVEDCL=$S(X:$$SLDT2^WVUTL5($P(Y,U,4)),1:"") ;---> EDC
104 .;---> FOR PREGNANCIES, SET 1ST PIECE AND 6TH SUBSCRIPT=4.
105 .;S X=4_U_WVCHRT_U_WVNAME_U_WVDATE1_U_WVPSTAT_U_WVEDCL
106 .S X=4_U_U_U_WVDATE1_U_WVPSTAT_U_WVEDCL
107 .S ^TMP("WV",$J,1,9999999.9999-WVDATE,1,4,WVIEN)=X Q
108 Q
Note: See TracBrowser for help on using the repository browser.