MHVXPRV ;WAS/DLF - Provider extract ; 9/25/08 4:11pm
;;1.0;My HealtheVet;**6,29**;July 10, 2017;Build 73
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
; Integration Agreements:
; 5250 : TPPR^SCAPMC
; 10103 : $$DT^XLFDT
; $$NOW^XLFDT
; 10060 : New Person File #200
; 10076 : ^XUSEC
;
;
;
CMMPRV(QRY,ERR,DATAROOT) ; return PCMM providers
;
; Primary Care Management Module interface
; return provider data in DATAROOT
; QRY, ERR passed by ref.
;
; Input:
; QRY - Query array
; ERR - Variable to hold error conditions
; 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
;
;
D LOG^MHVUL2("CMMPRV~MHVXPRV","BEGIN","S","TRACE")
;
K @DATAROOT,^TMP("MHVXPRV",$J) ; clean up residue
;
; get all PCMM providers for facility, no exclusion
;
N NXT,IIEN,NODE,TEAM,OUT
N DT,EXTIME,HIT,LOGND,RTN,U,X
N PRNAME,PRFNAME,PROLE,PRIEN
;
;
S NXT=0,IIEN=0
S U="^",DT=$$DT^XLFDT,ERR=0,EXTIME=$$NOW^XLFDT,HIT=0
;
I QRY("IEN")="" D ; no IEN, check PROVIDER key holders
.S PRIEN=""
.F S PRIEN=$O(^XUSEC("PROVIDER",PRIEN)) Q:PRIEN="" D PRVCHK(PRIEN)
;
; otherwise, check one match
;===================================================================
;E D
;JAZZ Story#409966-VistA Patch 29
;Defect: 504782-Fix PCMM Flag showing for users with NOPTOVIDER KEY
;===================================================================
E D:+$D(^XUSEC("PROVIDER",(QRY("IEN"))))
.D PRVCHK(QRY("IEN"))
;
S @DATAROOT=HIT_U_EXTIME ; count of hits ^ time
D LOG^MHVUL2("CMMPRV~MHVXPRV",HIT_" HITS","S","TRACE")
D LOG^MHVUL2("CMMPRV~MHVXPRV","END","S","TRACE")
Q
;
PRVCHK(PRIEN) ; if provider has roles and matches name paramter,add to the
; list to send back
;
N DIERR,PRVOUT,MHVDATES,MHVPURPA,MHVROLEA,MHVERR,MHVLIST,MHVRLS
N PHNE,SECTN
S MHVDATES("BEGIN")="",MHVDATES("END")=""
S MHVDATES("INCL")=0
S (MHVPURPA,MHVROLEA,MHVERR)=""
S X=$$TPPR^SCAPMC(PRIEN,.MHVDATES,MHVPURPA,MHVROLEA,"MHVRLS",MHVERR)
;
;If there are no roles, this person is not a pcmm provider
;
Q:'$D(MHVRLS)
;
S PROLE=$P(MHVRLS(1),"^",8)
D GETS^DIQ(200,PRIEN_",",".01;.132;29","E","PRVOUT","DIERR")
Q:$G(DIERR)
S PRNAME=$G(PRVOUT(200,PRIEN_",",.01,"E"))
S PRFNAME=$P(PRNAME,",",2)
Q:$E(PRNAME,1,$L(QRY("LNAME")))'=QRY("LNAME")
Q:$E(PRFNAME,1,$L(QRY("FNAME")))'=QRY("FNAME")
S PHNE=$G(PRVOUT(200,PRIEN_",",.132,"E"))
S SECTN=$G(PRVOUT(200,PRIEN_",",.29,"E"))
S HIT=HIT+1
S @DATAROOT@(HIT)=PRIEN_"^"_PRNAME_"^"_PROLE_"^^^^"_PHNE_"^"_SECTN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVXPRV 2843 printed Apr 09, 2024@21:18:16 Page 2
MHVXPRV ;WAS/DLF - Provider extract ; 9/25/08 4:11pm
+1 ;;1.0;My HealtheVet;**6,29**;July 10, 2017;Build 73
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Integration Agreements:
+7 ; 5250 : TPPR^SCAPMC
+8 ; 10103 : $$DT^XLFDT
+9 ; $$NOW^XLFDT
+10 ; 10060 : New Person File #200
+11 ; 10076 : ^XUSEC
+12 ;
+13 ;
+14 ;
CMMPRV(QRY,ERR,DATAROOT) ; return PCMM providers
+1 ;
+2 ; Primary Care Management Module interface
+3 ; return provider data in DATAROOT
+4 ; QRY, ERR passed by ref.
+5 ;
+6 ; Input:
+7 ; QRY - Query array
+8 ; ERR - Variable to hold error conditions
+9 ; DATAROOT - Root of array to hold extract data
+10 ; Output:
+11 ; DATAROOT - Populated data array
+12 ; includes number of hits and timestamp
+13 ; ERR - Errors during extraction, zero on success
+14 ;
+15 ;
+16 DO LOG^MHVUL2("CMMPRV~MHVXPRV","BEGIN","S","TRACE")
+17 ;
+18 ; clean up residue
KILL @DATAROOT,^TMP("MHVXPRV",$JOB)
+19 ;
+20 ; get all PCMM providers for facility, no exclusion
+21 ;
+22 NEW NXT,IIEN,NODE,TEAM,OUT
+23 NEW DT,EXTIME,HIT,LOGND,RTN,U,X
+24 NEW PRNAME,PRFNAME,PROLE,PRIEN
+25 ;
+26 ;
+27 SET NXT=0
SET IIEN=0
+28 SET U="^"
SET DT=$$DT^XLFDT
SET ERR=0
SET EXTIME=$$NOW^XLFDT
SET HIT=0
+29 ;
+30 ; no IEN, check PROVIDER key holders
IF QRY("IEN")=""
Begin DoDot:1
+31 SET PRIEN=""
+32 FOR
SET PRIEN=$ORDER(^XUSEC("PROVIDER",PRIEN))
if PRIEN=""
QUIT
DO PRVCHK(PRIEN)
End DoDot:1
+33 ;
+34 ; otherwise, check one match
+35 ;===================================================================
+36 ;E D
+37 ;JAZZ Story#409966-VistA Patch 29
+38 ;Defect: 504782-Fix PCMM Flag showing for users with NOPTOVIDER KEY
+39 ;===================================================================
+40 IF '$TEST
if +$DATA(^XUSEC("PROVIDER",(QRY("IEN"))))
Begin DoDot:1
+41 DO PRVCHK(QRY("IEN"))
End DoDot:1
+42 ;
+43 ; count of hits ^ time
SET @DATAROOT=HIT_U_EXTIME
+44 DO LOG^MHVUL2("CMMPRV~MHVXPRV",HIT_" HITS","S","TRACE")
+45 DO LOG^MHVUL2("CMMPRV~MHVXPRV","END","S","TRACE")
+46 QUIT
+47 ;
PRVCHK(PRIEN) ; if provider has roles and matches name paramter,add to the
+1 ; list to send back
+2 ;
+3 NEW DIERR,PRVOUT,MHVDATES,MHVPURPA,MHVROLEA,MHVERR,MHVLIST,MHVRLS
+4 NEW PHNE,SECTN
+5 SET MHVDATES("BEGIN")=""
SET MHVDATES("END")=""
+6 SET MHVDATES("INCL")=0
+7 SET (MHVPURPA,MHVROLEA,MHVERR)=""
+8 SET X=$$TPPR^SCAPMC(PRIEN,.MHVDATES,MHVPURPA,MHVROLEA,"MHVRLS",MHVERR)
+9 ;
+10 ;If there are no roles, this person is not a pcmm provider
+11 ;
+12 if '$DATA(MHVRLS)
QUIT
+13 ;
+14 SET PROLE=$PIECE(MHVRLS(1),"^",8)
+15 DO GETS^DIQ(200,PRIEN_",",".01;.132;29","E","PRVOUT","DIERR")
+16 if $GET(DIERR)
QUIT
+17 SET PRNAME=$GET(PRVOUT(200,PRIEN_",",.01,"E"))
+18 SET PRFNAME=$PIECE(PRNAME,",",2)
+19 if $EXTRACT(PRNAME,1,$LENGTH(QRY("LNAME")))'=QRY("LNAME")
QUIT
+20 if $EXTRACT(PRFNAME,1,$LENGTH(QRY("FNAME")))'=QRY("FNAME")
QUIT
+21 SET PHNE=$GET(PRVOUT(200,PRIEN_",",.132,"E"))
+22 SET SECTN=$GET(PRVOUT(200,PRIEN_",",.29,"E"))
+23 SET HIT=HIT+1
+24 SET @DATAROOT@(HIT)=PRIEN_"^"_PRNAME_"^"_PROLE_"^^^^"_PHNE_"^"_SECTN
+25 QUIT
