BQIDCMCM.m

BQIDCMCM ;PRXM/HC/ALA-"MY PATIENTS-CASE MANAGER" ; 20 Oct 2005  5:33 PM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 ;

 Q

 ;

FND(DATA,PARMS,MPARMS) ;EP - Find records

 ;

 ;Description

 ;  Executable that finds all patients who has a designated case manager

 ;Input

 ;  PARMS = Array of parameters and their values

 ;  MPARMS = Multiple array of a parameter (not currently used for this definition)

 ;Expected to return DATA

 ;

 ;  If the DSPM package is not installed, quit as there is no other case manager

 ;  alternative

 I $$VERSION^XPDUTL("BDP")="" Q

 ;

 NEW UID

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIDCMCM",UID))

 K @DATA

 ;

 ;  Lookup up the case manager internal entry number

 NEW DFN,CAT,DIC,IEN,NM,IEN,Y,X,PROV

 S DIC="^BDPTCAT("

 S DIC(0)="Z",X="CASE MANAGER" D ^DIC

 S CAT=+Y I CAT=-1 Q

 ;

 ;  Set the parameters into variables

 I '$D(PARMS),'$D(MPARMS) Q

 ;

 S NM=""

 F  S NM=$O(PARMS(NM)) Q:NM=""  D

 . S @NM=$P(PARMS(NM),U,1)

 . F I=2:1:$L(PARMS(NM),U) S @($P(PARMS(NM),U,I))

 ;

 ;  Go through the BDP DESG SPECIALTY PROVIDER File to find any patient

 ;  with the specified case manager

 ;

 S IEN=""

 F  S IEN=$O(^BDPRECN("AC",PROV,IEN)) Q:IEN=""  D

 . I $$GET1^DIQ(90360.1,IEN_",",.01,"I")'=CAT Q

 . S DFN=$$GET1^DIQ(90360.1,IEN_",",.02,"I") I DFN="" Q

 . ; If patient is deceased, quit

 . I $P($G(^DPT(DFN,.35)),U,1)'="" Q

 . ; If patient has no active HRNs, quit

 . I '$$HRN^BQIUL1(DFN) Q

 . ; If patient has no visit in last 3 years, quit

 . ;I '$$VTHR^BQIUL1(DFN) Q

 . S @DATA@(DFN)=""

 Q

BQIDCMCM  ;PRXM/HC/ALA-"MY PATIENTS-CASE MANAGER" ; 20 Oct 2005  5:33 PM

 +1       ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

 +3        QUIT 

 +4       ;

FND(DATA,PARMS,MPARMS) ;EP - Find records

 +1       ;

 +2       ;Description

 +3       ;  Executable that finds all patients who has a designated case manager

 +4       ;Input

 +5       ;  PARMS = Array of parameters and their values

 +6       ;  MPARMS = Multiple array of a parameter (not currently used for this definition)

 +7       ;Expected to return DATA

 +8       ;

 +9       ;  If the DSPM package is not installed, quit as there is no other case manager

 +10      ;  alternative

 +11       IF $$VERSION^XPDUTL("BDP")=""

               QUIT 

 +12      ;

 +13       NEW UID

 +14       SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +15       SET DATA=$NAME(^TMP("BQIDCMCM",UID))

 +16       KILL @DATA

 +17      ;

 +18      ;  Lookup up the case manager internal entry number

 +19       NEW DFN,CAT,DIC,IEN,NM,IEN,Y,X,PROV

 +20       SET DIC="^BDPTCAT("

 +21       SET DIC(0)="Z"

           SET X="CASE MANAGER"

           DO ^DIC

 +22       SET CAT=+Y

           IF CAT=-1

               QUIT 

 +23      ;

 +24      ;  Set the parameters into variables

 +25       IF '$DATA(PARMS)

               IF '$DATA(MPARMS)

                   QUIT 

 +26      ;

 +27       SET NM=""

 +28       FOR 

               SET NM=$ORDER(PARMS(NM))

               IF NM=""

                   QUIT 

               Begin DoDot:1

 +29               SET @NM=$PIECE(PARMS(NM),U,1)

 +30               FOR I=2:1:$LENGTH(PARMS(NM),U)

                       SET @($PIECE(PARMS(NM),U,I))

               End DoDot:1

 +31      ;

 +32      ;  Go through the BDP DESG SPECIALTY PROVIDER File to find any patient

 +33      ;  with the specified case manager

 +34      ;

 +35       SET IEN=""

 +36       FOR 

               SET IEN=$ORDER(^BDPRECN("AC",PROV,IEN))

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +37               IF $$GET1^DIQ(90360.1,IEN_",",.01,"I")'=CAT

                       QUIT 

 +38               SET DFN=$$GET1^DIQ(90360.1,IEN_",",.02,"I")

                   IF DFN=""

                       QUIT 

 +39      ; If patient is deceased, quit

 +40               IF $PIECE($GET(^DPT(DFN,.35)),U,1)'=""

                       QUIT 

 +41      ; If patient has no active HRNs, quit

 +42               IF '$$HRN^BQIUL1(DFN)

                       QUIT 

 +43      ; If patient has no visit in last 3 years, quit

 +44      ;I '$$VTHR^BQIUL1(DFN) Q

 +45               SET @DATA@(DFN)=""

               End DoDot:1

 +46       QUIT