XU8P509 ; BP/BDT - POST ROUTINE; 9/8/08
;;8.0;KERNEL;**509**;Jul 10, 1995;Build 1
;;"Per VHA Directive 2004-038, this routine should not be modified".
Q
POST ; Post routine for XU*8*509
D DEL ;delete entries 1137-1152 if they exist
D ADD ;add entries 1137-1152
D DEF^XU8P509A,DEF^XU8P509B ;modify definition texts
D DEF^XU8P509C,DEF^XU8P509D ;add definition texts
D DELXU8P ; delete routines XU8P509A,B,C,D
Q
DELXU8P ;
;Delete the routine XU8P509A,B,C,D:
N X F X="XU8P509A","XU8P509B","XU8P509C","XU8P509D" X ^%ZOSF("DEL")
Q
;
ADD ; Add new entries from 1137-1152
N XUI,XUDATA
F XUI=1:1:16 S XUDATA=$T(DATA+XUI) Q:XUDATA=" ;;END" D
. S XUDATA=$P(XUDATA,";;",2) Q:XUDATA="END"
. 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 entry
N XUI F XUI=1137:1:1152 D
. N DIK,DA S DIK="^USC(8932.1,",DA=XUI D ^DIK
Q
;
GET ;Get information of entries from the Person Class file
N XUI
F XUI=1137:1:1152 D GET1(XUI)
Q
;
GET1(XUIEN) ; Get information of given entry from Person Class file.
N XUI
S XUI=$G(^USC(8932.1,XUIEN,0))
S XUI=" ;;"_XUIEN_"^"_$P(XUI,"^",1,3)_"^"_$P(XUI,"^",6,9) W !,XUI
Q
;
DATA ; information of entries from 1137-1152
;;1137^Allopathic & Osteopathic Physicians^Family Medicine^Sleep Medicine^V180707^207QS1201X^08
;;1138^Behavioral Health & Social Service Providers^Behavioral Analyst^^V010700^103K00000X
;;1139^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Gerontology^V130110^225XG0600X^67
;;1140^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Mental Health^V130111^225XM0800X^67
;;1141^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Physical Rehabilitation^V130112^225XP0019X^67
;;1142^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Environmental Modification^V130113^225XE0001X^67
;;1143^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Feeding, Eating & Swallowing^V130114^225XF0002X^67
;;1144^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Low Vision^V130115^225XL0004X^67
;;1145^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapy Assistant^Feeding, Eating & Swallowing^V130116^224ZF0002X^67
;;1146^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapy Assistant^Low Vision^V130117^224ZL0004X^67
;;1147^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapy Assistant^Driving & Community Mobility^V130118^224ZR0403X^67
;;1148^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapy Assistant^Environmental Modification^V130119^224ZE0001X^67
;;1149^Technologists, Technicians & Other Technical Service Providers^Radiology Practitioner Assistant^^V153000^243U00000X^
;;1150^Agencies^In Home Supportive Care^^^253Z00000X^^N
;;1151^Behavioral Health & Social Service Providers^Psychologist^Health Psychologist^V010422^103TH0004X^68
;;1152^Allopathic & Osteopathic Physicians^Physical Medicine & Rehabilitation^Hospice and Palliative Medicine^V182605^2081H0002X^25
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P509 3661 printed Sep 23, 2025@19:44:04 Page 2
XU8P509 ; BP/BDT - POST ROUTINE; 9/8/08
+1 ;;8.0;KERNEL;**509**;Jul 10, 1995;Build 1
+2 ;;"Per VHA Directive 2004-038, this routine should not be modified".
+3 QUIT
POST ; Post routine for XU*8*509
+1 ;delete entries 1137-1152 if they exist
DO DEL
+2 ;add entries 1137-1152
DO ADD
+3 ;modify definition texts
DO DEF^XU8P509A
DO DEF^XU8P509B
+4 ;add definition texts
DO DEF^XU8P509C
DO DEF^XU8P509D
+5 ; delete routines XU8P509A,B,C,D
DO DELXU8P
+6 QUIT
DELXU8P ;
+1 ;Delete the routine XU8P509A,B,C,D:
+2 NEW X
FOR X="XU8P509A","XU8P509B","XU8P509C","XU8P509D"
XECUTE ^%ZOSF("DEL")
+3 QUIT
+4 ;
ADD ; Add new entries from 1137-1152
+1 NEW XUI,XUDATA
+2 FOR XUI=1:1:16
SET XUDATA=$TEXT(DATA+XUI)
if XUDATA=" ;;END"
QUIT
Begin DoDot:1
+3 SET XUDATA=$PIECE(XUDATA,";;",2)
if XUDATA="END"
QUIT
+4 DO ADD1(XUDATA)
End DoDot:1
+5 QUIT
+6 ;
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 entry
+1 NEW XUI
FOR XUI=1137:1:1152
Begin DoDot:1
+2 NEW DIK,DA
SET DIK="^USC(8932.1,"
SET DA=XUI
DO ^DIK
End DoDot:1
+3 QUIT
+4 ;
GET ;Get information of entries from the Person Class file
+1 NEW XUI
+2 FOR XUI=1137:1:1152
DO GET1(XUI)
+3 QUIT
+4 ;
GET1(XUIEN) ; Get information of given entry from Person Class file.
+1 NEW XUI
+2 SET XUI=$GET(^USC(8932.1,XUIEN,0))
+3 SET XUI=" ;;"_XUIEN_"^"_$PIECE(XUI,"^",1,3)_"^"_$PIECE(XUI,"^",6,9)
WRITE !,XUI
+4 QUIT
+5 ;
DATA ; information of entries from 1137-1152
+1 ;;1137^Allopathic & Osteopathic Physicians^Family Medicine^Sleep Medicine^V180707^207QS1201X^08
+2 ;;1138^Behavioral Health & Social Service Providers^Behavioral Analyst^^V010700^103K00000X
+3 ;;1139^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Gerontology^V130110^225XG0600X^67
+4 ;;1140^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Mental Health^V130111^225XM0800X^67
+5 ;;1141^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Physical Rehabilitation^V130112^225XP0019X^67
+6 ;;1142^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Environmental Modification^V130113^225XE0001X^67
+7 ;;1143^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Feeding, Eating & Swallowing^V130114^225XF0002X^67
+8 ;;1144^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapist^Low Vision^V130115^225XL0004X^67
+9 ;;1145^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapy Assistant^Feeding, Eating & Swallowing^V130116^224ZF0002X^67
+10 ;;1146^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapy Assistant^Low Vision^V130117^224ZL0004X^67
+11 ;;1147^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapy Assistant^Driving & Community Mobility^V130118^224ZR0403X^67
+12 ;;1148^Respiratory, Rehabilitative and Restorative Service Providers^Occupational Therapy Assistant^Environmental Modification^V130119^224ZE0001X^67
+13 ;;1149^Technologists, Technicians & Other Technical Service Providers^Radiology Practitioner Assistant^^V153000^243U00000X^
+14 ;;1150^Agencies^In Home Supportive Care^^^253Z00000X^^N
+15 ;;1151^Behavioral Health & Social Service Providers^Psychologist^Health Psychologist^V010422^103TH0004X^68
+16 ;;1152^Allopathic & Osteopathic Physicians^Physical Medicine & Rehabilitation^Hospice and Palliative Medicine^V182605^2081H0002X^25
+17 ;;END
