- XU8P601 ; BA/BP - PERSON CLASSES;06/25/12
- ;;8.0;KERNEL;**601**; July 10, 1995;Build 4
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ; Update Person Class file for 06/01/2012
- POST ;
- D DEL ;clean entry 1180-1209 if existed
- D ADD ;add entry 1180-1209 in the file
- D DEF^XU8P601A ;update definition for entries
- D DEF^XU8P601B ;update definition for entries
- N X F X="XU8P601A","XU8P601B" X ^%ZOSF("DEL") ;delete routine.
- Q
- ;
- ADD ;add the entry 1180-1209
- N XUDATA
- S XUDATA="1180^Behavioral Health & Social Service Providers^Psychoanalyst^^a^^V010423^102L00000X^^26^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1181^Behavioral Health & Social Service Providers^Poetry Therapist^^a^^V010701^102X00000X^^26^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1182^Chiropractic Providers^Chiropractor^Rehabilitation^a^^V020601^111NR0400X^^35^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1183^Allopathic & Osteopathic Physicians^Anesthesiology^Hospice and Palliative Medicine^a^^V180204^207LH0002X^^05^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1184^Allopathic & Osteopathic Physicians^Anesthesiology^Pediatric Anesthesiology^a^^V180205^207LP3000X^^05^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1185^Allopathic & Osteopathic Physicians^Emergency Medicine^Hospice and Palliative Medicine^a^^V180606^207PH0002X^^93^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1186^Allopathic & Osteopathic Physicians^Family Medicine^Bariatric Medicine^a^^V180708^207QB0002X^^08^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1187^Allopathic & Osteopathic Physicians^Family Medicine^Hospice and Palliative Medicine^a^^V180709^207QH0002X^^08^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1188^Allopathic & Osteopathic Physicians^Internal Medicine^Bariatric Medicine^a^^V181022^207RB0002X^^11^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1189^Allopathic & Osteopathic Physicians^Internal Medicine^Hospice and Palliative Medicine^a^^V181023^207RH0002X^^11^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1190^Allopathic & Osteopathic Physicians^Internal Medicine^Sleep Medicine^a^^V181024^207RS0012X^^11^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1191^Allopathic & Osteopathic Physicians^Internal Medicine^Transplant Hepatology^a^^V181025^207RT0003X^^11^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1192^Allopathic & Osteopathic Physicians^Obstetrics & Gynecology^Bariatric Medicine^a^^V181808^207VB0002X^^16^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1193^Allopathic & Osteopathic Physicians^Obstetrics & Gynecology^Hospice and Palliative Medicine^a^^V181809^207VH0002X^^16^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1194^Allopathic & Osteopathic Physicians^Otolaryngology^Sleep Medicine^a^^V182207^207YS0012X^^04^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1195^Allopathic & Osteopathic Physicians^Pediatrics^Hospice and Palliative Medicine^a^^V182518^2080H0002X^^37^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1196^Allopathic & Osteopathic Physicians^Pediatrics^Sleep Medicine^a^^V182519^2080S0012X^^37^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1197^Allopathic & Osteopathic Physicians^Pediatrics^Pediatric Transplant Hepatology^a^^V182520^2080T0004X^^37^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1198^Allopathic & Osteopathic Physicians^Physical Medicine & Rehabilitation^Neuromuscular Medicine^a^^V182605^2081N0008X^^25^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1199^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Bariatric Medicine^a^^V182915^2084B0002X^^86^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1200^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Behavioral Neurology & Neuropsychiatry^a^^V182916^2084B0040X^^86^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1201^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Diagnostic Neuroimaging^a^^V182917^2084D0003X^^86^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1202^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Hospice and Palliative Medicine^a^^V182918^2084H0002X^^86^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1203^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Neuromuscular Medicine^a^^V182919^2084N0008X^^86^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1204^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Psychosomatic Medicine^a^^V182920^2084P0015X^^86^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1205^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Sleep Medicine^a^^V182921^2084S0012X^^86^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1206^Allopathic & Osteopathic Physicians^Radiology^Diagnostic Neuroimaging^a^^V183011^2085D0003X^^94^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1207^Allopathic & Osteopathic Physicians^Radiology^Hospice and Palliative Medicine^a^^V183012^2085H0002X^^94^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1208^Allopathic & Osteopathic Physicians^Surgery^Hospice and Palliative Medicine^a^^V183108^2086H0002X^^02^^^I"
- D ADD1(XUDATA)
- N XUDATA
- S XUDATA="1209^Allopathic & Osteopathic Physicians^Urology^Pediatric Urology^a^^V183402^2088P0231X^^34^^^I"
- D ADD1(XUDATA)
- Q
- ;^USC(8932.1,D0,0)= (#.01) PROVIDER TYPE [1F] ^ (#1) CLASSIFICATION [2F] ^
- ; ==>(#2) AREA OF SPECIALIZATION [3F] ^ (#3) STATUS [4S] ^ (#4)
- ; ==>DATE INACTIVATED [5D] ^ (#5) VA CODE [6F] ^ (#6) X12 CODE
- ; ==>[7F] ^ (#7) reserved [8F] ^ (#8) SPECIALTY CODE [9F] ^
- ;^USC(8932.1,D0,11,0)=^8932.111^^ (#11) DEFINITION
- ;^USC(8932.1,D0,11,D1,0)= (#.01) DEFINITION [1W] ^
- ;^USC(8932.1,D0,90002)= ^ (#90002) INDIVIDUAL/NON [2S] ^
- ;
- ADD1(XUDATA) ; add single entry
- N FDA,FDAIEN,XUD
- S XUD=$G(XUDATA)
- S FDAIEN(1)=$P(XUD,"^")
- S FDA(8932.1,"+1,",.01)=$P(XUD,"^",2)
- S FDA(8932.1,"+1,",1)=$P(XUD,"^",3)
- S FDA(8932.1,"+1,",2)=$P(XUD,"^",4)
- S FDA(8932.1,"+1,",3)="a"
- S FDA(8932.1,"+1,",5)=$P(XUD,"^",7)
- S FDA(8932.1,"+1,",6)=$P(XUD,"^",8)
- S FDA(8932.1,"+1,",8)=$P(XUD,"^",10)
- S FDA(8932.1,"+1,",90002)=$P(XUD,"^",12)
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q
- ;
- DEL ; Delete entries
- N XU581,DIK,DA
- F XU581=1180:1:1209 S DIK="^USC(8932.1,",DA=XU581 D ^DIK
- Q
- ;
- DEF ; Update definitions
- N XUI
- F XUI=1180:1:1209 D DEF1(XUI)
- Q
- ;
- DEF1(XUI) ; Update definition for single entry XUI
- N XUI1,XUDATA,XUY
- K ^TMP($J,"XUBA")
- F XUY=1:1:100 S XUDATA=$T(@XUI+XUY) Q:XUDATA=" ;;END" D
- . S ^TMP($J,"XUBA",XUI,XUY,0)=$P(XUDATA,";;",2)
- S XUI1=XUI_","
- D WP^DIE(8932.1,XUI1,11,"K","^TMP($J,""XUBA"",XUI)")
- K ^TMP($J,"XUBA")
- Q
- ;
- GETDEF ; get definitions
- N XUI,XUY
- F XUI=1180:1:1209 D
- . S XUY=$G(^USC(8932.1,XUI,11,0)),XUY=$P(XUY,"^",3)
- . I XUY>0 D GETDES(XUI,XUY)
- Q
- ;
- GETDES(XUI,XUY) ; get single entry definition
- N XUA,XUB
- W !,XUI," ;"
- F XUA=1:1:XUY W !," ;;",$G(^USC(8932.1,XUI,11,XUA,0))
- W !," ;;END"
- Q
- GET ;
- N XU591
- F XU591=1180:1:1209 D GET1(XU591)
- Q
- ;
- GET1(XUIEN) ; Get information of given entry from Person Class file.
- N XUI
- S XUI=" ;;"_XUIEN_"^"_$G(^USC(8932.1,XUIEN,0))
- S $P(XUI,"^",12)=$G(^USC(8932.1,XUIEN,90002))
- W !," N XUDATA"
- W !," S XUDATA=","""",$P(XUI,";;",2),""""
- W !," D ADD1(XUDATA)"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P601 7132 printed Jan 18, 2025@03:09:33 Page 2
- XU8P601 ; BA/BP - PERSON CLASSES;06/25/12
- +1 ;;8.0;KERNEL;**601**; July 10, 1995;Build 4
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ; Update Person Class file for 06/01/2012
- POST ;
- +1 ;clean entry 1180-1209 if existed
- DO DEL
- +2 ;add entry 1180-1209 in the file
- DO ADD
- +3 ;update definition for entries
- DO DEF^XU8P601A
- +4 ;update definition for entries
- DO DEF^XU8P601B
- +5 ;delete routine.
- NEW X
- FOR X="XU8P601A","XU8P601B"
- XECUTE ^%ZOSF("DEL")
- +6 QUIT
- +7 ;
- ADD ;add the entry 1180-1209
- +1 NEW XUDATA
- +2 SET XUDATA="1180^Behavioral Health & Social Service Providers^Psychoanalyst^^a^^V010423^102L00000X^^26^^^I"
- +3 DO ADD1(XUDATA)
- +4 NEW XUDATA
- +5 SET XUDATA="1181^Behavioral Health & Social Service Providers^Poetry Therapist^^a^^V010701^102X00000X^^26^^^I"
- +6 DO ADD1(XUDATA)
- +7 NEW XUDATA
- +8 SET XUDATA="1182^Chiropractic Providers^Chiropractor^Rehabilitation^a^^V020601^111NR0400X^^35^^^I"
- +9 DO ADD1(XUDATA)
- +10 NEW XUDATA
- +11 SET XUDATA="1183^Allopathic & Osteopathic Physicians^Anesthesiology^Hospice and Palliative Medicine^a^^V180204^207LH0002X^^05^^^I"
- +12 DO ADD1(XUDATA)
- +13 NEW XUDATA
- +14 SET XUDATA="1184^Allopathic & Osteopathic Physicians^Anesthesiology^Pediatric Anesthesiology^a^^V180205^207LP3000X^^05^^^I"
- +15 DO ADD1(XUDATA)
- +16 NEW XUDATA
- +17 SET XUDATA="1185^Allopathic & Osteopathic Physicians^Emergency Medicine^Hospice and Palliative Medicine^a^^V180606^207PH0002X^^93^^^I"
- +18 DO ADD1(XUDATA)
- +19 NEW XUDATA
- +20 SET XUDATA="1186^Allopathic & Osteopathic Physicians^Family Medicine^Bariatric Medicine^a^^V180708^207QB0002X^^08^^^I"
- +21 DO ADD1(XUDATA)
- +22 NEW XUDATA
- +23 SET XUDATA="1187^Allopathic & Osteopathic Physicians^Family Medicine^Hospice and Palliative Medicine^a^^V180709^207QH0002X^^08^^^I"
- +24 DO ADD1(XUDATA)
- +25 NEW XUDATA
- +26 SET XUDATA="1188^Allopathic & Osteopathic Physicians^Internal Medicine^Bariatric Medicine^a^^V181022^207RB0002X^^11^^^I"
- +27 DO ADD1(XUDATA)
- +28 NEW XUDATA
- +29 SET XUDATA="1189^Allopathic & Osteopathic Physicians^Internal Medicine^Hospice and Palliative Medicine^a^^V181023^207RH0002X^^11^^^I"
- +30 DO ADD1(XUDATA)
- +31 NEW XUDATA
- +32 SET XUDATA="1190^Allopathic & Osteopathic Physicians^Internal Medicine^Sleep Medicine^a^^V181024^207RS0012X^^11^^^I"
- +33 DO ADD1(XUDATA)
- +34 NEW XUDATA
- +35 SET XUDATA="1191^Allopathic & Osteopathic Physicians^Internal Medicine^Transplant Hepatology^a^^V181025^207RT0003X^^11^^^I"
- +36 DO ADD1(XUDATA)
- +37 NEW XUDATA
- +38 SET XUDATA="1192^Allopathic & Osteopathic Physicians^Obstetrics & Gynecology^Bariatric Medicine^a^^V181808^207VB0002X^^16^^^I"
- +39 DO ADD1(XUDATA)
- +40 NEW XUDATA
- +41 SET XUDATA="1193^Allopathic & Osteopathic Physicians^Obstetrics & Gynecology^Hospice and Palliative Medicine^a^^V181809^207VH0002X^^16^^^I"
- +42 DO ADD1(XUDATA)
- +43 NEW XUDATA
- +44 SET XUDATA="1194^Allopathic & Osteopathic Physicians^Otolaryngology^Sleep Medicine^a^^V182207^207YS0012X^^04^^^I"
- +45 DO ADD1(XUDATA)
- +46 NEW XUDATA
- +47 SET XUDATA="1195^Allopathic & Osteopathic Physicians^Pediatrics^Hospice and Palliative Medicine^a^^V182518^2080H0002X^^37^^^I"
- +48 DO ADD1(XUDATA)
- +49 NEW XUDATA
- +50 SET XUDATA="1196^Allopathic & Osteopathic Physicians^Pediatrics^Sleep Medicine^a^^V182519^2080S0012X^^37^^^I"
- +51 DO ADD1(XUDATA)
- +52 NEW XUDATA
- +53 SET XUDATA="1197^Allopathic & Osteopathic Physicians^Pediatrics^Pediatric Transplant Hepatology^a^^V182520^2080T0004X^^37^^^I"
- +54 DO ADD1(XUDATA)
- +55 NEW XUDATA
- +56 SET XUDATA="1198^Allopathic & Osteopathic Physicians^Physical Medicine & Rehabilitation^Neuromuscular Medicine^a^^V182605^2081N0008X^^25^^^I"
- +57 DO ADD1(XUDATA)
- +58 NEW XUDATA
- +59 SET XUDATA="1199^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Bariatric Medicine^a^^V182915^2084B0002X^^86^^^I"
- +60 DO ADD1(XUDATA)
- +61 NEW XUDATA
- +62 SET XUDATA="1200^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Behavioral Neurology & Neuropsychiatry^a^^V182916^2084B0040X^^86^^^I"
- +63 DO ADD1(XUDATA)
- +64 NEW XUDATA
- +65 SET XUDATA="1201^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Diagnostic Neuroimaging^a^^V182917^2084D0003X^^86^^^I"
- +66 DO ADD1(XUDATA)
- +67 NEW XUDATA
- +68 SET XUDATA="1202^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Hospice and Palliative Medicine^a^^V182918^2084H0002X^^86^^^I"
- +69 DO ADD1(XUDATA)
- +70 NEW XUDATA
- +71 SET XUDATA="1203^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Neuromuscular Medicine^a^^V182919^2084N0008X^^86^^^I"
- +72 DO ADD1(XUDATA)
- +73 NEW XUDATA
- +74 SET XUDATA="1204^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Psychosomatic Medicine^a^^V182920^2084P0015X^^86^^^I"
- +75 DO ADD1(XUDATA)
- +76 NEW XUDATA
- +77 SET XUDATA="1205^Allopathic & Osteopathic Physicians^Psychiatry & Neurology^Sleep Medicine^a^^V182921^2084S0012X^^86^^^I"
- +78 DO ADD1(XUDATA)
- +79 NEW XUDATA
- +80 SET XUDATA="1206^Allopathic & Osteopathic Physicians^Radiology^Diagnostic Neuroimaging^a^^V183011^2085D0003X^^94^^^I"
- +81 DO ADD1(XUDATA)
- +82 NEW XUDATA
- +83 SET XUDATA="1207^Allopathic & Osteopathic Physicians^Radiology^Hospice and Palliative Medicine^a^^V183012^2085H0002X^^94^^^I"
- +84 DO ADD1(XUDATA)
- +85 NEW XUDATA
- +86 SET XUDATA="1208^Allopathic & Osteopathic Physicians^Surgery^Hospice and Palliative Medicine^a^^V183108^2086H0002X^^02^^^I"
- +87 DO ADD1(XUDATA)
- +88 NEW XUDATA
- +89 SET XUDATA="1209^Allopathic & Osteopathic Physicians^Urology^Pediatric Urology^a^^V183402^2088P0231X^^34^^^I"
- +90 DO ADD1(XUDATA)
- +91 QUIT
- +92 ;^USC(8932.1,D0,0)= (#.01) PROVIDER TYPE [1F] ^ (#1) CLASSIFICATION [2F] ^
- +93 ; ==>(#2) AREA OF SPECIALIZATION [3F] ^ (#3) STATUS [4S] ^ (#4)
- +94 ; ==>DATE INACTIVATED [5D] ^ (#5) VA CODE [6F] ^ (#6) X12 CODE
- +95 ; ==>[7F] ^ (#7) reserved [8F] ^ (#8) SPECIALTY CODE [9F] ^
- +96 ;^USC(8932.1,D0,11,0)=^8932.111^^ (#11) DEFINITION
- +97 ;^USC(8932.1,D0,11,D1,0)= (#.01) DEFINITION [1W] ^
- +98 ;^USC(8932.1,D0,90002)= ^ (#90002) INDIVIDUAL/NON [2S] ^
- +99 ;
- ADD1(XUDATA) ; add single entry
- +1 NEW FDA,FDAIEN,XUD
- +2 SET XUD=$GET(XUDATA)
- +3 SET FDAIEN(1)=$PIECE(XUD,"^")
- +4 SET FDA(8932.1,"+1,",.01)=$PIECE(XUD,"^",2)
- +5 SET FDA(8932.1,"+1,",1)=$PIECE(XUD,"^",3)
- +6 SET FDA(8932.1,"+1,",2)=$PIECE(XUD,"^",4)
- +7 SET FDA(8932.1,"+1,",3)="a"
- +8 SET FDA(8932.1,"+1,",5)=$PIECE(XUD,"^",7)
- +9 SET FDA(8932.1,"+1,",6)=$PIECE(XUD,"^",8)
- +10 SET FDA(8932.1,"+1,",8)=$PIECE(XUD,"^",10)
- +11 SET FDA(8932.1,"+1,",90002)=$PIECE(XUD,"^",12)
- +12 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +13 QUIT
- +14 ;
- DEL ; Delete entries
- +1 NEW XU581,DIK,DA
- +2 FOR XU581=1180:1:1209
- SET DIK="^USC(8932.1,"
- SET DA=XU581
- DO ^DIK
- +3 QUIT
- +4 ;
- DEF ; Update definitions
- +1 NEW XUI
- +2 FOR XUI=1180:1:1209
- DO DEF1(XUI)
- +3 QUIT
- +4 ;
- DEF1(XUI) ; Update definition for single entry XUI
- +1 NEW XUI1,XUDATA,XUY
- +2 KILL ^TMP($JOB,"XUBA")
- +3 FOR XUY=1:1:100
- SET XUDATA=$TEXT(@XUI+XUY)
- if XUDATA=" ;;END"
- QUIT
- Begin DoDot:1
- +4 SET ^TMP($JOB,"XUBA",XUI,XUY,0)=$PIECE(XUDATA,";;",2)
- End DoDot:1
- +5 SET XUI1=XUI_","
- +6 DO WP^DIE(8932.1,XUI1,11,"K","^TMP($J,""XUBA"",XUI)")
- +7 KILL ^TMP($JOB,"XUBA")
- +8 QUIT
- +9 ;
- GETDEF ; get definitions
- +1 NEW XUI,XUY
- +2 FOR XUI=1180:1:1209
- Begin DoDot:1
- +3 SET XUY=$GET(^USC(8932.1,XUI,11,0))
- SET XUY=$PIECE(XUY,"^",3)
- +4 IF XUY>0
- DO GETDES(XUI,XUY)
- End DoDot:1
- +5 QUIT
- +6 ;
- GETDES(XUI,XUY) ; get single entry definition
- +1 NEW XUA,XUB
- +2 WRITE !,XUI," ;"
- +3 FOR XUA=1:1:XUY
- WRITE !," ;;",$GET(^USC(8932.1,XUI,11,XUA,0))
- +4 WRITE !," ;;END"
- +5 QUIT
- GET ;
- +1 NEW XU591
- +2 FOR XU591=1180:1:1209
- DO GET1(XU591)
- +3 QUIT
- +4 ;
- GET1(XUIEN) ; Get information of given entry from Person Class file.
- +1 NEW XUI
- +2 SET XUI=" ;;"_XUIEN_"^"_$GET(^USC(8932.1,XUIEN,0))
- +3 SET $PIECE(XUI,"^",12)=$GET(^USC(8932.1,XUIEN,90002))
- +4 WRITE !," N XUDATA"
- +5 WRITE !," S XUDATA=","""",$PIECE(XUI,";;",2),""""
- +6 WRITE !," D ADD1(XUDATA)"
- +7 QUIT