- DGSRVICE ;SLC/PKR - Routines for setting service indexes. ;01/13/2006
- ;;5.3;Registration;**690,1015**;Aug 13, 1993;Build 21
- ;===============================================================
- 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
- ;
- DGSRVICE ;SLC/PKR - Routines for setting service indexes. ;01/13/2006
- +1 ;;5.3;Registration;**690,1015**;Aug 13, 1993;Build 21
- +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 ;