PXRMPCMM.m

PXRMPCMM ;SLC/PKR - Computed findings for PCMM. ;07/01/2012

 ;;2.0;CLINICAL REMINDERS;**18,24**;Feb 04, 2005;Build 193

 ;References to SCAPMC supported by DBIA #1916.

 ;====================================

INSTPCTM(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PCMM PC TEAM

 ;INSTITUTION computed finding. Return the institution and team for

 ;the patient's primary care team as of the evaluation date. 

 N IND,EFFDATE,RESULT

 S EFFDATE=$$NOW^PXRMDATE

 S RESULT=$$INSTPCTM^SCAPMC(DFN,EFFDATE)

 I RESULT=0 S NFOUND=0 Q

 S NFOUND=1,DATE(1)=EFFDATE,TEST(1)=1

 S (DATA(1,"PCMM TEAM"),DATA(1,"VALUE"))=$P(RESULT,U,2)

 S DATA(1,"INSTITUTION")=$P(RESULT,U,4)

 S TEXT(1)="Primary care team is "_DATA(1,"PCMM TEAM")_", Institution is "_DATA(1,"INSTITUTION")_"."

 Q

 ;

 ;====================================

MHTC(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PCMM MHTC computed

 ;finding. MHTC stands for Mental Health Treatment Coordinator.

 N RESULT

 ;DBIA #5697

 S RESULT=$$START^SCMCMHTC(DFN)

 I RESULT="" S NFOUND=0 Q

 ;S NFOUND=1,DATE(1)=$$NOW^PXRMDATE,TEST(1)=1

 ;The API does not currently take a date.

 S NFOUND=1,DATE(1)=$$NOW^XLFDT,TEST(1)=1

 S (DATA(1,"MHTC"),DATA(1,"VALUE"))=$P(RESULT,U,2)

 S DATA(1,"TEAM POSITION")=$P(RESULT,U,3)

 S DATA(1,"ROLE")=$P(RESULT,U,4)

 S DATA(1,"TEAM")=$P(RESULT,U,5)

 S TEXT(1)="Team Position is "_DATA(1,"TEAM POSITION")_", Role is "_DATA(1,"ROLE")_", Team is "_DATA(1,"TEAM")_"."

 Q

 ;

 ;====================================

PRPT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PCMM PRACTITIONERS

 ;ASSIGNED TO A PATIENT computed finding. Return a list of

 ;practitioners assigned to a patient.

 N DATES,ERR,INCL,IND,LIST,RESULT

 S INCL=+$P(TEST,U,1)

 S DATES("BEGIN")=BDT,DATES("END")=EDT,DATES("INCL")=INCL

 S RESULT=$$PRPT^SCAPMC(DFN,"DATES","","","","","LIST","ERR")

 S NFOUND=+$G(LIST(0))

 I NFOUND=0 Q

 F IND=1:1:NFOUND D

 . S TEST(IND)=1

 . S DATA(IND,"PROVIDER IEN")=$P(LIST(IND),U,1)

 . S DATA(IND,"PROVIDER")=$P(LIST(IND),U,2)

 . S DATA(IND,"POSITION")=$P(LIST(IND),U,4)

 . S (DATA(IND,"ACTIVATION DATE"),DATE(IND))=$P(LIST(IND),U,9)

 . S TEXT(IND)="Provider: "_DATA(IND,"PROVIDER")_"; Position: "_DATA(IND,"POSITION")

 Q

 ;

 ;====================================

PTPR(NGET,BDT,EDT,PLIST,PARAM) ;VA-PCMM PATIENTS ASSIGNED TO A PRACTITIONER.

 ;List type computed finding that returns a list of patients

 ;assigned to a list of practitioners within a time period.

 N DATES,ERR,INCL,IND,JND,LIST,NPAT,NPR,PRAC,PRACLIST,RESULT

 K ^TMP($J,PLIST)

 S PRACLIST=$P(PARAM,U,1)

 S INCL=+$P(PARAM,U,2)

 S NPR=$L(PRACLIST,";")

 S DATES("BEGIN")=BDT,DATES("END")=EDT,DATES("INCL")=INCL

 F IND=1:1:NPR D

 . S PRAC=$P(PRACLIST,";",IND)

 . S PRAC=$$FIND1^DIC(200,,"ABX",PRAC,,,"MSG")

 . I PRAC=0 Q

 . K LIST

 . S RESULT=$$PTPR^SCAPMC(PRAC,"DATES","","","LIST","ERR","")

 . S NPAT=+$G(LIST(0)) I NPAT=0 Q

 . F JND=1:1:NPAT D

 .. S DFN=$P(LIST(JND),U,1)

 .. S ^TMP($J,PLIST,DFN,1)=U_$P(LIST(JND),U,4)_U_DFN_U_$P(LIST(JND),U,2)

 .. S ^TMP($J,PLIST,DFN,1,"VALUE")=DFN

 Q

 ;

 ;====================================

PTTM(NGET,BDT,EDT,PLIST,PARAM) ;VA-PCMM PATIENTS ASSIGNED TO A TEAM

 ;List type computed finding that returns a list of patients

 ;assigned to a team for a time period.

 N DATES,ERR,INCL,LIST,MSG,RESULT,TEAM

 S TEAM=$P(PARAM,U,1)

 S TEAM=$$FIND1^DIC(404.51,,"ABX",TEAM,,,"MSG")

 I TEAM=0 Q

 S INCL=+$P(PARAM,U,2)

 S DATES("BEGIN")=BDT,DATES("END")=EDT,DATES("INCL")=INCL

 ;Return list in ^TMP.

 S RESULT=$$PTTM^SCAPMC(TEAM,"DATES","LIST","MSG")

 K ^TMP($J,PLIST)

 S IND=0

 F  S IND=+$O(LIST(IND)) Q:IND=0  D

 . S DFN=$P(LIST(IND),U,1)

 . S ^TMP($J,PLIST,DFN,1)=U_$P(LIST(IND),U,4)_U_DFN_U_$P(LIST(IND),U,2)

 . S ^TMP($J,PLIST,DFN,1,"VALUE")=DFN

 Q

 ;

PXRMPCMM  ;SLC/PKR - Computed findings for PCMM. ;07/01/2012

 +1       ;;2.0;CLINICAL REMINDERS;**18,24**;Feb 04, 2005;Build 193

 +2       ;References to SCAPMC supported by DBIA #1916.

 +3       ;====================================

INSTPCTM(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PCMM PC TEAM

 +1       ;INSTITUTION computed finding. Return the institution and team for

 +2       ;the patient's primary care team as of the evaluation date. 

 +3        NEW IND,EFFDATE,RESULT

 +4        SET EFFDATE=$$NOW^PXRMDATE

 +5        SET RESULT=$$INSTPCTM^SCAPMC(DFN,EFFDATE)

 +6        IF RESULT=0

               SET NFOUND=0

               QUIT 

 +7        SET NFOUND=1

           SET DATE(1)=EFFDATE

           SET TEST(1)=1

 +8        SET (DATA(1,"PCMM TEAM"),DATA(1,"VALUE"))=$PIECE(RESULT,U,2)

 +9        SET DATA(1,"INSTITUTION")=$PIECE(RESULT,U,4)

 +10       SET TEXT(1)="Primary care team is "_DATA(1,"PCMM TEAM")_", Institution is "_DATA(1,"INSTITUTION")_"."

 +11       QUIT 

 +12      ;

 +13      ;====================================

MHTC(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PCMM MHTC computed

 +1       ;finding. MHTC stands for Mental Health Treatment Coordinator.

 +2        NEW RESULT

 +3       ;DBIA #5697

 +4        SET RESULT=$$START^SCMCMHTC(DFN)

 +5        IF RESULT=""

               SET NFOUND=0

               QUIT 

 +6       ;S NFOUND=1,DATE(1)=$$NOW^PXRMDATE,TEST(1)=1

 +7       ;The API does not currently take a date.

 +8        SET NFOUND=1

           SET DATE(1)=$$NOW^XLFDT

           SET TEST(1)=1

 +9        SET (DATA(1,"MHTC"),DATA(1,"VALUE"))=$PIECE(RESULT,U,2)

 +10       SET DATA(1,"TEAM POSITION")=$PIECE(RESULT,U,3)

 +11       SET DATA(1,"ROLE")=$PIECE(RESULT,U,4)

 +12       SET DATA(1,"TEAM")=$PIECE(RESULT,U,5)

 +13       SET TEXT(1)="Team Position is "_DATA(1,"TEAM POSITION")_", Role is "_DATA(1,"ROLE")_", Team is "_DATA(1,"TEAM")_"."

 +14       QUIT 

 +15      ;

 +16      ;====================================

PRPT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PCMM PRACTITIONERS

 +1       ;ASSIGNED TO A PATIENT computed finding. Return a list of

 +2       ;practitioners assigned to a patient.

 +3        NEW DATES,ERR,INCL,IND,LIST,RESULT

 +4        SET INCL=+$PIECE(TEST,U,1)

 +5        SET DATES("BEGIN")=BDT

           SET DATES("END")=EDT

           SET DATES("INCL")=INCL

 +6        SET RESULT=$$PRPT^SCAPMC(DFN,"DATES","","","","","LIST","ERR")

 +7        SET NFOUND=+$GET(LIST(0))

 +8        IF NFOUND=0

               QUIT 

 +9        FOR IND=1:1:NFOUND

               Begin DoDot:1

 +10               SET TEST(IND)=1

 +11               SET DATA(IND,"PROVIDER IEN")=$PIECE(LIST(IND),U,1)

 +12               SET DATA(IND,"PROVIDER")=$PIECE(LIST(IND),U,2)

 +13               SET DATA(IND,"POSITION")=$PIECE(LIST(IND),U,4)

 +14               SET (DATA(IND,"ACTIVATION DATE"),DATE(IND))=$PIECE(LIST(IND),U,9)

 +15               SET TEXT(IND)="Provider: "_DATA(IND,"PROVIDER")_"; Position: "_DATA(IND,"POSITION")

               End DoDot:1

 +16       QUIT 

 +17      ;

 +18      ;====================================

PTPR(NGET,BDT,EDT,PLIST,PARAM) ;VA-PCMM PATIENTS ASSIGNED TO A PRACTITIONER.

 +1       ;List type computed finding that returns a list of patients

 +2       ;assigned to a list of practitioners within a time period.

 +3        NEW DATES,ERR,INCL,IND,JND,LIST,NPAT,NPR,PRAC,PRACLIST,RESULT

 +4        KILL ^TMP($JOB,PLIST)

 +5        SET PRACLIST=$PIECE(PARAM,U,1)

 +6        SET INCL=+$PIECE(PARAM,U,2)

 +7        SET NPR=$LENGTH(PRACLIST,";")

 +8        SET DATES("BEGIN")=BDT

           SET DATES("END")=EDT

           SET DATES("INCL")=INCL

 +9        FOR IND=1:1:NPR

               Begin DoDot:1

 +10               SET PRAC=$PIECE(PRACLIST,";",IND)

 +11               SET PRAC=$$FIND1^DIC(200,,"ABX",PRAC,,,"MSG")

 +12               IF PRAC=0

                       QUIT 

 +13               KILL LIST

 +14               SET RESULT=$$PTPR^SCAPMC(PRAC,"DATES","","","LIST","ERR","")

 +15               SET NPAT=+$GET(LIST(0))

                   IF NPAT=0

                       QUIT 

 +16               FOR JND=1:1:NPAT

                       Begin DoDot:2

 +17                       SET DFN=$PIECE(LIST(JND),U,1)

 +18                       SET ^TMP($JOB,PLIST,DFN,1)=U_$PIECE(LIST(JND),U,4)_U_DFN_U_$PIECE(LIST(JND),U,2)

 +19                       SET ^TMP($JOB,PLIST,DFN,1,"VALUE")=DFN

                       End DoDot:2

               End DoDot:1

 +20       QUIT 

 +21      ;

 +22      ;====================================

PTTM(NGET,BDT,EDT,PLIST,PARAM) ;VA-PCMM PATIENTS ASSIGNED TO A TEAM

 +1       ;List type computed finding that returns a list of patients

 +2       ;assigned to a team for a time period.

 +3        NEW DATES,ERR,INCL,LIST,MSG,RESULT,TEAM

 +4        SET TEAM=$PIECE(PARAM,U,1)

 +5        SET TEAM=$$FIND1^DIC(404.51,,"ABX",TEAM,,,"MSG")

 +6        IF TEAM=0

               QUIT 

 +7        SET INCL=+$PIECE(PARAM,U,2)

 +8        SET DATES("BEGIN")=BDT

           SET DATES("END")=EDT

           SET DATES("INCL")=INCL

 +9       ;Return list in ^TMP.

 +10       SET RESULT=$$PTTM^SCAPMC(TEAM,"DATES","LIST","MSG")

 +11       KILL ^TMP($JOB,PLIST)

 +12       SET IND=0

 +13       FOR 

               SET IND=+$ORDER(LIST(IND))

               IF IND=0

                   QUIT 

               Begin DoDot:1

 +14               SET DFN=$PIECE(LIST(IND),U,1)

 +15               SET ^TMP($JOB,PLIST,DFN,1)=U_$PIECE(LIST(IND),U,4)_U_DFN_U_$PIECE(LIST(IND),U,2)

 +16               SET ^TMP($JOB,PLIST,DFN,1,"VALUE")=DFN

               End DoDot:1

 +17       QUIT 

 +18      ;