MHVXPAT ;WAS/DLF/KUM - Patient extract ; 9/25/08 4:11pm
;;1.0;My HealtheVet;**6,9,10,11**;Aug 23, 2005;Build 61
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
; Integration Agreements:
;
; 10060 : New Person file #200
; 1252 : OUTPTPR^SDUTL3
; 1916 : PTPR^SCAPMC
; PRPT^SCAPMC
; 3859 : GETAPPT^SDAMA201
; 4433 : $$SDAPI^SDAMA301
; 2692 : TEAMPTS^ORQPTQ1
; TMSPT^ORQPTQ1
; 10103 : $$DT^XLFDT
; $$NOW^XLFDT
; $$HL7TFM$XLFDT
;
PATCL(QRY,ERR,DATAROOT) ;Patients for clinic
;
; Primary Care Management Module interface
; return patient list in dataroot
; QRY, ERR passed by ref.
;
; Input:
; QRY - Query array
; QRY(CLIN IEN) - ien of Hospital location file (#44)
; DATAROOT - Root of array to hold extract data
;
; Output:
; DATAROOT - Populated data array
; includes number of hits and timestamp
; ERR - Errors during extraction, zero on success
;
N EXTIME,HIT,LOGND,FROMDT,TODT,RTN,X,ICN,SSN,CLINIEN
;
S RTN=$T(+0),LOGND=RTN_"^PTPCMP" ; node for logging
D LOG^MHVUL2(LOGND,"BEGIN","S","TRACE")
; needed vars.
S ERR=0,EXTIME=$$NOW^XLFDT,HIT=0
;
K @DATAROOT,^TMP(RTN,$J) ; clean up residue
;
I '$G(QRY("FROMDT")) S QRY("FROMDT")=2920101
I '$G(QRY("TODT")) S QRY("TODT")=DT
S FROMDT=$G(QRY("FROMDT"))
S TODT=$G(QRY("TODT"))
S CLINIEN=$G(QRY("IEN"))
I '(CLINIEN>0) S ERR="1^Clinic IEN missing" Q
; get all PCM patients for CLinic
D:'ERR
.N MHVDATES,J,RSLT,RSLTLST,SCER,TM,ICN,PTIEN,MHVARR,MHVSTAT
.K ^TMP($J,"SDAMA301")
.S MHVARR(1)=FROMDT_";"_TODT
.S MHVARR(2)=CLINIEN
.S MHVARR("FLDS")="4"
.S MHVARR("SORT")="P"
.S MHVSTAT=$$SDAPI^SDAMA301(.MHVARR)
.I MHVSTAT<0 D Q
.. S ERRTXT="",ERRNUM=0
.. S ERRNUM=$O(^TMP($J,"SDAMA301",ERRNUM))
.. S:ERRNUM'="" ERRTXT=$G(^TMP($J,"SDAMA301",ERRNUM))
.. S ERR="1^Appointment Extract Error: "_ERRNUM_";"_ERRTXT
.. K ^TMP($J,"SDAMA301")
.. Q
.I MHVSTAT>0 D
..;resort appts to ensure same patient can only be added to list once
..K ^TMP($J,"RE-SORT","SDAMA301")
..S (SDY,SDX)=0
..F S SDX=$O(^TMP($J,"SDAMA301",SDX)) Q:'SDX D
...S SDY=$O(^TMP($J,"SDAMA301",SDX,""))
...S ^TMP($J,"RE-SORT","SDAMA301",SDY,SDX)=""
..K ^TMP($J,"SDAMA301")
..K ^TMP($J,"EXCLPAT")
..S (SCDT,DFN)=0
..F S SCDT=$O(^TMP($J,"RE-SORT","SDAMA301",SCDT)) Q:'SCDT D
...F S DFN=$O(^TMP($J,"RE-SORT","SDAMA301",SCDT,DFN)) Q:'DFN D
....Q:$D(^TMP($J,"EXCLPAT",+DFN))
....S ICN=$$GET1^DIQ(2,DFN_",",991.01)
....S SSN=$$GET1^DIQ(2,DFN_",",.09)
....S HIT=HIT+1,@DATAROOT@(HIT)=DFN_U_""_U_$$GET1^DIQ(2,DFN_",",.01)_U_ICN_U_SSN
....S ^TMP($J,"EXCLPAT",+DFN)="Y"
;
S @DATAROOT=HIT_U_EXTIME ; hits ^ time
D XITLOG(LOGND,HIT)
;
Q
PATTM(QRY,ERR,DATAROOT) ;Patients for team
;
; Primary Care Management Module interface
; return patient list in dataroot
; QRY, ERR passed by ref.
;
; Input:
; QRY - Query array
; QRY(P1) - ien of OE/RR list file (#100.21)
; DATAROOT - Root of array to hold extract data
;
; Output:
; DATAROOT - Populated data array
; includes number of hits and timestamp
; ERR - Errors during extraction, zero on success
;
N EXTIME,HIT,LOGND,TEAMIEN,RTN,X,ICN,SSN
;
S RTN=$T(+0),LOGND=RTN_"^PATTM" ; node for logging
D LOG^MHVUL2(LOGND,"BEGIN","S","TRACE")
; needed vars.
S ERR=0,EXTIME=$$NOW^XLFDT,HIT=0
;
K @DATAROOT,^TMP(RTN,$J) ; clean up residue
;
S TEAMIEN=$G(QRY("IEN"))
I '(TEAMIEN>0) S ERR="1^Team IEN missing" Q
; get all patients for Team
N MHVDATES,J,RSLT,RSLTLST,TM,PTIEN,ICN
S RSLTLST=$NA(^TMP(RTN,$J,"PTTM"))
S RSLTLST=$E(RSLTLST,1,$L(RSLTLST)-1)_","
D TEAMPTS^ORQPTQ1(RSLTLST,TEAMIEN,1)
Q:^TMP(RTN,$J,"PTTM",1)["No patients"
; now save results
S J=0
F S J=$O(^TMP(RTN,$J,"PTTM",J)) Q:'J S TM=$G(^TMP(RTN,$J,"PTTM",J)) D
.S PTIEN=$P(TM,U,1)
.S ICN=$$GET1^DIQ(2,PTIEN_",",991.01)
.S SSN=$$GET1^DIQ(2,PTIEN_",",.09)
.S HIT=HIT+1,@DATAROOT@(HIT)=PTIEN_U_""_U_$P(TM,U,2)_U_ICN_U_SSN
;
S @DATAROOT=HIT_U_EXTIME ; hits ^ time
D XITLOG(LOGND,HIT)
;
Q
PTPCMP(QRY,ERR,DATAROOT) ; patients for PCMM provider
; Primary Care Management Module interface
; return patient data in DATAROOT
; QRY, ERR passed by ref.
;
; Input:
; QRY - Query array
; QRY("PRVDR IEN") - ien NEW PERSON file (#200)
; DATAROOT - Root of array to hold extract data
;
; Output:
; DATAROOT - Populated data array
; includes number of hits and timestamp
; ERR - Errors during extraction, zero on success
;
N EXTIME,HIT,LOGND,PRVIEN,RTN,X,ICN,SSN
;
S RTN=$T(+0),LOGND=RTN_"^PTPCMP" ; node for logging
D LOG^MHVUL2(LOGND,"BEGIN","S","TRACE")
; needed vars.
S ERR=0,EXTIME=$$NOW^XLFDT,HIT=0
;
K @DATAROOT,^TMP(RTN,$J) ; clean up residue
;
S PRVIEN=$G(QRY("IEN"))
I '(PRVIEN>0) S ERR="1^provider IEN missing" Q
;
;
; get all PCM patients for provider
D:'ERR
.N MHVDATES,J,RSLT,RSLTLST,SCER,TM,PTIEN,ICN
.S RSLTLST=$NA(^TMP(RTN,$J,"PRVDR"))
.S MHVDATES("BEGIN")="",MHVDATES("END")=DT ; only for today
.S MHVDATES("INCL")=1 ; include all
.S RSLT=$$PTPR^SCAPMC(PRVIEN,.MHVDATES,"","",RSLTLST,"SCER","")
.I $G(SCER(0)) D Q
..S ERR="1^errors ("_SCER(0)_") returned by PTPR^SCAPMC"
.; now save results
.S J=0
.F S J=$O(^TMP(RTN,$J,"PRVDR",J)) Q:'J S TM=$G(^TMP(RTN,$J,"PRVDR",J)) D
..S PTIEN=$P(TM,U,1)
..S ICN=$$GET1^DIQ(2,PTIEN_",",991.01)
..S SSN=$$GET1^DIQ(2,PTIEN_",",.09)
..S HIT=HIT+1,@DATAROOT@(HIT)=PTIEN_U_""_U_$P(TM,U,2)_U_ICN_U_SSN
;
S @DATAROOT=HIT_U_EXTIME ; hits ^ time
D XITLOG(LOGND,HIT)
;
Q
PTREL(QRY,ERR,DATAROOT) ; patient relationships
; Primary Care Management Module interface
; return patient data in DATAROOT
; QRY, ERR passed by ref.
;
; Input:
; QRY - Query array
; QRY("IEN") - Patient
; QRY("FROMDT") - Begin date
; QRY("TODT") - End Date
;
; DATAROOT - Root of array to hold extract data
;
; Output:
; DATAROOT - Populated data array
; includes number of hits and timestamp
; ERR - Errors during extraction, zero on success
;
N EXTIME,HIT,THIT,LOGND,PRVIEN,RTN,X,MHVTEAMS,PATIEN,SCTEAMA
N SCPOSA,SCUSRA,SCROLEA,SCPURPA,SCER,FROMDT,TODT
N PPHONE,SSECTION,PTYPE,TYPE,REC
;
S RTN=$T(+0),LOGND=RTN_"^PTREL" ; node for logging
D LOG^MHVUL2(LOGND,"BEGIN","S","TRACE")
; needed vars.
S ERR=0,EXTIME=$$NOW^XLFDT,HIT=0
;
K @DATAROOT,^TMP(RTN,$J) ; clean up residue
;
S PATIEN=$G(QRY("IEN"))
I '(PATIEN>0) S ERR="1^patient IEN missing" Q
;
;
; get all clinics, providers and PCMM TEAMS for the patient
; in the date range
;
Q:ERR
;
N MHVDATES,CLID,J,RSLT,RSLTLST,SCER,TM,PATIEN
S RSLTLST=$NA(^TMP(RTN,$J,"CLINICS"))
I '$G(QRY("FROMDT")) S QRY("FROMDT")=2920101
I '$G(QRY("TODT")) S QRY("TODT")=DT
S MHVDATES("BEGIN")=QRY("FROMDT")
S MHVDATES("END")=QRY("TODT")
S PATIEN=QRY("IEN")
;
;Load Clinics
;
D GETAPPT^SDAMA201(PATIEN,"1;2","R;NT",QRY("FROMDT"),QRY("TODT"),"")
I $D(^TMP($J,"SDAMA201","GETAPPT","ERROR")) D Q
.S ERR="",ERR=$O(^TMP($J,"SDAMA201","GETAPPT","ERROR",ERR))
.S ERR="1^"_^TMP($J,"SDAMA201","GETAPPT","ERROR",ERR)
S REC=""
F S REC=$O(^TMP($J,"SDAMA201","GETAPPT",REC)) Q:REC="" D
.S CLID=$P(^TMP($J,"SDAMA201","GETAPPT",REC,2),"^",1)
.Q:$D(^TMP($J,"CLFND",CLID))
.S @RSLTLST@(REC)=$P(^TMP($J,"SDAMA201","GETAPPT",REC,2),"^",1,2)
.S ^TMP($J,"CLFND",CLID)=""
S @RSLTLST@(0)=REC
K ^TMP($J,"SDAMA201"),^TMP($J,"CLFND")
;
;Load MHVTEAMS
;
D TMSPT^ORQPTQ1(.MHVTEAMS,PATIEN)
I MHVTEAMS(1)["No teams" K MHVTEAMS(1)
M ^TMP("MHVXPAT",$J,"TEAMS")=MHVTEAMS
;
;Load Providers
S RSLTLST=$NA(^TMP(RTN,$J,"PROVIDERS"))
;S (SCPOSA,SCUSRA,SCROLEA,SCPURPA,SCER)=""
;S X=$$PRPT^SCAPMC(PATIEN,.MHVDATES,SCPOSA,SCUSRA,SCROLEA,SCPURPA,RSLTLST,SCER)
;
S X=$$OUTPTPR^SDUTL3(PATIEN) ;MHV*1*9 Always return PC
I +X D
.S ^TMP(RTN,$J,"PROVIDERS",0)=""
.S ^TMP(RTN,$J,"PROVIDERS",1)=X
.S $P(^TMP(RTN,$J,"PROVIDERS",1),U,8)="PHYSICIAN-PRIMARY CARE"
; now save results
;
N MHVHDAT
S MHVHDAT=DATAROOT
S THIT=0
F TYPE="CLINICS","PROVIDERS","TEAMS" D
.S J=0
.S HIT=0
.F S J=$O(^TMP(RTN,$J,TYPE,J)) Q:'J S TM=$G(^TMP(RTN,$J,TYPE,J)) D
..S HIT=HIT+1,THIT=THIT+1,@DATAROOT@(TYPE,HIT)=$P(TM,U)_"^"_$P(TM,U,2)
..I TYPE="PROVIDERS" D
...S PPHONE=$$GET1^DIQ(200,$P(TM,U)_",",.132)
...S SSECTION=$$GET1^DIQ(200,$P(TM,U)_",",29)
...S PTYPE=$P(TM,U,8)
...S @DATAROOT@(TYPE,HIT)=@DATAROOT@(TYPE,HIT)_"^"_PTYPE
...S @DATAROOT@(TYPE,HIT)=@DATAROOT@(TYPE,HIT)_"^^^^"_PPHONE_"^"_SSECTION
S @DATAROOT=THIT_U_EXTIME ; hits ^ time
D XITLOG(LOGND,HIT)
Q
;
XITLOG(ND,HT) ; exit log
D LOG^MHVUL2(ND,HT_" HITS","S","TRACE")
D LOG^MHVUL2(ND,"END","S","TRACE") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVXPAT 9189 printed Sep 23, 2025@19:52:14 Page 2
MHVXPAT ;WAS/DLF/KUM - Patient extract ; 9/25/08 4:11pm
+1 ;;1.0;My HealtheVet;**6,9,10,11**;Aug 23, 2005;Build 61
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Integration Agreements:
+7 ;
+8 ; 10060 : New Person file #200
+9 ; 1252 : OUTPTPR^SDUTL3
+10 ; 1916 : PTPR^SCAPMC
+11 ; PRPT^SCAPMC
+12 ; 3859 : GETAPPT^SDAMA201
+13 ; 4433 : $$SDAPI^SDAMA301
+14 ; 2692 : TEAMPTS^ORQPTQ1
+15 ; TMSPT^ORQPTQ1
+16 ; 10103 : $$DT^XLFDT
+17 ; $$NOW^XLFDT
+18 ; $$HL7TFM$XLFDT
+19 ;
PATCL(QRY,ERR,DATAROOT) ;Patients for clinic
+1 ;
+2 ; Primary Care Management Module interface
+3 ; return patient list in dataroot
+4 ; QRY, ERR passed by ref.
+5 ;
+6 ; Input:
+7 ; QRY - Query array
+8 ; QRY(CLIN IEN) - ien of Hospital location file (#44)
+9 ; DATAROOT - Root of array to hold extract data
+10 ;
+11 ; Output:
+12 ; DATAROOT - Populated data array
+13 ; includes number of hits and timestamp
+14 ; ERR - Errors during extraction, zero on success
+15 ;
+16 NEW EXTIME,HIT,LOGND,FROMDT,TODT,RTN,X,ICN,SSN,CLINIEN
+17 ;
+18 ; node for logging
SET RTN=$TEXT(+0)
SET LOGND=RTN_"^PTPCMP"
+19 DO LOG^MHVUL2(LOGND,"BEGIN","S","TRACE")
+20 ; needed vars.
+21 SET ERR=0
SET EXTIME=$$NOW^XLFDT
SET HIT=0
+22 ;
+23 ; clean up residue
KILL @DATAROOT,^TMP(RTN,$JOB)
+24 ;
+25 IF '$GET(QRY("FROMDT"))
SET QRY("FROMDT")=2920101
+26 IF '$GET(QRY("TODT"))
SET QRY("TODT")=DT
+27 SET FROMDT=$GET(QRY("FROMDT"))
+28 SET TODT=$GET(QRY("TODT"))
+29 SET CLINIEN=$GET(QRY("IEN"))
+30 IF '(CLINIEN>0)
SET ERR="1^Clinic IEN missing"
QUIT
+31 ; get all PCM patients for CLinic
+32 if 'ERR
Begin DoDot:1
+33 NEW MHVDATES,J,RSLT,RSLTLST,SCER,TM,ICN,PTIEN,MHVARR,MHVSTAT
+34 KILL ^TMP($JOB,"SDAMA301")
+35 SET MHVARR(1)=FROMDT_";"_TODT
+36 SET MHVARR(2)=CLINIEN
+37 SET MHVARR("FLDS")="4"
+38 SET MHVARR("SORT")="P"
+39 SET MHVSTAT=$$SDAPI^SDAMA301(.MHVARR)
+40 IF MHVSTAT<0
Begin DoDot:2
+41 SET ERRTXT=""
SET ERRNUM=0
+42 SET ERRNUM=$ORDER(^TMP($JOB,"SDAMA301",ERRNUM))
+43 if ERRNUM'=""
SET ERRTXT=$GET(^TMP($JOB,"SDAMA301",ERRNUM))
+44 SET ERR="1^Appointment Extract Error: "_ERRNUM_";"_ERRTXT
+45 KILL ^TMP($JOB,"SDAMA301")
+46 QUIT
End DoDot:2
QUIT
+47 IF MHVSTAT>0
Begin DoDot:2
+48 ;resort appts to ensure same patient can only be added to list once
+49 KILL ^TMP($JOB,"RE-SORT","SDAMA301")
+50 SET (SDY,SDX)=0
+51 FOR
SET SDX=$ORDER(^TMP($JOB,"SDAMA301",SDX))
if 'SDX
QUIT
Begin DoDot:3
+52 SET SDY=$ORDER(^TMP($JOB,"SDAMA301",SDX,""))
+53 SET ^TMP($JOB,"RE-SORT","SDAMA301",SDY,SDX)=""
End DoDot:3
+54 KILL ^TMP($JOB,"SDAMA301")
+55 KILL ^TMP($JOB,"EXCLPAT")
+56 SET (SCDT,DFN)=0
+57 FOR
SET SCDT=$ORDER(^TMP($JOB,"RE-SORT","SDAMA301",SCDT))
if 'SCDT
QUIT
Begin DoDot:3
+58 FOR
SET DFN=$ORDER(^TMP($JOB,"RE-SORT","SDAMA301",SCDT,DFN))
if 'DFN
QUIT
Begin DoDot:4
+59 if $DATA(^TMP($JOB,"EXCLPAT",+DFN))
QUIT
+60 SET ICN=$$GET1^DIQ(2,DFN_",",991.01)
+61 SET SSN=$$GET1^DIQ(2,DFN_",",.09)
+62 SET HIT=HIT+1
SET @DATAROOT@(HIT)=DFN_U_""_U_$$GET1^DIQ(2,DFN_",",.01)_U_ICN_U_SSN
+63 SET ^TMP($JOB,"EXCLPAT",+DFN)="Y"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+64 ;
+65 ; hits ^ time
SET @DATAROOT=HIT_U_EXTIME
+66 DO XITLOG(LOGND,HIT)
+67 ;
+68 QUIT
PATTM(QRY,ERR,DATAROOT) ;Patients for team
+1 ;
+2 ; Primary Care Management Module interface
+3 ; return patient list in dataroot
+4 ; QRY, ERR passed by ref.
+5 ;
+6 ; Input:
+7 ; QRY - Query array
+8 ; QRY(P1) - ien of OE/RR list file (#100.21)
+9 ; DATAROOT - Root of array to hold extract data
+10 ;
+11 ; Output:
+12 ; DATAROOT - Populated data array
+13 ; includes number of hits and timestamp
+14 ; ERR - Errors during extraction, zero on success
+15 ;
+16 NEW EXTIME,HIT,LOGND,TEAMIEN,RTN,X,ICN,SSN
+17 ;
+18 ; node for logging
SET RTN=$TEXT(+0)
SET LOGND=RTN_"^PATTM"
+19 DO LOG^MHVUL2(LOGND,"BEGIN","S","TRACE")
+20 ; needed vars.
+21 SET ERR=0
SET EXTIME=$$NOW^XLFDT
SET HIT=0
+22 ;
+23 ; clean up residue
KILL @DATAROOT,^TMP(RTN,$JOB)
+24 ;
+25 SET TEAMIEN=$GET(QRY("IEN"))
+26 IF '(TEAMIEN>0)
SET ERR="1^Team IEN missing"
QUIT
+27 ; get all patients for Team
+28 NEW MHVDATES,J,RSLT,RSLTLST,TM,PTIEN,ICN
+29 SET RSLTLST=$NAME(^TMP(RTN,$JOB,"PTTM"))
+30 SET RSLTLST=$EXTRACT(RSLTLST,1,$LENGTH(RSLTLST)-1)_","
+31 DO TEAMPTS^ORQPTQ1(RSLTLST,TEAMIEN,1)
+32 if ^TMP(RTN,$JOB,"PTTM",1)["No patients"
QUIT
+33 ; now save results
+34 SET J=0
+35 FOR
SET J=$ORDER(^TMP(RTN,$JOB,"PTTM",J))
if 'J
QUIT
SET TM=$GET(^TMP(RTN,$JOB,"PTTM",J))
Begin DoDot:1
+36 SET PTIEN=$PIECE(TM,U,1)
+37 SET ICN=$$GET1^DIQ(2,PTIEN_",",991.01)
+38 SET SSN=$$GET1^DIQ(2,PTIEN_",",.09)
+39 SET HIT=HIT+1
SET @DATAROOT@(HIT)=PTIEN_U_""_U_$PIECE(TM,U,2)_U_ICN_U_SSN
End DoDot:1
+40 ;
+41 ; hits ^ time
SET @DATAROOT=HIT_U_EXTIME
+42 DO XITLOG(LOGND,HIT)
+43 ;
+44 QUIT
PTPCMP(QRY,ERR,DATAROOT) ; patients for PCMM provider
+1 ; Primary Care Management Module interface
+2 ; return patient data in DATAROOT
+3 ; QRY, ERR passed by ref.
+4 ;
+5 ; Input:
+6 ; QRY - Query array
+7 ; QRY("PRVDR IEN") - ien NEW PERSON file (#200)
+8 ; DATAROOT - Root of array to hold extract data
+9 ;
+10 ; Output:
+11 ; DATAROOT - Populated data array
+12 ; includes number of hits and timestamp
+13 ; ERR - Errors during extraction, zero on success
+14 ;
+15 NEW EXTIME,HIT,LOGND,PRVIEN,RTN,X,ICN,SSN
+16 ;
+17 ; node for logging
SET RTN=$TEXT(+0)
SET LOGND=RTN_"^PTPCMP"
+18 DO LOG^MHVUL2(LOGND,"BEGIN","S","TRACE")
+19 ; needed vars.
+20 SET ERR=0
SET EXTIME=$$NOW^XLFDT
SET HIT=0
+21 ;
+22 ; clean up residue
KILL @DATAROOT,^TMP(RTN,$JOB)
+23 ;
+24 SET PRVIEN=$GET(QRY("IEN"))
+25 IF '(PRVIEN>0)
SET ERR="1^provider IEN missing"
QUIT
+26 ;
+27 ;
+28 ; get all PCM patients for provider
+29 if 'ERR
Begin DoDot:1
+30 NEW MHVDATES,J,RSLT,RSLTLST,SCER,TM,PTIEN,ICN
+31 SET RSLTLST=$NAME(^TMP(RTN,$JOB,"PRVDR"))
+32 ; only for today
SET MHVDATES("BEGIN")=""
SET MHVDATES("END")=DT
+33 ; include all
SET MHVDATES("INCL")=1
+34 SET RSLT=$$PTPR^SCAPMC(PRVIEN,.MHVDATES,"","",RSLTLST,"SCER","")
+35 IF $GET(SCER(0))
Begin DoDot:2
+36 SET ERR="1^errors ("_SCER(0)_") returned by PTPR^SCAPMC"
End DoDot:2
QUIT
+37 ; now save results
+38 SET J=0
+39 FOR
SET J=$ORDER(^TMP(RTN,$JOB,"PRVDR",J))
if 'J
QUIT
SET TM=$GET(^TMP(RTN,$JOB,"PRVDR",J))
Begin DoDot:2
+40 SET PTIEN=$PIECE(TM,U,1)
+41 SET ICN=$$GET1^DIQ(2,PTIEN_",",991.01)
+42 SET SSN=$$GET1^DIQ(2,PTIEN_",",.09)
+43 SET HIT=HIT+1
SET @DATAROOT@(HIT)=PTIEN_U_""_U_$PIECE(TM,U,2)_U_ICN_U_SSN
End DoDot:2
End DoDot:1
+44 ;
+45 ; hits ^ time
SET @DATAROOT=HIT_U_EXTIME
+46 DO XITLOG(LOGND,HIT)
+47 ;
+48 QUIT
PTREL(QRY,ERR,DATAROOT) ; patient relationships
+1 ; Primary Care Management Module interface
+2 ; return patient data in DATAROOT
+3 ; QRY, ERR passed by ref.
+4 ;
+5 ; Input:
+6 ; QRY - Query array
+7 ; QRY("IEN") - Patient
+8 ; QRY("FROMDT") - Begin date
+9 ; QRY("TODT") - End Date
+10 ;
+11 ; DATAROOT - Root of array to hold extract data
+12 ;
+13 ; Output:
+14 ; DATAROOT - Populated data array
+15 ; includes number of hits and timestamp
+16 ; ERR - Errors during extraction, zero on success
+17 ;
+18 NEW EXTIME,HIT,THIT,LOGND,PRVIEN,RTN,X,MHVTEAMS,PATIEN,SCTEAMA
+19 NEW SCPOSA,SCUSRA,SCROLEA,SCPURPA,SCER,FROMDT,TODT
+20 NEW PPHONE,SSECTION,PTYPE,TYPE,REC
+21 ;
+22 ; node for logging
SET RTN=$TEXT(+0)
SET LOGND=RTN_"^PTREL"
+23 DO LOG^MHVUL2(LOGND,"BEGIN","S","TRACE")
+24 ; needed vars.
+25 SET ERR=0
SET EXTIME=$$NOW^XLFDT
SET HIT=0
+26 ;
+27 ; clean up residue
KILL @DATAROOT,^TMP(RTN,$JOB)
+28 ;
+29 SET PATIEN=$GET(QRY("IEN"))
+30 IF '(PATIEN>0)
SET ERR="1^patient IEN missing"
QUIT
+31 ;
+32 ;
+33 ; get all clinics, providers and PCMM TEAMS for the patient
+34 ; in the date range
+35 ;
+36 if ERR
QUIT
+37 ;
+38 NEW MHVDATES,CLID,J,RSLT,RSLTLST,SCER,TM,PATIEN
+39 SET RSLTLST=$NAME(^TMP(RTN,$JOB,"CLINICS"))
+40 IF '$GET(QRY("FROMDT"))
SET QRY("FROMDT")=2920101
+41 IF '$GET(QRY("TODT"))
SET QRY("TODT")=DT
+42 SET MHVDATES("BEGIN")=QRY("FROMDT")
+43 SET MHVDATES("END")=QRY("TODT")
+44 SET PATIEN=QRY("IEN")
+45 ;
+46 ;Load Clinics
+47 ;
+48 DO GETAPPT^SDAMA201(PATIEN,"1;2","R;NT",QRY("FROMDT"),QRY("TODT"),"")
+49 IF $DATA(^TMP($JOB,"SDAMA201","GETAPPT","ERROR"))
Begin DoDot:1
+50 SET ERR=""
SET ERR=$ORDER(^TMP($JOB,"SDAMA201","GETAPPT","ERROR",ERR))
+51 SET ERR="1^"_^TMP($JOB,"SDAMA201","GETAPPT","ERROR",ERR)
End DoDot:1
QUIT
+52 SET REC=""
+53 FOR
SET REC=$ORDER(^TMP($JOB,"SDAMA201","GETAPPT",REC))
if REC=""
QUIT
Begin DoDot:1
+54 SET CLID=$PIECE(^TMP($JOB,"SDAMA201","GETAPPT",REC,2),"^",1)
+55 if $DATA(^TMP($JOB,"CLFND",CLID))
QUIT
+56 SET @RSLTLST@(REC)=$PIECE(^TMP($JOB,"SDAMA201","GETAPPT",REC,2),"^",1,2)
+57 SET ^TMP($JOB,"CLFND",CLID)=""
End DoDot:1
+58 SET @RSLTLST@(0)=REC
+59 KILL ^TMP($JOB,"SDAMA201"),^TMP($JOB,"CLFND")
+60 ;
+61 ;Load MHVTEAMS
+62 ;
+63 DO TMSPT^ORQPTQ1(.MHVTEAMS,PATIEN)
+64 IF MHVTEAMS(1)["No teams"
KILL MHVTEAMS(1)
+65 MERGE ^TMP("MHVXPAT",$JOB,"TEAMS")=MHVTEAMS
+66 ;
+67 ;Load Providers
+68 SET RSLTLST=$NAME(^TMP(RTN,$JOB,"PROVIDERS"))
+69 ;S (SCPOSA,SCUSRA,SCROLEA,SCPURPA,SCER)=""
+70 ;S X=$$PRPT^SCAPMC(PATIEN,.MHVDATES,SCPOSA,SCUSRA,SCROLEA,SCPURPA,RSLTLST,SCER)
+71 ;
+72 ;MHV*1*9 Always return PC
SET X=$$OUTPTPR^SDUTL3(PATIEN)
+73 IF +X
Begin DoDot:1
+74 SET ^TMP(RTN,$JOB,"PROVIDERS",0)=""
+75 SET ^TMP(RTN,$JOB,"PROVIDERS",1)=X
+76 SET $PIECE(^TMP(RTN,$JOB,"PROVIDERS",1),U,8)="PHYSICIAN-PRIMARY CARE"
End DoDot:1
+77 ; now save results
+78 ;
+79 NEW MHVHDAT
+80 SET MHVHDAT=DATAROOT
+81 SET THIT=0
+82 FOR TYPE="CLINICS","PROVIDERS","TEAMS"
Begin DoDot:1
+83 SET J=0
+84 SET HIT=0
+85 FOR
SET J=$ORDER(^TMP(RTN,$JOB,TYPE,J))
if 'J
QUIT
SET TM=$GET(^TMP(RTN,$JOB,TYPE,J))
Begin DoDot:2
+86 SET HIT=HIT+1
SET THIT=THIT+1
SET @DATAROOT@(TYPE,HIT)=$PIECE(TM,U)_"^"_$PIECE(TM,U,2)
+87 IF TYPE="PROVIDERS"
Begin DoDot:3
+88 SET PPHONE=$$GET1^DIQ(200,$PIECE(TM,U)_",",.132)
+89 SET SSECTION=$$GET1^DIQ(200,$PIECE(TM,U)_",",29)
+90 SET PTYPE=$PIECE(TM,U,8)
+91 SET @DATAROOT@(TYPE,HIT)=@DATAROOT@(TYPE,HIT)_"^"_PTYPE
+92 SET @DATAROOT@(TYPE,HIT)=@DATAROOT@(TYPE,HIT)_"^^^^"_PPHONE_"^"_SSECTION
End DoDot:3
End DoDot:2
End DoDot:1
+93 ; hits ^ time
SET @DATAROOT=THIT_U_EXTIME
+94 DO XITLOG(LOGND,HIT)
+95 QUIT
+96 ;
XITLOG(ND,HT) ; exit log
+1 DO LOG^MHVUL2(ND,HT_" HITS","S","TRACE")
+2 DO LOG^MHVUL2(ND,"END","S","TRACE")
QUIT
