XU8P264A ;OAK-BP/BDT ;PERSON CLASS CODE UNDATE; [12/4/02 12:24pm]
;;8.0;KERNEL;**264**; Jul 10, 1995
;;This routine updates Person Class file
;- Add sixty new entries.
;- Inactivate two existing entries.
START ;Print message about post-install
N XUA,XU1,XUDATA,DAYINAC
S DAYINAC=DT
S XUA(1)="",XUA(2)=">>>XU*8*264 Post-Install...",XUA(3)=""
D MES^XPDUTL(.XUA)
;loop through DATA^XUP264
F XU1=1:1 S XUDATA=$P($T(DATA+XU1^XU8P264),";",4,99) Q:XUDATA="$END$" X $$ADD(XU1+674,XUDATA)
;call function INAC to inactivate entries 180 and 659
X $$INAC(180,DAYINAC)
X $$INAC(659,DAYINAC)
S XUA(1)="",XUA(2)=">>>XU*8*264 Post-Install complete..",XUA(3)=""
D MES^XPDUTL(.XUA)
Q
;
ADD(X,Y) ;add new entries.
I ^USC(8932.1,X,0)'=Y S ^USC(8932.1,X,0)=Y W "-"
Q ""
;
INAC(X,Y) ;inactivate an entries
N XUA
L +^USC(8932.1,X,0):10 I '$T D Q
.S XUA(1)="",XUA(2)=">>>Record # "_X_" locked at time of patch installation. Could not inactivate." D MES^XPDUTL(.XUA)
S $P(^USC(8932.1,X,0),"^",4)="i"
S $P(^USC(8932.1,X,0),"^",5)=Y
L -^USC(8932.1,X,0) Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P264A 1089 printed Dec 13, 2024@02:07:06 Page 2
XU8P264A ;OAK-BP/BDT ;PERSON CLASS CODE UNDATE; [12/4/02 12:24pm]
+1 ;;8.0;KERNEL;**264**; Jul 10, 1995
+2 ;;This routine updates Person Class file
+3 ;- Add sixty new entries.
+4 ;- Inactivate two existing entries.
START ;Print message about post-install
+1 NEW XUA,XU1,XUDATA,DAYINAC
+2 SET DAYINAC=DT
+3 SET XUA(1)=""
SET XUA(2)=">>>XU*8*264 Post-Install..."
SET XUA(3)=""
+4 DO MES^XPDUTL(.XUA)
+5 ;loop through DATA^XUP264
+6 FOR XU1=1:1
SET XUDATA=$PIECE($TEXT(DATA+XU1^XU8P264),";",4,99)
if XUDATA="$END$"
QUIT
XECUTE $$ADD(XU1+674,XUDATA)
+7 ;call function INAC to inactivate entries 180 and 659
+8 XECUTE $$INAC(180,DAYINAC)
+9 XECUTE $$INAC(659,DAYINAC)
+10 SET XUA(1)=""
SET XUA(2)=">>>XU*8*264 Post-Install complete.."
SET XUA(3)=""
+11 DO MES^XPDUTL(.XUA)
+12 QUIT
+13 ;
ADD(X,Y) ;add new entries.
+1 IF ^USC(8932.1,X,0)'=Y
SET ^USC(8932.1,X,0)=Y
WRITE "-"
+2 QUIT ""
+3 ;
INAC(X,Y) ;inactivate an entries
+1 NEW XUA
+2 LOCK +^USC(8932.1,X,0):10
IF '$TEST
Begin DoDot:1
+3 SET XUA(1)=""
SET XUA(2)=">>>Record # "_X_" locked at time of patch installation. Could not inactivate."
DO MES^XPDUTL(.XUA)
End DoDot:1
QUIT
+4 SET $PIECE(^USC(8932.1,X,0),"^",4)="i"
+5 SET $PIECE(^USC(8932.1,X,0),"^",5)=Y
+6 LOCK -^USC(8932.1,X,0)
QUIT ""