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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPCMM 3793 printed Dec 13, 2024@01:48:24 Page 2
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 ;
