XU8P581 ; BA/BP - PERSON CLASSES; 07/27/11
;;8.0;KERNEL;**581**; July 10, 1995;Build 1
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
POST ;
D DEL ;clean entry 1171-1173 if existed
D ADD ;add entry 1171-1173 in the file
D DEF ;update definition for entries
Q
;
ADD ;add the entry 1171-1173
N XUDATA
S XUDATA="1171^Allopathic & Osteopathic Physicians^Internal Medicine^Hypertension Specialist^a^^V182605^207RH0005X^^11^^I"
D ADD1(XUDATA)
N XUDATA
S XUDATA="1172^Respiratory, Developmental, Rehabilitative and Restorative^Clinical Exercise Physiologist^^a^^V130601^224Y00000X^^25^^I"
D ADD1(XUDATA)
N XUDATA
S XUDATA="1173^Suppliers^Medical Foods Supplier^^a^^^335G00000X^^^^N"
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=1171,1172,1173 S DIK="^USC(8932.1,",DA=XU581 D ^DIK
Q
;
DEF ; Update definitions
N XUI
F XUI=1171,1172,1173 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
;
1171 ;
;;A Hypertension Specialist is a physician who concentrates on all aspects
;;of the diagnosis and treatment of hypertension.
;;
;;Source: American Society of Hypertension
;;Additional Resources: The American Society of Hypertension Specialists
;;Program offers an examination and designation for Hypertension
;;Specialists. This subspecialty is not a Board certificate issued by
;;either the American Board of Internal Medicine or the American
;;Osteopathic Board of Internal Medicine.
;;END
1172 ;
;;A Clinical Exercise Physiologist is a health care professional who is
;;trained to work with patients with chronic disease where exercise
;;training has been shown to be of therapeutic benefit, including but not
;;limited to cardiovascular and pulmonary disease, and metabolic disorders.
;;
;;Source: What is a Clinical Exercise Physiologist? Clinical Exercise
;;Physiology Association (CEPA), CEPA Executive Board, 2008
;;END
1173 ;
;;A supplier of special replacement foods for clients with errors of
;;metabolism that prohibit them from eating a regular diet. Medical foods
;;are lacking in the compounds which cause complications of the metabolic
;;disorder, and are not generally available in grocery stores, health food
;;stores, or pharmacies.
;;
;;Source: The Children with Special Healthcare Needs (CSHCN) Services
;;Program, a program of the Texas Department of State Health Services.
;;END
;
GETDATA ; get definitions
N XUI,XUY
F XUI=1171,1172,1173 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 XU581
F XU581=1171,1172,1173 D GET1(XU581)
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[HXU8P581 4307 printed Apr 09, 2024@21:16:51 Page 2
XU8P581 ; BA/BP - PERSON CLASSES; 07/27/11
+1 ;;8.0;KERNEL;**581**; July 10, 1995;Build 1
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
POST ;
+1 ;clean entry 1171-1173 if existed
DO DEL
+2 ;add entry 1171-1173 in the file
DO ADD
+3 ;update definition for entries
DO DEF
+4 QUIT
+5 ;
ADD ;add the entry 1171-1173
+1 NEW XUDATA
+2 SET XUDATA="1171^Allopathic & Osteopathic Physicians^Internal Medicine^Hypertension Specialist^a^^V182605^207RH0005X^^11^^I"
+3 DO ADD1(XUDATA)
+4 NEW XUDATA
+5 SET XUDATA="1172^Respiratory, Developmental, Rehabilitative and Restorative^Clinical Exercise Physiologist^^a^^V130601^224Y00000X^^25^^I"
+6 DO ADD1(XUDATA)
+7 NEW XUDATA
+8 SET XUDATA="1173^Suppliers^Medical Foods Supplier^^a^^^335G00000X^^^^N"
+9 DO ADD1(XUDATA)
+10 QUIT
+11 ;^USC(8932.1,D0,0)= (#.01) PROVIDER TYPE [1F] ^ (#1) CLASSIFICATION [2F] ^
+12 ; ==>(#2) AREA OF SPECIALIZATION [3F] ^ (#3) STATUS [4S] ^ (#4)
+13 ; ==>DATE INACTIVATED [5D] ^ (#5) VA CODE [6F] ^ (#6) X12 CODE
+14 ; ==>[7F] ^ (#7) reserved [8F] ^ (#8) SPECIALTY CODE [9F] ^
+15 ;^USC(8932.1,D0,11,0)=^8932.111^^ (#11) DEFINITION
+16 ;^USC(8932.1,D0,11,D1,0)= (#.01) DEFINITION [1W] ^
+17 ;^USC(8932.1,D0,90002)= ^ (#90002) INDIVIDUAL/NON [2S] ^
+18 ;
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=1171,1172,1173
SET DIK="^USC(8932.1,"
SET DA=XU581
DO ^DIK
+3 QUIT
+4 ;
DEF ; Update definitions
+1 NEW XUI
+2 FOR XUI=1171,1172,1173
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 ;
1171 ;
+1 ;;A Hypertension Specialist is a physician who concentrates on all aspects
+2 ;;of the diagnosis and treatment of hypertension.
+3 ;;
+4 ;;Source: American Society of Hypertension
+5 ;;Additional Resources: The American Society of Hypertension Specialists
+6 ;;Program offers an examination and designation for Hypertension
+7 ;;Specialists. This subspecialty is not a Board certificate issued by
+8 ;;either the American Board of Internal Medicine or the American
+9 ;;Osteopathic Board of Internal Medicine.
+10 ;;END
1172 ;
+1 ;;A Clinical Exercise Physiologist is a health care professional who is
+2 ;;trained to work with patients with chronic disease where exercise
+3 ;;training has been shown to be of therapeutic benefit, including but not
+4 ;;limited to cardiovascular and pulmonary disease, and metabolic disorders.
+5 ;;
+6 ;;Source: What is a Clinical Exercise Physiologist? Clinical Exercise
+7 ;;Physiology Association (CEPA), CEPA Executive Board, 2008
+8 ;;END
1173 ;
+1 ;;A supplier of special replacement foods for clients with errors of
+2 ;;metabolism that prohibit them from eating a regular diet. Medical foods
+3 ;;are lacking in the compounds which cause complications of the metabolic
+4 ;;disorder, and are not generally available in grocery stores, health food
+5 ;;stores, or pharmacies.
+6 ;;
+7 ;;Source: The Children with Special Healthcare Needs (CSHCN) Services
+8 ;;Program, a program of the Texas Department of State Health Services.
+9 ;;END
+10 ;
GETDATA ; get definitions
+1 NEW XUI,XUY
+2 FOR XUI=1171,1172,1173
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 XU581
+2 FOR XU581=1171,1172,1173
DO GET1(XU581)
+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
