WVPROF2 ;HCIOFO/FT,JR-DISPLAY PATIENT PROFILE; ;5/27/99  16:48
 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
 ;;  Original routine created by IHS/ANMC/MWR
 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  RETRIEVE AND SORT PROCEDURES, NOTIFICATIONS, PAP REGIMENS,
 ;;  AND PREGNANCIES FOR PATIENT PROFILE.  CALLED BY WVPROF.
 ;
SORT ;EP
 ;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
 ;
 K ^TMP("WV",$J)
 ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
 ;---> WVENDDT1=THE LAST SECOND OF END DATE.
 ;S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999    ;---> XDATES
 ;
 D PATVARS^WVUTL3(WVDFN)
 ;
 ;*******************
 ;---> GET PROCEDURES
 S WVIEN=0
 F  S WVIEN=$O(^WV(790.1,"C",WVDFN,WVIEN)) Q:'WVIEN  D
 .;---> SET Y=THE ZERO NODE FOR THIS PROCEDURE.
 .S Y=^WV(790.1,WVIEN,0)
 .;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
 .Q:WVERRORS&($P(Y,U,5)=8)
 .;---> QUIT IF NOT WITHIN DATE RANGE.
 .S (WVDATE,WVDATE1)=$P(Y,U,12)
 .;Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)                ;---> XDATES
 .S WVDATE1=$$SLDT2^WVUTL5(WVDATE1)
 .S WVACC=$P(Y,U)                                      ;---> ACCESSION#
 .S WVPCD=$P(^WV(790.2,$P(Y,U,4),0),U,2)               ;---> PROC TYPE
 .S WVSTAT=$$STATUS^WVUTL4                             ;---> STATUS
 .S WVDIAG=$$DIAG^WVUTL4($P(Y,U,5))                    ;---> RESULT/DIAG
 .S WVPROV=$P(Y,U,7) D                                 ;---> PROVIDER
 ..I 'WVPROV S WVPROV="NOT ENTERED" Q
 ..S WVPROV=$P($$GET1^DIQ(200,WVPROV,.01,"E"),",")
 .;---> FOR PROCEDURES, SET 1ST PIECE AND 6TH SUBSCRIPT=1.
 .S X=1_U_U_U_WVDATE1_U_WVPCD_U_WVACC_U_WVDIAG
 .S X=X_U_WVPROV_U_WVSTAT_U_WVIEN
 .S ^TMP("WV",$J,1,9999999.9999-WVDATE,WVACC,1,WVIEN)=X Q
 ;
 ;**********************
 ;---> GET NOTIFICATIONS
 Q:'WVD
 S WVIEN=0
 F  S WVIEN=$O(^WV(790.4,"B",WVDFN,WVIEN)) Q:'WVIEN  D
 .S Y=^WV(790.4,WVIEN,0)
 .;---> QUIT IF NOT WITHIN DATE RANGE.  WVDATE1 PRESERVES NOTIF DATE.
 .S (WVDATE,WVDATE1)=$P(Y,U,2)
 .;Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)               ;---> XDATE
 .S WVDATE1=$$SLDT2^WVUTL5(WVDATE1)
 .S WVACC=$P(Y,U,6) D                                 ;---> ACCESSION#
 ..I WVACC="" S WVACC="NO ACC#" Q
 ..;---> IF THIS NOTIFICATION PERTAINS TO A PROCEDURE (I.E., IT
 ..;---> HAS AN ACCESSION#), RESET ITS DATE SO THAT IT WILL COLLATE
 ..;---> UNDER ITS PROCEDURE IN THE DISPLAY.
 ..S WVACC=$P(^WV(790.1,WVACC,0),U),WVDATE=$P(^(0),U,12)
 .S WVSTAT=$$STATUS^WVUTL4                            ;---> STATUS
 .S WVTYPE=$P(Y,U,3)  D                               ;---> TYPE
 ..I WVTYPE="" S WVTYPE="NOT ENTERED" Q
 ..S WVTYPE=$P(^WV(790.403,WVTYPE,0),U)
 .S WVPURP=$P(Y,U,4)  D                               ;---> PURPOSE
 ..I WVPURP="" S WVPURP="NOT ENTERED" Q
 ..S WVPURP=$P(^WV(790.404,WVPURP,0),U)
 .S WVOUT=$P(Y,U,5)  D                                ;---> OUTCOME
 ..I WVOUT="" S WVOUT="NOT ENTERED" Q
 ..S WVOUT=$P(^WV(790.405,WVOUT,0),U)
 .;---> FOR NOTIFICATIONS, SET 1ST PIECE AND 6TH SUBSCRIPT=2.
 .;S X=2_U_WVCHRT_U_WVNAME_U_WVDATE1_U_WVACC_U_WVTYPE_U_WVPURP
 .S X=2_U_U_U_WVDATE1_U_WVACC_U_WVTYPE_U_WVPURP
 .S X=X_U_WVOUT_U_WVSTAT_U_WVIEN
 .S ^TMP("WV",$J,1,9999999.9999-WVDATE,WVACC,2,WVIEN)=X Q
 ;
 ;**********************
 ;---> GET PAP REGIMENS
 S WVIEN=0
 F  S WVIEN=$O(^WV(790.04,"C",WVDFN,WVIEN)) Q:'WVIEN  D
 .;---> SET Y=THE ZERO NODE FOR THIS PAP REGIMEN LOG ENTRY.
 .S Y=^WV(790.04,WVIEN,0)
 .;---> PIECE 1=START DATE FOR THE PAP REGIMEN.
 .S (WVDATE,WVDATE1)=$P(Y,U)                           ;---> DATE
 .;---> QUIT IF NOT WITHIN DATE RANGE.
 .;Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)                ;---> XDATES
 .S WVDATE1=$$SLDT2^WVUTL5(WVDATE1)
 .S WVPAPRG1=$$PAPRG1^WVUTL1($P(Y,U,3))                ;---> PAP REGIMEN
 .;---> FOR PAP REGIMENS, SET 1ST PIECE AND 6TH SUBSCRIPT=3.
 .;S X=3_U_WVCHRT_U_WVNAME_U_WVDATE1_U_WVPAPRG1
 .S X=3_U_U_U_WVDATE1_U_WVPAPRG1
 .S ^TMP("WV",$J,1,9999999.9999-WVDATE,1,3,WVIEN)=X Q
 ;
 ;**********************
 ;---> GET PREGNANCIES
 S WVIEN=0
 F  S WVIEN=$O(^WV(790.05,"C",WVDFN,WVIEN)) Q:'WVIEN  D
 .;---> SET Y=THE ZERO NODE FOR THIS PREGNANCY LOG ENTRY.
 .S Y=^WV(790.05,WVIEN,0)
 .;---> PIECE 1=DATE PREGNANCY LOG ENTRY WAS MADE.
 .S (WVDATE,WVDATE1)=$P(Y,U)                           ;---> DATE
 .;---> QUIT IF NOT WITHIN DATE RANGE.
 .;Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)                ;---> XDATES
 .S WVDATE1=$$SLDT2^WVUTL5(WVDATE1)
 .S WVPSTAT=$S($P(Y,U,3):"PREGNANT",1:"NOT PREGNANT")  ;---> PREG STATUS
 .S WVEDCL=$S(X:$$SLDT2^WVUTL5($P(Y,U,4)),1:"")        ;---> EDC
 .;---> FOR PREGNANCIES, SET 1ST PIECE AND 6TH SUBSCRIPT=4.
 .;S X=4_U_WVCHRT_U_WVNAME_U_WVDATE1_U_WVPSTAT_U_WVEDCL
 .S X=4_U_U_U_WVDATE1_U_WVPSTAT_U_WVEDCL
 .S ^TMP("WV",$J,1,9999999.9999-WVDATE,1,4,WVIEN)=X Q
 Q