DGSRVICE ;SLC/PKR - Routines for setting service indexes. ;01/13/2006
;;5.3;Registration;**690**;Aug 13, 1993
;===============================================================
CSERVDI(DFN,EDATE,SEPDATE,TYPE) ;
I EDATE="",SEPDATE="" Q
I EDATE="" S EDATE="U"_DFN
I SEPDATE="" S SEPDATE="U"_DFN
I '$D(^DPT("ASERVICE",SEPDATE,EDATE,DFN,TYPE)) S ^TMP($J,"ASERVICE",DFN,TYPE)=EDATE_U_SEPDATE
Q
;
;===============================================================
CSERVDG(DFN,EDATE,SEPDATE,TYPE) ;
N NOMATCH,TEMP
S TEMP=$G(^DPT(DFN,.32))
S NOMATCH=0
I EDATE["U" S EDATE=""
I SEPDATE["U" S SEPDATE=""
I TYPE="LAST" S NOMATCH=$S(EDATE'=$P(TEMP,U,6):1,SEPDATE'=$P(TEMP,U,7):1,1:0)
I TYPE="NTL" S NOMATCH=$S(EDATE'=$P(TEMP,U,11):1,SEPDATE'=$P(TEMP,U,12):1,1:0)
I TYPE="NNTL" S NOMATCH=$S(EDATE'=$P(TEMP,U,16):1,SEPDATE'=$P(TEMP,U,17):1,1:0)
I NOMATCH S ^TMP($J,"ASERVICE",DFN,TYPE)=EDATE_U_SEPDATE
Q
;
;===============================================================
KSERV(X,DA,TYPE) ;Delete index for service data.
I X(1)="",X(2)="" Q
N ENTRY,SEP
S ENTRY=$S(X(1)'="":X(1),1:"U"_DA)
S SEP=$S(X(2)'="":X(2),1:"U"_DA)
K ^DPT("ASERVICE",SEP,ENTRY,DA,TYPE)
Q
;
;===============================================================
PPTYPEM ;Print the patient type index mismatches
N DFN,PTYPE
S DFN=0
F S DFN=$O(^TMP($J,"PTYPE",DFN)) Q:DFN="" D
. S PTYPE=^TMP($J,"PTYPE",DFN)
. W !,"DFN=",DFN," PATIENT TYPE=",PTYPE
Q
;
;===============================================================
PSERVM ;Print the service date index mismatches
N DFN,TEMP,TYPE
S DFN=0
F S DFN=$O(^TMP($J,"ASERVICE",DFN)) Q:DFN="" D
. S TYPE=""
. F S TYPE=$O(^TMP($J,"ASERVICE",DFN,TYPE)) Q:TYPE="" D
.. S TEMP=^TMP($J,"ASERVICE",DFN,TYPE)
.. W !,"DFN=",DFN," TYPE=",TYPE," Entry date=",$P(TEMP,U,1)," Separation date=",$P(TEMP,U,2)
Q
;
;===============================================================
SSERV(X,DA,TYPE) ;Set index for service data.
;X(1)=SERVICE ENTRY DATE
;X(2)=SERVICE SEPARATION DATE
I X(1)="",X(2)="" Q
N ENTRY,SEP
S ENTRY=$S(X(1)'="":X(1),1:"U"_DA)
S SEP=$S(X(2)'="":X(2),1:"U"_DA)
S ^DPT("ASERVICE",SEP,ENTRY,DA,TYPE)=""
Q
;
;===============================================================
VERIFY ;Check to make sure the indexes and global are in agreement.
N DFN,EDATE,NOPROB,PTYPE,SEPDATE,TEMP,TYPE
W !,$$FMTE^XLFDT($$NOW^XLFDT,"5Z")," Starting index verification.",!
S NOPROB=1
K ^TMP($J,"ASERVICE"),^TMP($J,"PTYPE")
;Go through the global.
S DFN=0
F S DFN=+$O(^DPT(DFN)) Q:DFN=0 D
. S PTYPE=$G(^DPT(DFN,"TYPE"))
. I PTYPE'="",'$D(^DPT("APTYPE",PTYPE,DFN)) S ^TMP($J,"PTYPE",DFN)=PTYPE
. S TEMP=$G(^DPT(DFN,.32))
. I TEMP="" Q
. S EDATE=$P(TEMP,U,6),SEPDATE=$P(TEMP,U,7) D CSERVDI(DFN,EDATE,SEPDATE,"LAST")
. S EDATE=$P(TEMP,U,11),SEPDATE=$P(TEMP,U,12) D CSERVDI(DFN,EDATE,SEPDATE,"NTL")
. S EDATE=$P(TEMP,U,16),SEPDATE=$P(TEMP,U,17) D CSERVDI(DFN,EDATE,SEPDATE,"NNTL")
I $D(^TMP($J,"ASERVICE")) D
. S NOPROB=0
. W !,"The following global entries do not have a matching service date index entry:"
. D PSERVM
;Go through the index.
K ^TMP($J,"ASERVICE")
S SEPDATE=0
F S SEPDATE=$O(^DPT("ASERVICE",SEPDATE)) Q:SEPDATE="" D
. S EDATE=0
. F S EDATE=$O(^DPT("ASERVICE",SEPDATE,EDATE)) Q:EDATE="" D
.. S DFN=0
.. F S DFN=$O(^DPT("ASERVICE",SEPDATE,EDATE,DFN)) Q:DFN="" D
... S TYPE=""
... F S TYPE=$O(^DPT("ASERVICE",SEPDATE,EDATE,DFN,TYPE)) Q:TYPE="" D
.... D CSERVDG(DFN,EDATE,SEPDATE,TYPE)
I $D(^TMP($J,"ASERVICE")) D
. S NOPROB=0
. W !!,"The following service date index entries do not have a corresponding global entry:"
. D PSERVM
K ^TMP($J,"ASERVICE")
I NOPROB W !,"No problems were found with the service dates index."
;
;Check the patient type index.
S NOPROB=1
I $D(^TMP($J,"PTYPE")) D
. S NOPROB=0
. W !!,"The following global entries do not have a matching patient type index entry:"
. D PPTYPEM
K ^TMP($J,"PTYPE")
;Go through the patient type index.
S TYPE=""
F S TYPE=$O(^DPT("APTYPE",TYPE)) Q:TYPE="" D
. S DFN=0
. F S DFN=$O(^DPT("APTYPE",TYPE,DFN)) Q:DFN="" D
.. I TYPE'=$G(^DPT(DFN,"TYPE")) S ^TMP($J,"PTYPE",DFN)=TYPE
I $D(^TMP($J,"PTYPE")) D
. S NOPROB=0
. W !!,"The following patient type index entries do not have a corresponding"
. W !,"global entry:"
. D PPTYPEM
K ^TMP($J,"PTYPE")
I NOPROB W !,"No problems were found with the patient type index."
W !!,$$FMTE^XLFDT($$NOW^XLFDT,"5Z")," Index verification complete."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGSRVICE 4571 printed Dec 13, 2024@02:58:58 Page 2
DGSRVICE ;SLC/PKR - Routines for setting service indexes. ;01/13/2006
+1 ;;5.3;Registration;**690**;Aug 13, 1993
+2 ;===============================================================
CSERVDI(DFN,EDATE,SEPDATE,TYPE) ;
+1 IF EDATE=""
IF SEPDATE=""
QUIT
+2 IF EDATE=""
SET EDATE="U"_DFN
+3 IF SEPDATE=""
SET SEPDATE="U"_DFN
+4 IF '$DATA(^DPT("ASERVICE",SEPDATE,EDATE,DFN,TYPE))
SET ^TMP($JOB,"ASERVICE",DFN,TYPE)=EDATE_U_SEPDATE
+5 QUIT
+6 ;
+7 ;===============================================================
CSERVDG(DFN,EDATE,SEPDATE,TYPE) ;
+1 NEW NOMATCH,TEMP
+2 SET TEMP=$GET(^DPT(DFN,.32))
+3 SET NOMATCH=0
+4 IF EDATE["U"
SET EDATE=""
+5 IF SEPDATE["U"
SET SEPDATE=""
+6 IF TYPE="LAST"
SET NOMATCH=$SELECT(EDATE'=$PIECE(TEMP,U,6):1,SEPDATE'=$PIECE(TEMP,U,7):1,1:0)
+7 IF TYPE="NTL"
SET NOMATCH=$SELECT(EDATE'=$PIECE(TEMP,U,11):1,SEPDATE'=$PIECE(TEMP,U,12):1,1:0)
+8 IF TYPE="NNTL"
SET NOMATCH=$SELECT(EDATE'=$PIECE(TEMP,U,16):1,SEPDATE'=$PIECE(TEMP,U,17):1,1:0)
+9 IF NOMATCH
SET ^TMP($JOB,"ASERVICE",DFN,TYPE)=EDATE_U_SEPDATE
+10 QUIT
+11 ;
+12 ;===============================================================
KSERV(X,DA,TYPE) ;Delete index for service data.
+1 IF X(1)=""
IF X(2)=""
QUIT
+2 NEW ENTRY,SEP
+3 SET ENTRY=$SELECT(X(1)'="":X(1),1:"U"_DA)
+4 SET SEP=$SELECT(X(2)'="":X(2),1:"U"_DA)
+5 KILL ^DPT("ASERVICE",SEP,ENTRY,DA,TYPE)
+6 QUIT
+7 ;
+8 ;===============================================================
PPTYPEM ;Print the patient type index mismatches
+1 NEW DFN,PTYPE
+2 SET DFN=0
+3 FOR
SET DFN=$ORDER(^TMP($JOB,"PTYPE",DFN))
if DFN=""
QUIT
Begin DoDot:1
+4 SET PTYPE=^TMP($JOB,"PTYPE",DFN)
+5 WRITE !,"DFN=",DFN," PATIENT TYPE=",PTYPE
End DoDot:1
+6 QUIT
+7 ;
+8 ;===============================================================
PSERVM ;Print the service date index mismatches
+1 NEW DFN,TEMP,TYPE
+2 SET DFN=0
+3 FOR
SET DFN=$ORDER(^TMP($JOB,"ASERVICE",DFN))
if DFN=""
QUIT
Begin DoDot:1
+4 SET TYPE=""
+5 FOR
SET TYPE=$ORDER(^TMP($JOB,"ASERVICE",DFN,TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+6 SET TEMP=^TMP($JOB,"ASERVICE",DFN,TYPE)
+7 WRITE !,"DFN=",DFN," TYPE=",TYPE," Entry date=",$PIECE(TEMP,U,1)," Separation date=",$PIECE(TEMP,U,2)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
+10 ;===============================================================
SSERV(X,DA,TYPE) ;Set index for service data.
+1 ;X(1)=SERVICE ENTRY DATE
+2 ;X(2)=SERVICE SEPARATION DATE
+3 IF X(1)=""
IF X(2)=""
QUIT
+4 NEW ENTRY,SEP
+5 SET ENTRY=$SELECT(X(1)'="":X(1),1:"U"_DA)
+6 SET SEP=$SELECT(X(2)'="":X(2),1:"U"_DA)
+7 SET ^DPT("ASERVICE",SEP,ENTRY,DA,TYPE)=""
+8 QUIT
+9 ;
+10 ;===============================================================
VERIFY ;Check to make sure the indexes and global are in agreement.
+1 NEW DFN,EDATE,NOPROB,PTYPE,SEPDATE,TEMP,TYPE
+2 WRITE !,$$FMTE^XLFDT($$NOW^XLFDT,"5Z")," Starting index verification.",!
+3 SET NOPROB=1
+4 KILL ^TMP($JOB,"ASERVICE"),^TMP($JOB,"PTYPE")
+5 ;Go through the global.
+6 SET DFN=0
+7 FOR
SET DFN=+$ORDER(^DPT(DFN))
if DFN=0
QUIT
Begin DoDot:1
+8 SET PTYPE=$GET(^DPT(DFN,"TYPE"))
+9 IF PTYPE'=""
IF '$DATA(^DPT("APTYPE",PTYPE,DFN))
SET ^TMP($JOB,"PTYPE",DFN)=PTYPE
+10 SET TEMP=$GET(^DPT(DFN,.32))
+11 IF TEMP=""
QUIT
+12 SET EDATE=$PIECE(TEMP,U,6)
SET SEPDATE=$PIECE(TEMP,U,7)
DO CSERVDI(DFN,EDATE,SEPDATE,"LAST")
+13 SET EDATE=$PIECE(TEMP,U,11)
SET SEPDATE=$PIECE(TEMP,U,12)
DO CSERVDI(DFN,EDATE,SEPDATE,"NTL")
+14 SET EDATE=$PIECE(TEMP,U,16)
SET SEPDATE=$PIECE(TEMP,U,17)
DO CSERVDI(DFN,EDATE,SEPDATE,"NNTL")
End DoDot:1
+15 IF $DATA(^TMP($JOB,"ASERVICE"))
Begin DoDot:1
+16 SET NOPROB=0
+17 WRITE !,"The following global entries do not have a matching service date index entry:"
+18 DO PSERVM
End DoDot:1
+19 ;Go through the index.
+20 KILL ^TMP($JOB,"ASERVICE")
+21 SET SEPDATE=0
+22 FOR
SET SEPDATE=$ORDER(^DPT("ASERVICE",SEPDATE))
if SEPDATE=""
QUIT
Begin DoDot:1
+23 SET EDATE=0
+24 FOR
SET EDATE=$ORDER(^DPT("ASERVICE",SEPDATE,EDATE))
if EDATE=""
QUIT
Begin DoDot:2
+25 SET DFN=0
+26 FOR
SET DFN=$ORDER(^DPT("ASERVICE",SEPDATE,EDATE,DFN))
if DFN=""
QUIT
Begin DoDot:3
+27 SET TYPE=""
+28 FOR
SET TYPE=$ORDER(^DPT("ASERVICE",SEPDATE,EDATE,DFN,TYPE))
if TYPE=""
QUIT
Begin DoDot:4
+29 DO CSERVDG(DFN,EDATE,SEPDATE,TYPE)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 IF $DATA(^TMP($JOB,"ASERVICE"))
Begin DoDot:1
+31 SET NOPROB=0
+32 WRITE !!,"The following service date index entries do not have a corresponding global entry:"
+33 DO PSERVM
End DoDot:1
+34 KILL ^TMP($JOB,"ASERVICE")
+35 IF NOPROB
WRITE !,"No problems were found with the service dates index."
+36 ;
+37 ;Check the patient type index.
+38 SET NOPROB=1
+39 IF $DATA(^TMP($JOB,"PTYPE"))
Begin DoDot:1
+40 SET NOPROB=0
+41 WRITE !!,"The following global entries do not have a matching patient type index entry:"
+42 DO PPTYPEM
End DoDot:1
+43 KILL ^TMP($JOB,"PTYPE")
+44 ;Go through the patient type index.
+45 SET TYPE=""
+46 FOR
SET TYPE=$ORDER(^DPT("APTYPE",TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+47 SET DFN=0
+48 FOR
SET DFN=$ORDER(^DPT("APTYPE",TYPE,DFN))
if DFN=""
QUIT
Begin DoDot:2
+49 IF TYPE'=$GET(^DPT(DFN,"TYPE"))
SET ^TMP($JOB,"PTYPE",DFN)=TYPE
End DoDot:2
End DoDot:1
+50 IF $DATA(^TMP($JOB,"PTYPE"))
Begin DoDot:1
+51 SET NOPROB=0
+52 WRITE !!,"The following patient type index entries do not have a corresponding"
+53 WRITE !,"global entry:"
+54 DO PPTYPEM
End DoDot:1
+55 KILL ^TMP($JOB,"PTYPE")
+56 IF NOPROB
WRITE !,"No problems were found with the patient type index."
+57 WRITE !!,$$FMTE^XLFDT($$NOW^XLFDT,"5Z")," Index verification complete."
+58 QUIT
+59 ;
