| [613] | 1 | PXBGPRV ;ISL/JVS,ESW - GATHER PROVIDERS ; 12/5/02 11:35am
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,108,186**;Aug 12, 1996;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | PRV(VISIT,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI) ;--Gather the entries in the V PROVIDER file
|
|---|
| 5 | ;
|
|---|
| 6 | ;Output:
|
|---|
| 7 | ; PXBSKY(PXBC,IEN)=PRVI
|
|---|
| 8 | ; PXBKY(NAME,PXBC)=NAME^P^TYPE^PRVI
|
|---|
| 9 | ; PXBSAM(PXBC)=NAME^P^TYPE^PRVI
|
|---|
| 10 | ; PRVDR("PRIMARY")=NAME^IEN^PRVI
|
|---|
| 11 | ; PXBCNT
|
|---|
| 12 | ; FPRI
|
|---|
| 13 | ;where:
|
|---|
| 14 | ; PXBC - sequence in an order of providers name
|
|---|
| 15 | ; IEN - of ^AUPNVPRV(
|
|---|
| 16 | ; NAME - provider's name (LAST,FIRST...)
|
|---|
| 17 | ; P - PRIMARY or SECONDARY
|
|---|
| 18 | ; PRVI - IEN of ^VA(200,
|
|---|
| 19 | ; PXBCNT - provider count
|
|---|
| 20 | ; FPRI:
|
|---|
| 21 | ; 0 - Primary not selected
|
|---|
| 22 | ; 1 - Primary selected
|
|---|
| 23 | ;
|
|---|
| 24 | N IEN,QUANTITY,PROVIDER,PRIMARY,PRV,GROUP,PXBC
|
|---|
| 25 | N DIC,DR,DA,DIQ,PRVI,TYPE
|
|---|
| 26 | ;
|
|---|
| 27 | K ^TMP("PXBU",$J),PRV,PXBKY,VAUGHN,PXBSAM,PXBSKY,PXBCNT,PXBPRV,FPRI
|
|---|
| 28 | K PRVDR
|
|---|
| 29 | S FPRI=""
|
|---|
| 30 | ; create an array of current providers without duplicates, with their
|
|---|
| 31 | ; ^(0) node as a value
|
|---|
| 32 | I $D(^AUPNVPRV("AD",VISIT)) D
|
|---|
| 33 | .D GETPRV^PXAPIOE(VISIT,"^TMP(""PXBU"",$J,""PRV"")")
|
|---|
| 34 | ;
|
|---|
| 35 | A ;--Set array with PROVIDERS
|
|---|
| 36 | ;
|
|---|
| 37 | I $G(^TMP("PXBU",$J,"PRV")) D
|
|---|
| 38 | .S IEN=0 F S IEN=$O(^TMP("PXBU",$J,"PRV",IEN)) Q:IEN'>0 D
|
|---|
| 39 | ..S PRIMARY=$S($P(^(IEN),U,4)="P":"PRIMARY",1:"SECONDARY")
|
|---|
| 40 | ..S PRVI=+^(IEN),TYPEI=$P(^(IEN),U,6)
|
|---|
| 41 | ..S DIC=200,DIC1=DIC,DR=.01,DA=PRVI,DIQ="PRVN" D EN^DIQ1 D
|
|---|
| 42 | ...S PRV=PRVN(DIC1,DA,DR)
|
|---|
| 43 | ..S FPRI=FPRI_$E(PRIMARY,1,3) ;-Creating Flag for Primary prompt
|
|---|
| 44 | ..S TYPE=$$OCCUP("","","",2,TYPEI) D
|
|---|
| 45 | ...N Y,DATE
|
|---|
| 46 | ...S Y=+$P($G(^AUPNVSIT(VISIT,0)),U) X ^DD("DD") S DATE=$P(Y,"@",1)
|
|---|
| 47 | ...I TYPEI="" S TYPE=$$GET^XUA4A72(PRVI,+$P($P($G(^AUPNVSIT(VISIT,0)),U),"."))
|
|---|
| 48 | ...I +TYPE=-2 S TYPE="*** CLASS not 'ACTIVE' on "_DATE_"***"
|
|---|
| 49 | ...I +TYPE=-1 S TYPE=""
|
|---|
| 50 | ...;I +TYPE>0 S TYPE="**** DELETE and RE-ENTER PROVIDER****"
|
|---|
| 51 | ...I +TYPE>0 S TYPE=""
|
|---|
| 52 | ..S GROUP=PRV_U_PRIMARY_U_TYPE_U_PRVI
|
|---|
| 53 | ..I PRIMARY["PRI" S PRVDR("PRIMARY")=PRV_U_IEN_U_PRVI
|
|---|
| 54 | ..S PRV(PRV,IEN)=GROUP
|
|---|
| 55 | K ^TMP("PXBU",$J,"PRV")
|
|---|
| 56 | ;
|
|---|
| 57 | B ;--Add line numbers
|
|---|
| 58 | ;create local arrays with data from existing providers
|
|---|
| 59 | I $D(PRV) D
|
|---|
| 60 | .S PXBC=0,PRV="" F S PRV=$O(PRV(PRV)) Q:PRV="" D
|
|---|
| 61 | ..S IEN=0 F S IEN=$O(PRV(PRV,IEN)) Q:IEN="" S PXBC=PXBC+1 D
|
|---|
| 62 | ...S PXBKY(PRV,PXBC)=$G(PRV(PRV,IEN)),PXBSAM(PXBC)=$G(PRV(PRV,IEN))
|
|---|
| 63 | ...S PXBSKY(PXBC,IEN)=$P(PRV(PRV,IEN),U,4)
|
|---|
| 64 | ...K PRV(PRV,IEN)
|
|---|
| 65 | FINISH ;--Finish up some variables
|
|---|
| 66 | S:FPRI'["PRI" FPRI=0 S:FPRI["PRI" FPRI=1
|
|---|
| 67 | ;FPRI=0 Then there is no Primary Selected yet
|
|---|
| 68 | EXIT ;--set a providers count
|
|---|
| 69 | S PXBCNT=+$G(PXBC)
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | OCCUP(IEN,DATE,CODE,RETURN,CLASSIEN) ;--FORMAT PERSON CLASS TO DISPLAY
|
|---|
| 73 | ; IEN = Provider pointer to file# 200
|
|---|
| 74 | ; DATE = Date of occurrence of service
|
|---|
| 75 | ; CODE = Person class Code (if already known)
|
|---|
| 76 | ; **(Required step) If you use code leave IEN and DATE Blank
|
|---|
| 77 | ; RETURN = (Required) Flag to decide what format you want the
|
|---|
| 78 | ; return value.
|
|---|
| 79 | ; CLASSIEN = Ien of entry in the PERSON CLASS file#8932.1 If the Ien
|
|---|
| 80 | ; was saved this parameter could be sent in instead of CODE.
|
|---|
| 81 | ;
|
|---|
| 82 | ; 1 = IEN^OCCUPATION^SPECIALITY^SUBSPECIALITY^STATUS^DATE INACTIVATED^VA CODE
|
|---|
| 83 | ; 2 = Short Description
|
|---|
| 84 | ; 3 = Short Description^VA CODE
|
|---|
| 85 | ; *** If only CODE and RETURN = 1 There is no value or other
|
|---|
| 86 | ; value in the STATUS and DATE INACTIVATED fields.
|
|---|
| 87 | ;
|
|---|
| 88 | ; Output:
|
|---|
| 89 | ; -1 "no comment" function call to person class couldn't find
|
|---|
| 90 | ; a class for that person.
|
|---|
| 91 | ; -1^COMMENT This function is called incorrectly
|
|---|
| 92 | ; -2 "no comment" There is no ACTIVE person class for provider
|
|---|
| 93 | ; based on the date provided.
|
|---|
| 94 | ;
|
|---|
| 95 | N OCC,SPE,SUB,ENTRY,DIS,OCCL,TYPE,VACODE,ANS
|
|---|
| 96 | ;--VALIDATE
|
|---|
| 97 | I (+$G(IEN)'>0)&($L(IEN)>0) Q -1_"^INVALID PERSON IEN"
|
|---|
| 98 | I '$G(IEN),'$G(DATE),$G(CODE)="",'$G(RETURN),'$G(CLASSIEN) Q -1_"^NO PARAMETERS"
|
|---|
| 99 | I '$G(IEN),'$G(DATE),$G(CODE)="",$G(RETURN),'$G(CLASSIEN) Q -1_"^NO PARAMETERS"
|
|---|
| 100 | I '$G(RETURN) Q -1_"^NO RETURN PARAMETER (Required)"
|
|---|
| 101 | I $G(RETURN)]"",(RETURN'<4!(RETURN'>0)) Q -1_"^RETURN MUST BE 1,2,or 3"
|
|---|
| 102 | I DATE]"",+DATE'>0 Q -1_"^INVALID FILEMAN DATE"
|
|---|
| 103 | I $G(IEN) Q:'$D(^VA(200,$G(IEN))) -1_"^NO SUCH IEN IN FILE# 200"
|
|---|
| 104 | I $G(IEN),$G(DATE) D I $G(RETURN)=1 Q TYPE
|
|---|
| 105 | .S TYPE=$$GET^XUA4A72(IEN,$P(DATE,".")),VACODE=$P(TYPE,U,7)
|
|---|
| 106 | I $G(IEN),$G(DATE),+TYPE<0 Q TYPE
|
|---|
| 107 | ;
|
|---|
| 108 | ;---CONVERT IEN TO CODE
|
|---|
| 109 | I $G(CLASSIEN) S CODE=$$IEN2CODE^XUA4A72(CLASSIEN)
|
|---|
| 110 | ;
|
|---|
| 111 | 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
|
|---|
| 112 | S ENTRY=$G(^USC(8932.1,+TYPE,0))
|
|---|
| 113 | OCC ;---OCCUPATION
|
|---|
| 114 | S OCCL=$P(ENTRY,U)
|
|---|
| 115 | S OCC=$P($P(ENTRY,U)," ",1)
|
|---|
| 116 | I OCCL["Physicians (M.D" S OCC="Physician"
|
|---|
| 117 | I OCCL["Physician Assistant" S OCC=OCCL
|
|---|
| 118 | I OCCL["Speech, Language" S OCC="Language"
|
|---|
| 119 | I OCCL["Technologists" S OCC="Technical"
|
|---|
| 120 | I OCCL["Eye and Vision" S OCC="Ophthalmic"
|
|---|
| 121 | I OCCL["Respiratory, Rehab" S OCC="Therapist"
|
|---|
| 122 | I OCCL["Podiatric" S OCC="Podiatry"
|
|---|
| 123 | ;
|
|---|
| 124 | SPE ;--SPECIALITY
|
|---|
| 125 | S SPEL=$P(ENTRY,U,2)
|
|---|
| 126 | S SPE=$P(ENTRY,U,2)
|
|---|
| 127 | I SPEL["Registered Nurse" S SPE="R.N."
|
|---|
| 128 | I SPEL["Dentist" S SPE="Dentist"
|
|---|
| 129 | I SPEL["Clinical Services" S SPE="Clinical"
|
|---|
| 130 | I SPEL["Non-R.N.s" S SPE="Non R.N."
|
|---|
| 131 | I SPEL["Radiologic Sciences" S SPE="Radiology"
|
|---|
| 132 | I SPEL["Clinical Path" S SPE=""
|
|---|
| 133 | I SPEL["Physical Therap" S SPE="P.T."
|
|---|
| 134 | I SPEL["Obstetrics and Gynecology" S SPE="Ob. & Gyn."
|
|---|
| 135 | I SPEL["iatry and Neur" S SPE="Psyc & Neuro"
|
|---|
| 136 | I SPEL["Clinical Specialist" S SPE="Clinical"
|
|---|
| 137 | I SPEL["Registered Dietitian" S SPE="R. Dietitian"
|
|---|
| 138 | I SPEL["Rehabilitation Prac" S SPE="Rehabilitation"
|
|---|
| 139 | I OCC["Physician"&(SPE["Internal Medicine") S SPE="Internist"
|
|---|
| 140 | ;
|
|---|
| 141 | SUB ;--SUBSPECIALITY
|
|---|
| 142 | S SUBL=$P(ENTRY,U,3)
|
|---|
| 143 | S SUB=$P(ENTRY,U,3)
|
|---|
| 144 | I SUB["Counselor"&(SPE["Counselor") S SPE=""
|
|---|
| 145 | I SUB["Therapist"&(SPE["Therapist") S SPE=""
|
|---|
| 146 | I SUB["Nurse"&(SPE["Nurse") S SPE=""
|
|---|
| 147 | I SUB["Pediatric"&(SPE["Pediatric") S SPE=""
|
|---|
| 148 | I SUB["Psychiatry"&(SPE["Psychiatry") S SPE=""
|
|---|
| 149 | I SUB["Podiatri"&(SPE["Podiatri") S SPE=""
|
|---|
| 150 | I SUB["Clinical and Laboratory Immunology" S SUB="Clin & Lab Immunology"
|
|---|
| 151 | I SUB["Clinical & Laboratory Immunology" S SUB="Clin & Lab Immunology"
|
|---|
| 152 | I SUB["cine-Envir" S SUB="Occ & Environmental"
|
|---|
| 153 | I SUB["Child and Adolescent Psyc" S SUB="Pediatric Mental Health"
|
|---|
| 154 | I SUB["ist in Meta" S SUB="Metabolic"
|
|---|
| 155 | I SUB["ist in Pedia" S SUB="Pediatric"
|
|---|
| 156 | I SUB["ist in Renal" S SUB="Renal"
|
|---|
| 157 | I SUB["tion Intern" S SUB="Intern"
|
|---|
| 158 | I SUB["tion Coordin" S SUB="Coordinator"
|
|---|
| 159 | I SUB["tion Counselor" S SUB="Counselor"
|
|---|
| 160 | I SUB["for the Blind" S SUB="Orientation for Blind"
|
|---|
| 161 | I SUB["Dosimetrist" S SUB="Planning, Dosimetrist"
|
|---|
| 162 | I SPEL["Respiratory Care Pr"&(SUB'="") S SPE=""
|
|---|
| 163 | ;
|
|---|
| 164 | ;--CALCULATE THE BEST DISPLAY
|
|---|
| 165 | S DISL=OCCL_"-"_SPEL_"-"_SUBL
|
|---|
| 166 | S DIS=OCC_"/"_SPE_"/"_SUB
|
|---|
| 167 | I SUB[SPE S DIS=OCC_"/"_SUB
|
|---|
| 168 | I SPE="" S DIS=OCC_"/"_SUB
|
|---|
| 169 | I SUB="" S DIS=OCC_"/"_SPE
|
|---|
| 170 | AND I $L(DIS," and ")>1 D
|
|---|
| 171 | .N I F I=1:1:$L(DIS," ") I $P(DIS," ",I)="and" S $P(DIS," ",I)="&"
|
|---|
| 172 | I $L(DIS," and ")>1 G AND
|
|---|
| 173 | ;Q $E(DIS,1,40)_" "_$L(DIS)
|
|---|
| 174 | ;Q $E(DIS,1,40)_"***"_OCCL
|
|---|
| 175 | ;Q SPE_" *** "_SPEL
|
|---|
| 176 | ;Q SUB_" *** "_SUBL
|
|---|
| 177 | ;Q DISL_"~"_DIS
|
|---|
| 178 | ;Q ""_"~"_DIS
|
|---|
| 179 | I $G(RETURN)=2 Q DIS
|
|---|
| 180 | I $G(RETURN)=3 Q DIS_U_VACODE
|
|---|
| 181 | Q -1_"^SOMETHING BAD WRONG_SHOULDN'T BE HERE"
|
|---|
