Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGSRVICE

DGSRVICE.m

Go to the documentation of this file.
  1. DGSRVICE ;SLC/PKR - Routines for setting service indexes. ;01/13/2006
  1. ;;5.3;Registration;**690,1015**;Aug 13, 1993;Build 21
  1. ;===============================================================
  1. CSERVDI(DFN,EDATE,SEPDATE,TYPE) ;
  1. I EDATE="",SEPDATE="" Q
  1. I EDATE="" S EDATE="U"_DFN
  1. I SEPDATE="" S SEPDATE="U"_DFN
  1. I '$D(^DPT("ASERVICE",SEPDATE,EDATE,DFN,TYPE)) S ^TMP($J,"ASERVICE",DFN,TYPE)=EDATE_U_SEPDATE
  1. Q
  1. ;
  1. ;===============================================================
  1. CSERVDG(DFN,EDATE,SEPDATE,TYPE) ;
  1. N NOMATCH,TEMP
  1. S TEMP=$G(^DPT(DFN,.32))
  1. S NOMATCH=0
  1. I EDATE["U" S EDATE=""
  1. I SEPDATE["U" S SEPDATE=""
  1. I TYPE="LAST" S NOMATCH=$S(EDATE'=$P(TEMP,U,6):1,SEPDATE'=$P(TEMP,U,7):1,1:0)
  1. I TYPE="NTL" S NOMATCH=$S(EDATE'=$P(TEMP,U,11):1,SEPDATE'=$P(TEMP,U,12):1,1:0)
  1. I TYPE="NNTL" S NOMATCH=$S(EDATE'=$P(TEMP,U,16):1,SEPDATE'=$P(TEMP,U,17):1,1:0)
  1. I NOMATCH S ^TMP($J,"ASERVICE",DFN,TYPE)=EDATE_U_SEPDATE
  1. Q
  1. ;
  1. ;===============================================================
  1. KSERV(X,DA,TYPE) ;Delete index for service data.
  1. I X(1)="",X(2)="" Q
  1. N ENTRY,SEP
  1. S ENTRY=$S(X(1)'="":X(1),1:"U"_DA)
  1. S SEP=$S(X(2)'="":X(2),1:"U"_DA)
  1. K ^DPT("ASERVICE",SEP,ENTRY,DA,TYPE)
  1. Q
  1. ;
  1. ;===============================================================
  1. PPTYPEM ;Print the patient type index mismatches
  1. N DFN,PTYPE
  1. S DFN=0
  1. F S DFN=$O(^TMP($J,"PTYPE",DFN)) Q:DFN="" D
  1. . S PTYPE=^TMP($J,"PTYPE",DFN)
  1. . W !,"DFN=",DFN," PATIENT TYPE=",PTYPE
  1. Q
  1. ;
  1. ;===============================================================
  1. PSERVM ;Print the service date index mismatches
  1. N DFN,TEMP,TYPE
  1. S DFN=0
  1. F S DFN=$O(^TMP($J,"ASERVICE",DFN)) Q:DFN="" D
  1. . S TYPE=""
  1. . F S TYPE=$O(^TMP($J,"ASERVICE",DFN,TYPE)) Q:TYPE="" D
  1. .. S TEMP=^TMP($J,"ASERVICE",DFN,TYPE)
  1. .. W !,"DFN=",DFN," TYPE=",TYPE," Entry date=",$P(TEMP,U,1)," Separation date=",$P(TEMP,U,2)
  1. Q
  1. ;
  1. ;===============================================================
  1. SSERV(X,DA,TYPE) ;Set index for service data.
  1. ;X(1)=SERVICE ENTRY DATE
  1. ;X(2)=SERVICE SEPARATION DATE
  1. I X(1)="",X(2)="" Q
  1. N ENTRY,SEP
  1. S ENTRY=$S(X(1)'="":X(1),1:"U"_DA)
  1. S SEP=$S(X(2)'="":X(2),1:"U"_DA)
  1. S ^DPT("ASERVICE",SEP,ENTRY,DA,TYPE)=""
  1. Q
  1. ;
  1. ;===============================================================
  1. VERIFY ;Check to make sure the indexes and global are in agreement.
  1. N DFN,EDATE,NOPROB,PTYPE,SEPDATE,TEMP,TYPE
  1. W !,$$FMTE^XLFDT($$NOW^XLFDT,"5Z")," Starting index verification.",!
  1. S NOPROB=1
  1. K ^TMP($J,"ASERVICE"),^TMP($J,"PTYPE")
  1. ;Go through the global.
  1. S DFN=0
  1. F S DFN=+$O(^DPT(DFN)) Q:DFN=0 D
  1. . S PTYPE=$G(^DPT(DFN,"TYPE"))
  1. . I PTYPE'="",'$D(^DPT("APTYPE",PTYPE,DFN)) S ^TMP($J,"PTYPE",DFN)=PTYPE
  1. . S TEMP=$G(^DPT(DFN,.32))
  1. . I TEMP="" Q
  1. . S EDATE=$P(TEMP,U,6),SEPDATE=$P(TEMP,U,7) D CSERVDI(DFN,EDATE,SEPDATE,"LAST")
  1. . S EDATE=$P(TEMP,U,11),SEPDATE=$P(TEMP,U,12) D CSERVDI(DFN,EDATE,SEPDATE,"NTL")
  1. . S EDATE=$P(TEMP,U,16),SEPDATE=$P(TEMP,U,17) D CSERVDI(DFN,EDATE,SEPDATE,"NNTL")
  1. I $D(^TMP($J,"ASERVICE")) D
  1. . S NOPROB=0
  1. . W !,"The following global entries do not have a matching service date index entry:"
  1. . D PSERVM
  1. ;Go through the index.
  1. K ^TMP($J,"ASERVICE")
  1. S SEPDATE=0
  1. F S SEPDATE=$O(^DPT("ASERVICE",SEPDATE)) Q:SEPDATE="" D
  1. . S EDATE=0
  1. . F S EDATE=$O(^DPT("ASERVICE",SEPDATE,EDATE)) Q:EDATE="" D
  1. .. S DFN=0
  1. .. F S DFN=$O(^DPT("ASERVICE",SEPDATE,EDATE,DFN)) Q:DFN="" D
  1. ... S TYPE=""
  1. ... F S TYPE=$O(^DPT("ASERVICE",SEPDATE,EDATE,DFN,TYPE)) Q:TYPE="" D
  1. .... D CSERVDG(DFN,EDATE,SEPDATE,TYPE)
  1. I $D(^TMP($J,"ASERVICE")) D
  1. . S NOPROB=0
  1. . W !!,"The following service date index entries do not have a corresponding global entry:"
  1. . D PSERVM
  1. K ^TMP($J,"ASERVICE")
  1. I NOPROB W !,"No problems were found with the service dates index."
  1. ;
  1. ;Check the patient type index.
  1. S NOPROB=1
  1. I $D(^TMP($J,"PTYPE")) D
  1. . S NOPROB=0
  1. . W !!,"The following global entries do not have a matching patient type index entry:"
  1. . D PPTYPEM
  1. K ^TMP($J,"PTYPE")
  1. ;Go through the patient type index.
  1. S TYPE=""
  1. F S TYPE=$O(^DPT("APTYPE",TYPE)) Q:TYPE="" D
  1. . S DFN=0
  1. . F S DFN=$O(^DPT("APTYPE",TYPE,DFN)) Q:DFN="" D
  1. .. I TYPE'=$G(^DPT(DFN,"TYPE")) S ^TMP($J,"PTYPE",DFN)=TYPE
  1. I $D(^TMP($J,"PTYPE")) D
  1. . S NOPROB=0
  1. . W !!,"The following patient type index entries do not have a corresponding"
  1. . W !,"global entry:"
  1. . D PPTYPEM
  1. K ^TMP($J,"PTYPE")
  1. I NOPROB W !,"No problems were found with the patient type index."
  1. W !!,$$FMTE^XLFDT($$NOW^XLFDT,"5Z")," Index verification complete."
  1. Q
  1. ;