MPIFDODC ;OAK/ELZ- DOD ACTIVITY CHECK ;6/9/2016
 ;;1.0;MASTER PATIENT INDEX VISTA;**64,66,67**;30 Apr 99;Build 2
 ; Integration Agreements Utilized:
 ;   IA #4433  $$SDAPI^SDAMA301
 ;   IA #4820  RX^PSO52API
 ;   IA #10062 IN5^VADPT and KVAR^VADPT
 ;   IA #92    ^DGPT("B",DFN), ^DGPT(PTF,0), ^DGPT(PTF,70)
 ;   IA #2548  OPEN^SDQ, INDEX^SDQ, PAT^SDQ, DATE^SDQ, SCANCB^SDQ,
 ;             ACTIVE^SDQ, SCAN^SDQ, CLOSE^SDQ
 ;   IA #6420  $$ACTIVITY^FBUTLMVI 
 ;   IA #2028  ^AUPNVSIT(
 ;   IA #3035  $$GETIENS^PXAAVCPT, $$CPT^PXAAVCPT
 ;
 ;
SITECK(RETURN,DFN,MPIDOD) ; - check various packages for activity after the
 ; date of death, called via RPC from the MPI
 ;
 N X,MPI52LST,MPINODE,MPIFB,VRETURN,MPIC,MPISDAR
 S RETURN=0
 ;
 ; Story 718545 (elz) check to make sure patient exists at site and return no activity if they are not there to have activity
 I '$D(^DPT(DFN,0)) Q
 ;
 ; Patients with appointments scheduled for dates after the current date,
 ; appointments that are cancelled should not be included.  The 
 ; appointment status should be set to blank, I, or NT.
 ; NOTE:  BLANK status is translated to R by the SDAMA301 call.
 K ^TMP($J,"SDAMA301")
 S MPISDAR("FLDS")=1
 S MPISDAR("MAX")=1
 S MPISDAR("SORT")="P"
 S MPISDAR(1)=$$FMADD^XLFDT(DT,1)
 S MPISDAR(3)="I;NT;R"
 S MPISDAR(4)=DFN
 S X=$$SDAPI^SDAMA301(.MPISDAR)
 I X S RETURN="1^"_($O(^TMP($J,"SDAMA301",DFN,0))\1)_"^Appointment Found"
 K ^TMP($J,"SDAMA301")
 Q:RETURN
 ;
 ;
 ; Patients with prescription fills requested after death.  The Log In
 ; date is the date the prescription was requested.
 ; Searching back 365 days + 90 days to ensure all possible prescriptions
 ; are included in the query since prescriptions can be set for up to 1
 ; year and initially filed within the first 90 days.
 ;
 S MPI52LST="MPIPSO",MPINODE="0,2,P,R"
 K ^TMP($J,MPI52LST,DFN)
 D RX^PSO52API(DFN,MPI52LST,,,MPINODE,$$FMADD^XLFDT(MPIDOD,-455))
 ; Story 718542 (elz) only use the login date (not time) for the comparison
 S X=0 F  S X=$O(^TMP($J,MPI52LST,DFN,X)) Q:'X!(RETURN)  D
 . N RF,P
 . I $P($P($G(^TMP($J,MPI52LST,DFN,X,21)),"^"),".")>MPIDOD S RETURN="1^"_($P(^(21),"^")\1)_"^Initial Rx Login" Q
 . S RF=0 F  S RF=$O(^TMP($J,MPI52LST,DFN,X,"RF",RF)) Q:'RF!(RETURN)  D
 .. I $P($G(^TMP($J,MPI52LST,DFN,X,"RF",RF,7)),".")>MPIDOD S RETURN="1^"_($P(^(7),"^")\1)_"^Refill Rx Login" Q
 . Q:RETURN
 . S P=0 F  S P=$O(^TMP($J,MPI52LST,DFN,X,"P",P)) Q:'P!(RETURN)  D
 .. I $P($G(^TMP($J,MPI52LST,DFN,X,"P",P,.08)),".")>MPIDOD S RETURN="1^"_($P(^(.08),"^")\1)_"^Partial Rx Login" Q
 I RETURN K ^TMP($J,MPI52LST,DFN) Q
 ;
 ; Rx part #2 (elz) MPIF*1*66
 ; the prescription was requested on or before the date of death, the fill date (FillDateTime)
 ; is after the current date, there is no date of death in the patient record at the
 ; corresponding station(Sta3n), and the prescription status (RxStatus) is ACTIVE, NON-VERIFIED,
 ; REFILL, HOLD, DRUG INTERACTIONS, SUSPENDED, 0, 1, 2, 3, 4, or 5
 ;- If there is no DOD at current site (I'd do this first just to quickly eliminate)
 I '$P($G(^DPT(DFN,.35)),"^") D
 . ;- Then loop through rx's
 . S X=0 F  S X=$O(^TMP($J,MPI52LST,DFN,X)) Q:'X!(RETURN)  D
 .. ; Check status 0,1,2,3,4,5 (also quickly eliminate rx's based on status early
 .. I $P($G(^TMP($J,MPI52LST,DFN,X,100)),"^")'="",$P($G(^TMP($J,MPI52LST,DFN,X,100)),"^")<6 D
 ... N RF,P
 ... ; if Rx initial Rx requested on or before DOD (login date/time #21) AND if Fill Date>DT (#22) return activity
 ... I $P($G(^TMP($J,MPI52LST,DFN,X,21)),".")'>MPIDOD,$G(^(21)),$P($G(^(22)),".")>DT S RETURN="1^"_(^(21)\1)_"^Initial Rx'>DOD,"_(^(22)\1)_">DT" Q
 ... ; loop through refills
 ... S RF=0 F  S RF=$O(^TMP($J,MPI52LST,DFN,X,"RF",RF)) Q:'RF!(RETURN)  D
 .... ;if refill requested on or before DOD (login date/time #7) AND if Fill Date>DT (#.01) return activity
 .... I $P($G(^TMP($J,MPI52LST,DFN,X,"RF",RF,7)),".")'>MPIDOD,$G(^(7)),$P($G(^(.01)),".")>DT S RETURN="1^"_(^(7)\1)_"^Refill'>DOD,"_(^(.01)\1)_">DT" Q
 ... ; loop through partials
 ... S P=0 F  S P=$O(^TMP($J,MPI52LST,DFN,X,"P",P)) Q:'P!(RETURN)  D
 .... ;if partial requested on or before DOD (login date/time #.08) AND if Fill Date>DT (#.01) return activiy
 .... I $P($G(^TMP($J,MPI52LST,DFN,X,"P",P,.08)),".")'>MPIDOD,$G(^(.08)),$P($G(^(.01)),".")>DT S RETURN="1^"_(^(.08)\1)_"Partial'>DOD,"_(^(.01)\1)_">DT" Q
 K ^TMP($J,MPI52LST,DFN)
 Q:RETURN
 ;
 ;
 ; Note: The next two categories are only considered when:
 ;  (1) the VistA patient record being checked for activity has no death
 ;      date or
 ;  (2) the VistA patient record being checked for activity has a death
 ;      date, and the source is other than INPATIENT AT VAMC.
 S X=$G(^DPT(DFN,35)) I 'X!(X&($P(X,"^",3)'=1)) D  Q:RETURN
 . ;
 . N VAIP,MPIARR,PTF
 . ; i. Patients with an inpatient discharge date more than one day after
 . ;    the date of death, VHA facility: The discharge date is more than
 . ;    one day after the date of death or the patient has not been
 . ;    discharged (currently an inpatient).
 . S VAIP("D")="LAST",VAIP("M")=0 D IN5^VADPT
 . I VAIP(1),'VAIP(17) S RETURN="1^^No Discharge Movement" Q
 . I $P(VAIP(17,1),".")>$$FMADD^XLFDT(MPIDOD,1) S RETURN="1^"_(VAIP(17,1)\1)_"^Last Discharge > DOD" Q
 . D KVAR^VADPT
 . ;
 . ;
 . ;ii. Purchased care: The discharge date is more than one day after
 . ;    the date of death. If there is no discharge date, use the
 . ;    admission date.  Have to go to the PTF as the FEE ones don't
 . ;    create movements and don't show in the VADPT calls.
 . ; get the last ptf record.
 . S PTF=$O(^DGPT("B",DFN,":"),-1)_","
 . I PTF D GETS^DIQ(45,PTF_",","2;70","I","MPIARR")
 . ; really we don't care if it was FEE or not, it was after the DOD
 . ; Story 722864 (elz) update return text to include PTF file (#45) IEN=nnnn
 . I $P($G(MPIARR(45,PTF,70,"I")),".")>$$FMADD^XLFDT(MPIDOD,1) S RETURN="1^"_(MPIARR(45,PTF,70,"I")\1)_"^PTF Record with discharge after DOD, PTF file (#45) IEN="_+PTF Q
 . E  I $P($G(MPIARR(45,PTF,2,"I")),".")>$$FMADD^XLFDT(MPIDOD,1) S RETURN="1^"_(MPIARR(45,PTF,2,"I")\1)_"^PTF with admission after DOD, PTF file (#45) IEN="_+PTF
 ;
 ; Patients with two or more of the following health care events after
 ; death
 S MPIC=0
 ; i. Visits that are not historical entries, are not non-count, and have
 ;    a procedure code recorded on the visit
 K ^TMP("DIERR",$J) D
 . N MPIQ
 . D OPEN^SDQ(.MPIQ) Q:'$G(MPIQ)
 . D INDEX^SDQ(.MPIQ,"PATIENT/DATE","SET")
 . D SCANCB^SDQ(.MPIQ,"D CALLBACK^MPIFDODC(Y0)","SET")
 . D PAT^SDQ(.MPIQ,DFN,"SET")
 . D DATE^SDQ(.MPIQ,$$FMADD^XLFDT(MPIDOD,1),9999999,"SET")
 . D ACTIVE^SDQ(.MPIQ,"TRUE","SET")
 . D SCAN^SDQ(.MPIQ,"FORWARD")
 . D CLOSE^SDQ(.MPIQ)
 K ^TMP("DIERR",$J)
 ;
 I MPIC>1,$G(VRETURN) S RETURN=VRETURN Q
 ;
 ; ii. Purchased Care with treatment dates after date of death
 S MPIFB=$$ACTIVITY^FBUTLMVI(DFN,MPIDOD,.MPIFB)
 I MPIFB+MPIC>1 S RETURN="1^"_MPIFB(+$O(MPIFB(0)))
 ;
 Q
 ;
CALLBACK(MPIOE) ; - Called back from the SDQ
 N MPIVISIT,MPICPT,MPICPTV,MPIARR,MPIS
 Q:$P(MPIOE,"^",12)=12  ; non-count encounter
 S MPIVISIT=$P(MPIOE,"^",5)_"," Q:'MPIVISIT
 D GETS^DIQ(9000010,MPIVISIT,".07","I","MPIARR")
 Q:$G(MPIARR(9000010,"4,",.07,"I"))="E"  ; historical
 S MPICPT=$$GETIENS^PXAAVCPT(+MPIVISIT,.MPICPT)
 Q:'MPICPT  ; no procedures found
 S MPIS=0
 S MPICPT=0 F  S MPICPT=$O(MPICPT(MPICPT)) Q:'MPICPT!(MPIS)  D
 . S MPICPTV=$$CPT^PXAAVCPT(MPICPT)
 . Q:$L($T(@MPICPTV))  ; cpt on the exclude list
 . S MPIC=MPIC+1,VRETURN="1^"_(MPIOE\1)_"^Multiple visits found",MPIS=1
 I MPIC>1 S SDSTOP=1
 Q
CPTS ; - list of cpt codes to ignore
98966 ;;HC PRO PHONE CALL 5-10 MIN
98967 ;;HC PRO PHONE CALL 11-20 MIN
98968 ;;HC PRO PHONE CALL 21-30 MIN
99441 ;;PHONE E/M PHYS/QHP 5-10 MIN
99373 ;;PHYSICIAN PHONE CONSULTATION
99442 ;;PHONE E/M PHYS/QHP 11-20 MIN
99371 ;;PHYSICIAN PHONE CONSULTATION
99377 ;;HOSPICE CARE SUPERVISION
99378 ;;HOSPICE CARE SUPERVISION
99372 ;;PHYSICIAN PHONE CONSULTATION
G0182 ;;HOSPICE CARE SUPERVISION
99443 ;;PHONE E/M PHYS/QHP 21-30 MIN
99380 ;;NURSING FAC CARE SUPERVISION
S0320 ;;RN TELEPHONE CALLS TO DMP
99339 ;;DOMICIL/R-HOME CARE SUPERVIS
99447 ;;INTERPROF PHONE/ONLINE 11-20
99448 ;;INTERPROF PHONE/ONLINE 21-30
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFDODC   8323     printed  Sep 23, 2025@19:47:05                                                                                                                                                                                                    Page 2
MPIFDODC  ;OAK/ELZ- DOD ACTIVITY CHECK ;6/9/2016
 +1       ;;1.0;MASTER PATIENT INDEX VISTA;**64,66,67**;30 Apr 99;Build 2
 +2       ; Integration Agreements Utilized:
 +3       ;   IA #4433  $$SDAPI^SDAMA301
 +4       ;   IA #4820  RX^PSO52API
 +5       ;   IA #10062 IN5^VADPT and KVAR^VADPT
 +6       ;   IA #92    ^DGPT("B",DFN), ^DGPT(PTF,0), ^DGPT(PTF,70)
 +7       ;   IA #2548  OPEN^SDQ, INDEX^SDQ, PAT^SDQ, DATE^SDQ, SCANCB^SDQ,
 +8       ;             ACTIVE^SDQ, SCAN^SDQ, CLOSE^SDQ
 +9       ;   IA #6420  $$ACTIVITY^FBUTLMVI 
 +10      ;   IA #2028  ^AUPNVSIT(
 +11      ;   IA #3035  $$GETIENS^PXAAVCPT, $$CPT^PXAAVCPT
 +12      ;
 +13      ;
SITECK(RETURN,DFN,MPIDOD) ; - check various packages for activity after the
 +1       ; date of death, called via RPC from the MPI
 +2       ;
 +3        NEW X,MPI52LST,MPINODE,MPIFB,VRETURN,MPIC,MPISDAR
 +4        SET RETURN=0
 +5       ;
 +6       ; Story 718545 (elz) check to make sure patient exists at site and return no activity if they are not there to have activity
 +7        IF '$DATA(^DPT(DFN,0))
               QUIT 
 +8       ;
 +9       ; Patients with appointments scheduled for dates after the current date,
 +10      ; appointments that are cancelled should not be included.  The 
 +11      ; appointment status should be set to blank, I, or NT.
 +12      ; NOTE:  BLANK status is translated to R by the SDAMA301 call.
 +13       KILL ^TMP($JOB,"SDAMA301")
 +14       SET MPISDAR("FLDS")=1
 +15       SET MPISDAR("MAX")=1
 +16       SET MPISDAR("SORT")="P"
 +17       SET MPISDAR(1)=$$FMADD^XLFDT(DT,1)
 +18       SET MPISDAR(3)="I;NT;R"
 +19       SET MPISDAR(4)=DFN
 +20       SET X=$$SDAPI^SDAMA301(.MPISDAR)
 +21       IF X
               SET RETURN="1^"_($ORDER(^TMP($JOB,"SDAMA301",DFN,0))\1)_"^Appointment Found"
 +22       KILL ^TMP($JOB,"SDAMA301")
 +23       if RETURN
               QUIT 
 +24      ;
 +25      ;
 +26      ; Patients with prescription fills requested after death.  The Log In
 +27      ; date is the date the prescription was requested.
 +28      ; Searching back 365 days + 90 days to ensure all possible prescriptions
 +29      ; are included in the query since prescriptions can be set for up to 1
 +30      ; year and initially filed within the first 90 days.
 +31      ;
 +32       SET MPI52LST="MPIPSO"
           SET MPINODE="0,2,P,R"
 +33       KILL ^TMP($JOB,MPI52LST,DFN)
 +34       DO RX^PSO52API(DFN,MPI52LST,,,MPINODE,$$FMADD^XLFDT(MPIDOD,-455))
 +35      ; Story 718542 (elz) only use the login date (not time) for the comparison
 +36       SET X=0
           FOR 
               SET X=$ORDER(^TMP($JOB,MPI52LST,DFN,X))
               if 'X!(RETURN)
                   QUIT 
               Begin DoDot:1
 +37               NEW RF,P
 +38               IF $PIECE($PIECE($GET(^TMP($JOB,MPI52LST,DFN,X,21)),"^"),".")>MPIDOD
                       SET RETURN="1^"_($PIECE(^(21),"^")\1)_"^Initial Rx Login"
                       QUIT 
 +39               SET RF=0
                   FOR 
                       SET RF=$ORDER(^TMP($JOB,MPI52LST,DFN,X,"RF",RF))
                       if 'RF!(RETURN)
                           QUIT 
                       Begin DoDot:2
 +40                       IF $PIECE($GET(^TMP($JOB,MPI52LST,DFN,X,"RF",RF,7)),".")>MPIDOD
                               SET RETURN="1^"_($PIECE(^(7),"^")\1)_"^Refill Rx Login"
                               QUIT 
                       End DoDot:2
 +41               if RETURN
                       QUIT 
 +42               SET P=0
                   FOR 
                       SET P=$ORDER(^TMP($JOB,MPI52LST,DFN,X,"P",P))
                       if 'P!(RETURN)
                           QUIT 
                       Begin DoDot:2
 +43                       IF $PIECE($GET(^TMP($JOB,MPI52LST,DFN,X,"P",P,.08)),".")>MPIDOD
                               SET RETURN="1^"_($PIECE(^(.08),"^")\1)_"^Partial Rx Login"
                               QUIT 
                       End DoDot:2
               End DoDot:1
 +44       IF RETURN
               KILL ^TMP($JOB,MPI52LST,DFN)
               QUIT 
 +45      ;
 +46      ; Rx part #2 (elz) MPIF*1*66
 +47      ; the prescription was requested on or before the date of death, the fill date (FillDateTime)
 +48      ; is after the current date, there is no date of death in the patient record at the
 +49      ; corresponding station(Sta3n), and the prescription status (RxStatus) is ACTIVE, NON-VERIFIED,
 +50      ; REFILL, HOLD, DRUG INTERACTIONS, SUSPENDED, 0, 1, 2, 3, 4, or 5
 +51      ;- If there is no DOD at current site (I'd do this first just to quickly eliminate)
 +52       IF '$PIECE($GET(^DPT(DFN,.35)),"^")
               Begin DoDot:1
 +53      ;- Then loop through rx's
 +54               SET X=0
                   FOR 
                       SET X=$ORDER(^TMP($JOB,MPI52LST,DFN,X))
                       if 'X!(RETURN)
                           QUIT 
                       Begin DoDot:2
 +55      ; Check status 0,1,2,3,4,5 (also quickly eliminate rx's based on status early
 +56                       IF $PIECE($GET(^TMP($JOB,MPI52LST,DFN,X,100)),"^")'=""
                               IF $PIECE($GET(^TMP($JOB,MPI52LST,DFN,X,100)),"^")<6
                                   Begin DoDot:3
 +57                                   NEW RF,P
 +58      ; if Rx initial Rx requested on or before DOD (login date/time #21) AND if Fill Date>DT (#22) return activity
 +59                                   IF $PIECE($GET(^TMP($JOB,MPI52LST,DFN,X,21)),".")'>MPIDOD
                                           IF $GET(^(21))
                                               IF $PIECE($GET(^(22)),".")>DT
                                                   SET RETURN="1^"_(^(21)\1)_"^Initial Rx'>DOD,"_(^(22)\1)_">DT"
                                                   QUIT 
 +60      ; loop through refills
 +61                                   SET RF=0
                                       FOR 
                                           SET RF=$ORDER(^TMP($JOB,MPI52LST,DFN,X,"RF",RF))
                                           if 'RF!(RETURN)
                                               QUIT 
                                           Begin DoDot:4
 +62      ;if refill requested on or before DOD (login date/time #7) AND if Fill Date>DT (#.01) return activity
 +63                                           IF $PIECE($GET(^TMP($JOB,MPI52LST,DFN,X,"RF",RF,7)),".")'>MPIDOD
                                                   IF $GET(^(7))
                                                       IF $PIECE($GET(^(.01)),".")>DT
                                                           SET RETURN="1^"_(^(7)\1)_"^Refill'>DOD,"_(^(.01)\1)_">DT"
                                                           QUIT 
                                           End DoDot:4
 +64      ; loop through partials
 +65                                   SET P=0
                                       FOR 
                                           SET P=$ORDER(^TMP($JOB,MPI52LST,DFN,X,"P",P))
                                           if 'P!(RETURN)
                                               QUIT 
                                           Begin DoDot:4
 +66      ;if partial requested on or before DOD (login date/time #.08) AND if Fill Date>DT (#.01) return activiy
 +67                                           IF $PIECE($GET(^TMP($JOB,MPI52LST,DFN,X,"P",P,.08)),".")'>MPIDOD
                                                   IF $GET(^(.08))
                                                       IF $PIECE($GET(^(.01)),".")>DT
                                                           SET RETURN="1^"_(^(.08)\1)_"Partial'>DOD,"_(^(.01)\1)_">DT"
                                                           QUIT 
                                           End DoDot:4
                                   End DoDot:3
                       End DoDot:2
               End DoDot:1
 +68       KILL ^TMP($JOB,MPI52LST,DFN)
 +69       if RETURN
               QUIT 
 +70      ;
 +71      ;
 +72      ; Note: The next two categories are only considered when:
 +73      ;  (1) the VistA patient record being checked for activity has no death
 +74      ;      date or
 +75      ;  (2) the VistA patient record being checked for activity has a death
 +76      ;      date, and the source is other than INPATIENT AT VAMC.
 +77       SET X=$GET(^DPT(DFN,35))
           IF 'X!(X&($PIECE(X,"^",3)'=1))
               Begin DoDot:1
 +78      ;
 +79               NEW VAIP,MPIARR,PTF
 +80      ; i. Patients with an inpatient discharge date more than one day after
 +81      ;    the date of death, VHA facility: The discharge date is more than
 +82      ;    one day after the date of death or the patient has not been
 +83      ;    discharged (currently an inpatient).
 +84               SET VAIP("D")="LAST"
                   SET VAIP("M")=0
                   DO IN5^VADPT
 +85               IF VAIP(1)
                       IF 'VAIP(17)
                           SET RETURN="1^^No Discharge Movement"
                           QUIT 
 +86               IF $PIECE(VAIP(17,1),".")>$$FMADD^XLFDT(MPIDOD,1)
                       SET RETURN="1^"_(VAIP(17,1)\1)_"^Last Discharge > DOD"
                       QUIT 
 +87               DO KVAR^VADPT
 +88      ;
 +89      ;
 +90      ;ii. Purchased care: The discharge date is more than one day after
 +91      ;    the date of death. If there is no discharge date, use the
 +92      ;    admission date.  Have to go to the PTF as the FEE ones don't
 +93      ;    create movements and don't show in the VADPT calls.
 +94      ; get the last ptf record.
 +95               SET PTF=$ORDER(^DGPT("B",DFN,":"),-1)_","
 +96               IF PTF
                       DO GETS^DIQ(45,PTF_",","2;70","I","MPIARR")
 +97      ; really we don't care if it was FEE or not, it was after the DOD
 +98      ; Story 722864 (elz) update return text to include PTF file (#45) IEN=nnnn
 +99               IF $PIECE($GET(MPIARR(45,PTF,70,"I")),".")>$$FMADD^XLFDT(MPIDOD,1)
                       SET RETURN="1^"_(MPIARR(45,PTF,70,"I")\1)_"^PTF Record with discharge after DOD, PTF file (#45) IEN="_+PTF
                       QUIT 
 +100             IF '$TEST
                       IF $PIECE($GET(MPIARR(45,PTF,2,"I")),".")>$$FMADD^XLFDT(MPIDOD,1)
                           SET RETURN="1^"_(MPIARR(45,PTF,2,"I")\1)_"^PTF with admission after DOD, PTF file (#45) IEN="_+PTF
               End DoDot:1
               if RETURN
                   QUIT 
 +101     ;
 +102     ; Patients with two or more of the following health care events after
 +103     ; death
 +104      SET MPIC=0
 +105     ; i. Visits that are not historical entries, are not non-count, and have
 +106     ;    a procedure code recorded on the visit
 +107      KILL ^TMP("DIERR",$JOB)
           Begin DoDot:1
 +108          NEW MPIQ
 +109          DO OPEN^SDQ(.MPIQ)
               if '$GET(MPIQ)
                   QUIT 
 +110          DO INDEX^SDQ(.MPIQ,"PATIENT/DATE","SET")
 +111          DO SCANCB^SDQ(.MPIQ,"D CALLBACK^MPIFDODC(Y0)","SET")
 +112          DO PAT^SDQ(.MPIQ,DFN,"SET")
 +113          DO DATE^SDQ(.MPIQ,$$FMADD^XLFDT(MPIDOD,1),9999999,"SET")
 +114          DO ACTIVE^SDQ(.MPIQ,"TRUE","SET")
 +115          DO SCAN^SDQ(.MPIQ,"FORWARD")
 +116          DO CLOSE^SDQ(.MPIQ)
           End DoDot:1
 +117      KILL ^TMP("DIERR",$JOB)
 +118     ;
 +119      IF MPIC>1
               IF $GET(VRETURN)
                   SET RETURN=VRETURN
                   QUIT 
 +120     ;
 +121     ; ii. Purchased Care with treatment dates after date of death
 +122      SET MPIFB=$$ACTIVITY^FBUTLMVI(DFN,MPIDOD,.MPIFB)
 +123      IF MPIFB+MPIC>1
               SET RETURN="1^"_MPIFB(+$ORDER(MPIFB(0)))
 +124     ;
 +125      QUIT 
 +126     ;
CALLBACK(MPIOE) ; - Called back from the SDQ
 +1        NEW MPIVISIT,MPICPT,MPICPTV,MPIARR,MPIS
 +2       ; non-count encounter
           if $PIECE(MPIOE,"^",12)=12
               QUIT 
 +3        SET MPIVISIT=$PIECE(MPIOE,"^",5)_","
           if 'MPIVISIT
               QUIT 
 +4        DO GETS^DIQ(9000010,MPIVISIT,".07","I","MPIARR")
 +5       ; historical
           if $GET(MPIARR(9000010,"4,",.07,"I"))="E"
               QUIT 
 +6        SET MPICPT=$$GETIENS^PXAAVCPT(+MPIVISIT,.MPICPT)
 +7       ; no procedures found
           if 'MPICPT
               QUIT 
 +8        SET MPIS=0
 +9        SET MPICPT=0
           FOR 
               SET MPICPT=$ORDER(MPICPT(MPICPT))
               if 'MPICPT!(MPIS)
                   QUIT 
               Begin DoDot:1
 +10               SET MPICPTV=$$CPT^PXAAVCPT(MPICPT)
 +11      ; cpt on the exclude list
                   if $LENGTH($TEXT(@MPICPTV))
                       QUIT 
 +12               SET MPIC=MPIC+1
                   SET VRETURN="1^"_(MPIOE\1)_"^Multiple visits found"
                   SET MPIS=1
               End DoDot:1
 +13       IF MPIC>1
               SET SDSTOP=1
 +14       QUIT 
CPTS      ; - list of cpt codes to ignore
98966     ;;HC PRO PHONE CALL 5-10 MIN
98967     ;;HC PRO PHONE CALL 11-20 MIN
98968     ;;HC PRO PHONE CALL 21-30 MIN
99441     ;;PHONE E/M PHYS/QHP 5-10 MIN
99373     ;;PHYSICIAN PHONE CONSULTATION
99442     ;;PHONE E/M PHYS/QHP 11-20 MIN
99371     ;;PHYSICIAN PHONE CONSULTATION
99377     ;;HOSPICE CARE SUPERVISION
99378     ;;HOSPICE CARE SUPERVISION
99372     ;;PHYSICIAN PHONE CONSULTATION
G0182     ;;HOSPICE CARE SUPERVISION
99443     ;;PHONE E/M PHYS/QHP 21-30 MIN
99380     ;;NURSING FAC CARE SUPERVISION
S0320     ;;RN TELEPHONE CALLS TO DMP
99339     ;;DOMICIL/R-HOME CARE SUPERVIS
99447     ;;INTERPROF PHONE/ONLINE 11-20
99448     ;;INTERPROF PHONE/ONLINE 21-30