XU8P571.m

XU8P571 ; BA/BP - PERSON CLASSES; 05/10/11

 ;;8.0;KERNEL;**571**; July 10, 1995;Build 4

 ;;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

XU8P571   ; BA/BP - PERSON CLASSES; 05/10/11

 +1       ;;8.0;KERNEL;**571**; July 10, 1995;Build 4

 +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