XU8P132 ;ALB/JEH - XU*8*132 - POST INIT - ADD SPECIALTY CODES ;04/18/2000 08:26
;;8.0;KERNEL;**132**;Jul 10, 1995
;
POST ;Update Person Class file with specialty codes
S XUA(1)="",XUA(2)=">>>XU*8*132 Post-Install...",XUA(3)="" D MES^XPDUTL(.XUA) K XUA
;
EN ;Entry for processing specialty codes
S XUCNT=0
F XU1=1:1 S XUDATA=$P($T(DATA+XU1^XU8P1321),";;",2,99) Q:XUDATA="$END$" D UPDATE
F XU1=1:1 S XUDATA=$P($T(DATA+XU1^XU8P1322),";;",2,99) Q:XUDATA="$END$" D UPDATE
;
ENQ ;Display record count, kill variables and quit
S XUA(1)="",XUA(2)=">>>XU*8*132 Post-Install Complete..."_XUCNT_" specialty codes added",XUA(3)="" D MES^XPDUTL(.XUA)
K XUREC,XUDATA,XUIEN,XUA,XUCNT,XU1
Q
UPDATE ;Process to add new specialty codes
I $P(XUDATA,U,3)="" Q ;Quit if no specialty code
S XUREC=$G(^USC(8932.1,+XUDATA,0)) I XUREC="" D Q
.S XUA(1)="",XUA(2)=">>>There is an IEN in the patch routine that does not exist in the",XUA(3)=" Person Class file. Record # "_+XUDATA_" does not exist",XUA(4)="" D MES^XPDUTL(.XUA) K XUA
S XUIEN=+XUDATA
I $P(XUDATA,U,2)'=$P(XUREC,U,6) D Q
.S XUA(1)="",XUA(2)=">>>Person Class VA Code and the patch update VA Code do not match.",XUA(3)=" Could not update specialty code for record # "_XUIEN,XUA(4)="" D MES^XPDUTL(.XUA) K XUA
L +^USC(8932.1,XUIEN):10 I '$T D Q
.S XUA(1)="",XUA(2)=">>>Record # "_XUIEN_" locked at time of patch installation. Could not update.",XUA(3)="" D MES^XPDUTL(.XUA) K XUA
S DIE="^USC(8932.1,",DA=XUIEN,DR="8///"_$P(XUDATA,U,3)
D ^DIE K DIE,DA,DR
L -^USC(8932.1,XUIEN)
S XUCNT=XUCNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P132 1594 printed Dec 13, 2024@02:07 Page 2
XU8P132 ;ALB/JEH - XU*8*132 - POST INIT - ADD SPECIALTY CODES ;04/18/2000 08:26
+1 ;;8.0;KERNEL;**132**;Jul 10, 1995
+2 ;
POST ;Update Person Class file with specialty codes
+1 SET XUA(1)=""
SET XUA(2)=">>>XU*8*132 Post-Install..."
SET XUA(3)=""
DO MES^XPDUTL(.XUA)
KILL XUA
+2 ;
EN ;Entry for processing specialty codes
+1 SET XUCNT=0
+2 FOR XU1=1:1
SET XUDATA=$PIECE($TEXT(DATA+XU1^XU8P1321),";;",2,99)
if XUDATA="$END$"
QUIT
DO UPDATE
+3 FOR XU1=1:1
SET XUDATA=$PIECE($TEXT(DATA+XU1^XU8P1322),";;",2,99)
if XUDATA="$END$"
QUIT
DO UPDATE
+4 ;
ENQ ;Display record count, kill variables and quit
+1 SET XUA(1)=""
SET XUA(2)=">>>XU*8*132 Post-Install Complete..."_XUCNT_" specialty codes added"
SET XUA(3)=""
DO MES^XPDUTL(.XUA)
+2 KILL XUREC,XUDATA,XUIEN,XUA,XUCNT,XU1
+3 QUIT
UPDATE ;Process to add new specialty codes
+1 ;Quit if no specialty code
IF $PIECE(XUDATA,U,3)=""
QUIT
+2 SET XUREC=$GET(^USC(8932.1,+XUDATA,0))
IF XUREC=""
Begin DoDot:1
+3 SET XUA(1)=""
SET XUA(2)=">>>There is an IEN in the patch routine that does not exist in the"
SET XUA(3)=" Person Class file. Record # "_+XUDATA_" does not exist"
SET XUA(4)=""
DO MES^XPDUTL(.XUA)
KILL XUA
End DoDot:1
QUIT
+4 SET XUIEN=+XUDATA
+5 IF $PIECE(XUDATA,U,2)'=$PIECE(XUREC,U,6)
Begin DoDot:1
+6 SET XUA(1)=""
SET XUA(2)=">>>Person Class VA Code and the patch update VA Code do not match."
SET XUA(3)=" Could not update specialty code for record # "_XUIEN
SET XUA(4)=""
DO MES^XPDUTL(.XUA)
KILL XUA
End DoDot:1
QUIT
+7 LOCK +^USC(8932.1,XUIEN):10
IF '$TEST
Begin DoDot:1
+8 SET XUA(1)=""
SET XUA(2)=">>>Record # "_XUIEN_" locked at time of patch installation. Could not update."
SET XUA(3)=""
DO MES^XPDUTL(.XUA)
KILL XUA
End DoDot:1
QUIT
+9 SET DIE="^USC(8932.1,"
SET DA=XUIEN
SET DR="8///"_$PIECE(XUDATA,U,3)
+10 DO ^DIE
KILL DIE,DA,DR
+11 LOCK -^USC(8932.1,XUIEN)
+12 SET XUCNT=XUCNT+1
+13 QUIT
