XU8P571 ; BA/BP - PERSON CLASSES; 05/10/11
;;8.0;KERNEL;**571**; July 10, 1995;Build 1
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
POST ;
D DEL ;clean entry 1170 if existed
D ADD ;add entry 1170 in the file
D DEF ;update definition for entries
Q
;
ADD ;add the entry 1170
N XUDATA
S XUDATA="1170^Other Service Providers^Genetic Counselor, MS^^V082201^170300000X^^I"
D ADD1(XUDATA)
Q
;
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,"^",5)
S FDA(8932.1,"+1,",6)=$P(XUD,"^",6)
S FDA(8932.1,"+1,",8)=$P(XUD,"^",7)
S FDA(8932.1,"+1,",90002)=$P(XUD,"^",8)
D UPDATE^DIE("","FDA","FDAIEN","ERR")
Q
;
DEL ; Delete entries
N XU560,DIK,DA
S XU560=1170 S DIK="^USC(8932.1,",DA=XU560 D ^DIK
Q
;
DEF ; Update definitions
N XUI
S XUI=1170 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
;
1170 ;
;;A masters trained health care provider who collects and interprets
;;genetic family histories; assesses the risk of disease occurrence or
;;recurrence; identifies interventions to manage or ameliorate disease risk;
;;educates about inheritance, testing, management, prevention, ethical
;;issues, resources, and research; and counsels to promote informed choices
;;and adaptation. Certification was established in 1993 by the American
;;Board of Genetic Counseling and prior to that by the American Board of
;;Medical Genetics. Requirements for experience, licensure, and job
;;responsibilities vary among the states.
;;
;;Source: National Society of Genetic Counselors [7/1/2005: new]
;;END
Q
;
GETDATA ; get definitions
N XUI,XUY
S XUI=1170
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P571 2380 printed Dec 13, 2024@02:08:11 Page 2
XU8P571 ; BA/BP - PERSON CLASSES; 05/10/11
+1 ;;8.0;KERNEL;**571**; July 10, 1995;Build 1
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
POST ;
+1 ;clean entry 1170 if existed
DO DEL
+2 ;add entry 1170 in the file
DO ADD
+3 ;update definition for entries
DO DEF
+4 QUIT
+5 ;
ADD ;add the entry 1170
+1 NEW XUDATA
+2 SET XUDATA="1170^Other Service Providers^Genetic Counselor, MS^^V082201^170300000X^^I"
+3 DO ADD1(XUDATA)
+4 QUIT
+5 ;
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,"^",5)
+9 SET FDA(8932.1,"+1,",6)=$PIECE(XUD,"^",6)
+10 SET FDA(8932.1,"+1,",8)=$PIECE(XUD,"^",7)
+11 SET FDA(8932.1,"+1,",90002)=$PIECE(XUD,"^",8)
+12 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
+13 QUIT
+14 ;
DEL ; Delete entries
+1 NEW XU560,DIK,DA
+2 SET XU560=1170
SET DIK="^USC(8932.1,"
SET DA=XU560
DO ^DIK
+3 QUIT
+4 ;
DEF ; Update definitions
+1 NEW XUI
+2 SET XUI=1170
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 ;
1170 ;
+1 ;;A masters trained health care provider who collects and interprets
+2 ;;genetic family histories; assesses the risk of disease occurrence or
+3 ;;recurrence; identifies interventions to manage or ameliorate disease risk;
+4 ;;educates about inheritance, testing, management, prevention, ethical
+5 ;;issues, resources, and research; and counsels to promote informed choices
+6 ;;and adaptation. Certification was established in 1993 by the American
+7 ;;Board of Genetic Counseling and prior to that by the American Board of
+8 ;;Medical Genetics. Requirements for experience, licensure, and job
+9 ;;responsibilities vary among the states.
+10 ;;
+11 ;;Source: National Society of Genetic Counselors [7/1/2005: new]
+12 ;;END
+13 QUIT
+14 ;
GETDATA ; get definitions
+1 NEW XUI,XUY
+2 SET XUI=1170
+3 SET XUY=$GET(^USC(8932.1,XUI,11,0))
SET XUY=$PIECE(XUY,"^",3)
+4 IF XUY>0
DO GETDES(XUI,XUY)
+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
