source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGSRVICE.m@ 1394

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1DGSRVICE ;SLC/PKR - Routines for setting service indexes. ;01/13/2006
2 ;;5.3;Registration;**690**;Aug 13, 1993
3 ;===============================================================
4CSERVDI(DFN,EDATE,SEPDATE,TYPE) ;
5 I EDATE="",SEPDATE="" Q
6 I EDATE="" S EDATE="U"_DFN
7 I SEPDATE="" S SEPDATE="U"_DFN
8 I '$D(^DPT("ASERVICE",SEPDATE,EDATE,DFN,TYPE)) S ^TMP($J,"ASERVICE",DFN,TYPE)=EDATE_U_SEPDATE
9 Q
10 ;
11 ;===============================================================
12CSERVDG(DFN,EDATE,SEPDATE,TYPE) ;
13 N NOMATCH,TEMP
14 S TEMP=$G(^DPT(DFN,.32))
15 S NOMATCH=0
16 I EDATE["U" S EDATE=""
17 I SEPDATE["U" S SEPDATE=""
18 I TYPE="LAST" S NOMATCH=$S(EDATE'=$P(TEMP,U,6):1,SEPDATE'=$P(TEMP,U,7):1,1:0)
19 I TYPE="NTL" S NOMATCH=$S(EDATE'=$P(TEMP,U,11):1,SEPDATE'=$P(TEMP,U,12):1,1:0)
20 I TYPE="NNTL" S NOMATCH=$S(EDATE'=$P(TEMP,U,16):1,SEPDATE'=$P(TEMP,U,17):1,1:0)
21 I NOMATCH S ^TMP($J,"ASERVICE",DFN,TYPE)=EDATE_U_SEPDATE
22 Q
23 ;
24 ;===============================================================
25KSERV(X,DA,TYPE) ;Delete index for service data.
26 I X(1)="",X(2)="" Q
27 N ENTRY,SEP
28 S ENTRY=$S(X(1)'="":X(1),1:"U"_DA)
29 S SEP=$S(X(2)'="":X(2),1:"U"_DA)
30 K ^DPT("ASERVICE",SEP,ENTRY,DA,TYPE)
31 Q
32 ;
33 ;===============================================================
34PPTYPEM ;Print the patient type index mismatches
35 N DFN,PTYPE
36 S DFN=0
37 F S DFN=$O(^TMP($J,"PTYPE",DFN)) Q:DFN="" D
38 . S PTYPE=^TMP($J,"PTYPE",DFN)
39 . W !,"DFN=",DFN," PATIENT TYPE=",PTYPE
40 Q
41 ;
42 ;===============================================================
43PSERVM ;Print the service date index mismatches
44 N DFN,TEMP,TYPE
45 S DFN=0
46 F S DFN=$O(^TMP($J,"ASERVICE",DFN)) Q:DFN="" D
47 . S TYPE=""
48 . F S TYPE=$O(^TMP($J,"ASERVICE",DFN,TYPE)) Q:TYPE="" D
49 .. S TEMP=^TMP($J,"ASERVICE",DFN,TYPE)
50 .. W !,"DFN=",DFN," TYPE=",TYPE," Entry date=",$P(TEMP,U,1)," Separation date=",$P(TEMP,U,2)
51 Q
52 ;
53 ;===============================================================
54SSERV(X,DA,TYPE) ;Set index for service data.
55 ;X(1)=SERVICE ENTRY DATE
56 ;X(2)=SERVICE SEPARATION DATE
57 I X(1)="",X(2)="" Q
58 N ENTRY,SEP
59 S ENTRY=$S(X(1)'="":X(1),1:"U"_DA)
60 S SEP=$S(X(2)'="":X(2),1:"U"_DA)
61 S ^DPT("ASERVICE",SEP,ENTRY,DA,TYPE)=""
62 Q
63 ;
64 ;===============================================================
65VERIFY ;Check to make sure the indexes and global are in agreement.
66 N DFN,EDATE,NOPROB,PTYPE,SEPDATE,TEMP,TYPE
67 W !,$$FMTE^XLFDT($$NOW^XLFDT,"5Z")," Starting index verification.",!
68 S NOPROB=1
69 K ^TMP($J,"ASERVICE"),^TMP($J,"PTYPE")
70 ;Go through the global.
71 S DFN=0
72 F S DFN=+$O(^DPT(DFN)) Q:DFN=0 D
73 . S PTYPE=$G(^DPT(DFN,"TYPE"))
74 . I PTYPE'="",'$D(^DPT("APTYPE",PTYPE,DFN)) S ^TMP($J,"PTYPE",DFN)=PTYPE
75 . S TEMP=$G(^DPT(DFN,.32))
76 . I TEMP="" Q
77 . S EDATE=$P(TEMP,U,6),SEPDATE=$P(TEMP,U,7) D CSERVDI(DFN,EDATE,SEPDATE,"LAST")
78 . S EDATE=$P(TEMP,U,11),SEPDATE=$P(TEMP,U,12) D CSERVDI(DFN,EDATE,SEPDATE,"NTL")
79 . S EDATE=$P(TEMP,U,16),SEPDATE=$P(TEMP,U,17) D CSERVDI(DFN,EDATE,SEPDATE,"NNTL")
80 I $D(^TMP($J,"ASERVICE")) D
81 . S NOPROB=0
82 . W !,"The following global entries do not have a matching service date index entry:"
83 . D PSERVM
84 ;Go through the index.
85 K ^TMP($J,"ASERVICE")
86 S SEPDATE=0
87 F S SEPDATE=$O(^DPT("ASERVICE",SEPDATE)) Q:SEPDATE="" D
88 . S EDATE=0
89 . F S EDATE=$O(^DPT("ASERVICE",SEPDATE,EDATE)) Q:EDATE="" D
90 .. S DFN=0
91 .. F S DFN=$O(^DPT("ASERVICE",SEPDATE,EDATE,DFN)) Q:DFN="" D
92 ... S TYPE=""
93 ... F S TYPE=$O(^DPT("ASERVICE",SEPDATE,EDATE,DFN,TYPE)) Q:TYPE="" D
94 .... D CSERVDG(DFN,EDATE,SEPDATE,TYPE)
95 I $D(^TMP($J,"ASERVICE")) D
96 . S NOPROB=0
97 . W !!,"The following service date index entries do not have a corresponding global entry:"
98 . D PSERVM
99 K ^TMP($J,"ASERVICE")
100 I NOPROB W !,"No problems were found with the service dates index."
101 ;
102 ;Check the patient type index.
103 S NOPROB=1
104 I $D(^TMP($J,"PTYPE")) D
105 . S NOPROB=0
106 . W !!,"The following global entries do not have a matching patient type index entry:"
107 . D PPTYPEM
108 K ^TMP($J,"PTYPE")
109 ;Go through the patient type index.
110 S TYPE=""
111 F S TYPE=$O(^DPT("APTYPE",TYPE)) Q:TYPE="" D
112 . S DFN=0
113 . F S DFN=$O(^DPT("APTYPE",TYPE,DFN)) Q:DFN="" D
114 .. I TYPE'=$G(^DPT(DFN,"TYPE")) S ^TMP($J,"PTYPE",DFN)=TYPE
115 I $D(^TMP($J,"PTYPE")) D
116 . S NOPROB=0
117 . W !!,"The following patient type index entries do not have a corresponding"
118 . W !,"global entry:"
119 . D PPTYPEM
120 K ^TMP($J,"PTYPE")
121 I NOPROB W !,"No problems were found with the patient type index."
122 W !!,$$FMTE^XLFDT($$NOW^XLFDT,"5Z")," Index verification complete."
123 Q
124 ;
Note: See TracBrowser for help on using the repository browser.