Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXBGPRV

PXBGPRV.m

Go to the documentation of this file.
  1. PXBGPRV ;ISL/JVS,ESW - GATHER PROVIDERS ;11/22/2019
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,108,186,220,211**;Aug 12, 1996;Build 454
  1. ;
  1. PRV(VISIT,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI) ;--Gather the entries in the V PROVIDER file
  1. ;
  1. ;Output:
  1. ; PXBSKY(PXBC,IEN)=PRVI
  1. ; PXBKY(NAME,PXBC)=NAME^P^TYPE^PRVI
  1. ; PXBSAM(PXBC)=NAME^P^TYPE^PRVI
  1. ; PRVDR("PRIMARY")=NAME^IEN^PRVI
  1. ; PXBCNT
  1. ; FPRI
  1. ;where:
  1. ; PXBC - sequence in an order of providers name
  1. ; IEN - of ^AUPNVPRV(
  1. ; NAME - provider's name (LAST,FIRST...)
  1. ; P - PRIMARY or SECONDARY
  1. ; PRVI - IEN of ^VA(200,
  1. ; PXBCNT - provider count
  1. ; FPRI:
  1. ; 0 - Primary not selected
  1. ; 1 - Primary selected
  1. ;
  1. N IEN,QUANTITY,PROVIDER,PRIMARY,PRV,PRVN,GROUP,PXBC
  1. N DIC,DR,DA,DIQ,PRVI,TYPE,TYPEI
  1. ;
  1. K ^TMP("PXBU",$J),PRV,PXBKY,VAUGHN,PXBSAM,PXBSKY,PXBCNT,PXBPRV,FPRI
  1. K PRVDR
  1. S FPRI=""
  1. ; create an array of current providers without duplicates, with their
  1. ; ^(0) node as a value
  1. I $D(^AUPNVPRV("AD",VISIT)) D
  1. .D GETPRV^PXAPIOE(VISIT,"^TMP(""PXBU"",$J,""PRV"")")
  1. ;
  1. A ;--Set array with PROVIDERS
  1. ;
  1. I $G(^TMP("PXBU",$J,"PRV")) D
  1. .S IEN=0 F S IEN=$O(^TMP("PXBU",$J,"PRV",IEN)) Q:IEN'>0 D
  1. ..S PRIMARY=$S($P(^(IEN),U,4)="P":"PRIMARY",1:"SECONDARY")
  1. ..S PRVI=+^(IEN),TYPEI=$P(^(IEN),U,6)
  1. ..S DIC=200,DIC1=DIC,DR=.01,DA=PRVI,DIQ="PRVN" D EN^DIQ1 D
  1. ...S PRV=PRVN(DIC1,DA,DR)
  1. ..S FPRI=FPRI_$E(PRIMARY,1,3) ;-Creating Flag for Primary prompt
  1. ..S TYPE=$$OCCUP("","","",2,TYPEI) D
  1. ...N Y,DATE
  1. ...S Y=+$P($G(^AUPNVSIT(VISIT,0)),U) X ^DD("DD") S DATE=$P(Y,"@",1)
  1. ...I TYPEI="" S TYPE=$$GET^XUA4A72(PRVI,+$P($P($G(^AUPNVSIT(VISIT,0)),U),"."))
  1. ...I +TYPE=-2 S TYPE="*** CLASS not 'ACTIVE' on "_DATE_"***"
  1. ...I +TYPE=-1 S TYPE=""
  1. ...;I +TYPE>0 S TYPE="**** DELETE and RE-ENTER PROVIDER****"
  1. ...I +TYPE>0 S TYPE=""
  1. ..S GROUP=PRV_U_PRIMARY_U_TYPE_U_PRVI
  1. ..I PRIMARY["PRI" S PRVDR("PRIMARY")=PRV_U_IEN_U_PRVI
  1. ..S PRV(PRV,IEN)=GROUP
  1. K ^TMP("PXBU",$J,"PRV")
  1. ;
  1. B ;--Add line numbers
  1. ;create local arrays with data from existing providers
  1. I $D(PRV) D
  1. .S PXBC=0,PRV="" F S PRV=$O(PRV(PRV)) Q:PRV="" D
  1. ..S IEN=0 F S IEN=$O(PRV(PRV,IEN)) Q:IEN="" S PXBC=PXBC+1 D
  1. ...S PXBKY(PRV,PXBC)=$G(PRV(PRV,IEN)),PXBSAM(PXBC)=$G(PRV(PRV,IEN))
  1. ...S PXBSKY(PXBC,IEN)=$P(PRV(PRV,IEN),U,4)
  1. ...K PRV(PRV,IEN)
  1. FINISH ;--Finish up some variables
  1. S:FPRI'["PRI" FPRI=0 S:FPRI["PRI" FPRI=1
  1. ;FPRI=0 Then there is no Primary Selected yet
  1. EXIT ;--set a providers count
  1. S PXBCNT=+$G(PXBC)
  1. Q
  1. ;
  1. OCCUP(IEN,DATE,CODE,RETURN,CLASSIEN) ;--FORMAT PERSON CLASS TO DISPLAY
  1. ; IEN = Provider pointer to file# 200
  1. ; DATE = Date of occurrence of service
  1. ; CODE = Person class Code (if already known)
  1. ; **(Required step) If you use code leave IEN and DATE Blank
  1. ; RETURN = (Required) Flag to decide what format you want the
  1. ; return value.
  1. ; CLASSIEN = Ien of entry in the PERSON CLASS file#8932.1 If the Ien
  1. ; was saved this parameter could be sent in instead of CODE.
  1. ;
  1. ; 1 = IEN^OCCUPATION^SPECIALITY^SUBSPECIALITY^STATUS^DATE INACTIVATED^VA CODE
  1. ; 2 = Short Description
  1. ; 3 = Short Description^VA CODE
  1. ; *** If only CODE and RETURN = 1 There is no value or other
  1. ; value in the STATUS and DATE INACTIVATED fields.
  1. ;
  1. ; Output:
  1. ; -1 "no comment" function call to person class couldn't find
  1. ; a class for that person.
  1. ; -1^COMMENT This function is called incorrectly
  1. ; -2 "no comment" There is no ACTIVE person class for provider
  1. ; based on the date provided.
  1. ;
  1. ;N OCC,SPE,SUB,ENTRY,DIS,OCCL,TYPE,VACODE,ANS
  1. N OCC,SPEL,SUB,SUBL,ENTRY,DIS,OCCL,TYPE,VACODE,ANS
  1. ;--VALIDATE
  1. I (+$G(IEN)'>0)&($L(IEN)>0) Q -1_"^INVALID PERSON IEN"
  1. I '$G(IEN),'$G(DATE),$G(CODE)="",'$G(RETURN),'$G(CLASSIEN) Q -1_"^NO PARAMETERS"
  1. I '$G(IEN),'$G(DATE),$G(CODE)="",$G(RETURN),'$G(CLASSIEN) Q -1_"^NO PARAMETERS"
  1. I '$G(RETURN) Q -1_"^NO RETURN PARAMETER (Required)"
  1. I $G(RETURN)]"",(RETURN'<4!(RETURN'>0)) Q -1_"^RETURN MUST BE 1,2,or 3"
  1. I DATE]"",+DATE'>0 Q -1_"^INVALID FILEMAN DATE"
  1. I $G(IEN) Q:'$D(^VA(200,$G(IEN))) -1_"^NO SUCH IEN IN FILE# 200"
  1. I $G(IEN),$G(DATE) D I $G(RETURN)=1 Q TYPE
  1. .S TYPE=$$GET^XUA4A72(IEN,$P(DATE,".")),VACODE=$P(TYPE,U,7)
  1. I $G(IEN),$G(DATE),+TYPE<0 Q TYPE
  1. ;
  1. ;---CONVERT IEN TO CODE
  1. I $G(CLASSIEN) S CODE=$$IEN2CODE^XUA4A72(CLASSIEN)
  1. ;
  1. I $G(CODE)]"",'$G(IEN),'$G(DATE) S TYPE=$O(^USC(8932.1,"F",$G(CODE),0)),VACODE=CODE I $G(RETURN)=1 S ANS=TYPE_U_$G(^USC(8932.1,TYPE,0)) Q ANS
  1. I '$G(TYPE) Q -1_"UNABLE TO IDENTIFY THE PERSON CLASS IEN" ;Often due to a missing VA CODE field
  1. S ENTRY=$G(^USC(8932.1,+TYPE,0))
  1. OCC ;---OCCUPATION
  1. S OCCL=$P(ENTRY,U)
  1. S OCC=$P($P(ENTRY,U)," ",1)
  1. I OCCL["Physicians (M.D" S OCC="Physician"
  1. I OCCL["Physician Assistant" S OCC=OCCL
  1. I OCCL["Speech, Language" S OCC="Language"
  1. I OCCL["Technologists" S OCC="Technical"
  1. I OCCL["Eye and Vision" S OCC="Ophthalmic"
  1. I OCCL["Respiratory, Rehab" S OCC="Therapist"
  1. I OCCL["Podiatric" S OCC="Podiatry"
  1. ;
  1. SPE ;--SPECIALITY
  1. S SPEL=$P(ENTRY,U,2)
  1. S SPE=$P(ENTRY,U,2)
  1. I SPEL["Registered Nurse" S SPE="R.N."
  1. I SPEL["Dentist" S SPE="Dentist"
  1. I SPEL["Clinical Services" S SPE="Clinical"
  1. I SPEL["Non-R.N.s" S SPE="Non R.N."
  1. I SPEL["Radiologic Sciences" S SPE="Radiology"
  1. I SPEL["Clinical Path" S SPE=""
  1. I SPEL["Physical Therap" S SPE="P.T."
  1. I SPEL["Obstetrics and Gynecology" S SPE="Ob. & Gyn."
  1. I SPEL["iatry and Neur" S SPE="Psyc & Neuro"
  1. I SPEL["Clinical Specialist" S SPE="Clinical"
  1. I SPEL["Registered Dietitian" S SPE="R. Dietitian"
  1. I SPEL["Rehabilitation Prac" S SPE="Rehabilitation"
  1. I OCC["Physician"&(SPE["Internal Medicine") S SPE="Internist"
  1. ;
  1. SUB ;--SUBSPECIALITY
  1. S SUBL=$P(ENTRY,U,3)
  1. S SUB=$P(ENTRY,U,3)
  1. I SUB["Counselor"&(SPE["Counselor") S SPE=""
  1. I SUB["Therapist"&(SPE["Therapist") S SPE=""
  1. I SUB["Nurse"&(SPE["Nurse") S SPE=""
  1. I SUB["Pediatric"&(SPE["Pediatric") S SPE=""
  1. I SUB["Psychiatry"&(SPE["Psychiatry") S SPE=""
  1. I SUB["Podiatri"&(SPE["Podiatri") S SPE=""
  1. I SUB["Clinical and Laboratory Immunology" S SUB="Clin & Lab Immunology"
  1. I SUB["Clinical & Laboratory Immunology" S SUB="Clin & Lab Immunology"
  1. I SUB["cine-Envir" S SUB="Occ & Environmental"
  1. I SUB["Child and Adolescent Psyc" S SUB="Pediatric Mental Health"
  1. I SUB["ist in Meta" S SUB="Metabolic"
  1. I SUB["ist in Pedia" S SUB="Pediatric"
  1. I SUB["ist in Renal" S SUB="Renal"
  1. I SUB["tion Intern" S SUB="Intern"
  1. I SUB["tion Coordin" S SUB="Coordinator"
  1. I SUB["tion Counselor" S SUB="Counselor"
  1. I SUB["for the Blind" S SUB="Orientation for Blind"
  1. I SUB["Dosimetrist" S SUB="Planning, Dosimetrist"
  1. I SPEL["Respiratory Care Pr"&(SUB'="") S SPE=""
  1. ;
  1. ;--CALCULATE THE BEST DISPLAY
  1. S DISL=OCCL_"-"_SPEL_"-"_SUBL
  1. S DIS=OCC_"/"_SPE_"/"_SUB
  1. I SUB[SPE S DIS=OCC_"/"_SUB
  1. I SPE="" S DIS=OCC_"/"_SUB
  1. I SUB="" S DIS=OCC_"/"_SPE
  1. AND I $L(DIS," and ")>1 D
  1. .N I F I=1:1:$L(DIS," ") I $P(DIS," ",I)="and" S $P(DIS," ",I)="&"
  1. I $L(DIS," and ")>1 G AND
  1. ;Q $E(DIS,1,40)_" "_$L(DIS)
  1. ;Q $E(DIS,1,40)_"***"_OCCL
  1. ;Q SPE_" *** "_SPEL
  1. ;Q SUB_" *** "_SUBL
  1. ;Q DISL_"~"_DIS
  1. ;Q ""_"~"_DIS
  1. I $G(RETURN)=2 Q DIS
  1. I $G(RETURN)=3 Q DIS_U_VACODE
  1. Q -1_"^SOMETHING BAD WRONG_SHOULDN'T BE HERE"