SR224UTL ;HDSO/DSK - YEARLY CPT EXCLUSION UPDATES; Apr 13, 2026@16:31
;;3.0;Surgery;**224**;24 Jun 93;Build 2
;
ENV ;
S SRBACKUP="SR"_$E($T(+1),3,5)_" PRE INSTALL BACKUP"
I $D(^XTMP(SRBACKUP)) D
. ;Field test sites will already have a backup, so they can continue the install.
. N DIR,DTOUT,DUOUT,Y
. S DIR(0)="YN",DIR("B")="NO"
. S DIR("A",1)="Backup of the CPT EXCLUSIONS (#137) file has already occurred."
. S DIR("A",2)="If this site was a field test site for patch SR*3.0*220,"
. S DIR("A",3)="patch installation may proceed."
. S DIR("A")="Was this site a field test site"
. D ^DIR
. I $D(DUOUT)!($D(DTOUT))!('Y) D
. . S XPDABORT=1
. . D BMES^XPDUTL($$CJ^XLFSTR("Submit a ServiceNow ticket for assistance.",80))
. . K ^XTMP(SRBACKUP,1)
Q
;
PRE ;
N SRBACKUP
S SRBACKUP="SR"_$E($T(+1),3,5)_" PRE INSTALL BACKUP"
;Do not back up again if field test site already backed the file up.
I $D(^XTMP(SRBACKUP,1)) D Q
. D BMES^XPDUTL($$CJ^XLFSTR("Backup of CPT EXCLUSIONS (#137) file not needed",80))
. D BMES^XPDUTL($$CJ^XLFSTR("if backup was already performed and this is a field test site.",80))
S ^XTMP(SRBACKUP,0)=$$FMADD^XLFDT(DT,120)_"^"_$G(DT)_"^Backup of file 137 before update"
D BMES^XPDUTL($$CJ^XLFSTR("Backing up the CPT EXCLUSIONS file (#137) to ^XTMP("""_SRBACKUP_""")",80))
M ^XTMP(SRBACKUP,137)=^SRO(137) S ^XTMP(SRBACKUP,1)=DT
D BMES^XPDUTL($$CJ^XLFSTR("Backup complete.",80))
Q
;
POST ; -- post-install process
N SRI,SRJ,SRLIST,SRX,SRY,DA,X
F SRJ=1:1 S SRLIST=$P($T(ADDS+SRJ)," ;;",2) Q:SRLIST="" D
. F SRI=1:1 S SRX=$P(SRLIST,",",SRI) Q:SRX="" I $D(^ICPT("B",SRX)) D
. . S SRY=$O(^ICPT("B",SRX,0)) Q:SRY=""
. . ;Do not add if code is already in the file.
. . I '$D(^SRO(137,SRY)) D
. . . K DA,DIC,DD,DO,DINUM S (DINUM,X)=SRY
. . . S DIC="^SRO(137,",DIC(0)="L" D FILE^DICN
D BMES^XPDUTL($$CJ^XLFSTR(" Update of CPT EXCLUSIONS (#137) file completed.",80))
Q
;
BACK ; -- rollback
N SRBACKUP
S SRBACKUP="SR"_$E($T(+1),3,5)_" PRE INSTALL BACKUP"
I '$D(^XTMP(SRBACKUP)) D Q
. W !,"Backup file has not been set yet or was set and was deleted after six months."
I '$D(^SRO(137,0))#2 D Q
. W !,"File #137 hasn't been set up yet, so no data to delete."
W !,"Restoring file 137 from the backup..."
K ^SRO(137)
S ^SRO(137,0)="CPT EXCLUSIONS^137P^^0"
M ^SRO(137)=^XTMP(SRBACKUP,137)
;Kill the backup in case the patch needs to be installed again.
K ^XTMP(SRBACKUP)
W !!,"Rollback completed."
Q
;
ADDS ;
;;0948T,0949T,0950T,0961T,0962T,0963T,0964T,0965T,0966T,0967T
;;0972T,0973T,0974T,0975T,0976T,0977T,0981T,0982T,0983T,0984T
;;0986T,0988T,0989T,0990T,0991T,0992T,0993T,0996T,0997T,0998T
;;0999T,1000T,1001T,1002T,1003T,1004T,1005T,1006T,1007T,1008T
;;1009T,1010T,1011T,1012T,1016T,1017T,1018T,1020T,1021T,1022T
;;1023T,1024T,1025T,47384,52443,55707,55708,55709,55710,55711
;;55712,55713,55714,55715,55877,64567,64654,64655,64656,64657
;;64658,64659,64728,70471,70472,70473,75577,77436,77437,77438
;;77439,81354,81524,87182,87183,87494,87627,87812,90382,90481
;;90482,90483,90484,90593,90612,90613,90631,90635,91124,91125
;;91323,92288,92628,92629,92631,92632,92634,92635,92636,92637
;;92638,92639,92641,92642,92930,92945,93145,93146,97007,97008
;;97009,98979,98984,98985,98986,99445,99470
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR224UTL 3351 printed Aug 19, 2026@23:49:47 Page 2
SR224UTL ;HDSO/DSK - YEARLY CPT EXCLUSION UPDATES; Apr 13, 2026@16:31
+1 ;;3.0;Surgery;**224**;24 Jun 93;Build 2
+2 ;
ENV ;
+1 SET SRBACKUP="SR"_$EXTRACT($TEXT(+1),3,5)_" PRE INSTALL BACKUP"
+2 IF $DATA(^XTMP(SRBACKUP))
Begin DoDot:1
+3 ;Field test sites will already have a backup, so they can continue the install.
+4 NEW DIR,DTOUT,DUOUT,Y
+5 SET DIR(0)="YN"
SET DIR("B")="NO"
+6 SET DIR("A",1)="Backup of the CPT EXCLUSIONS (#137) file has already occurred."
+7 SET DIR("A",2)="If this site was a field test site for patch SR*3.0*220,"
+8 SET DIR("A",3)="patch installation may proceed."
+9 SET DIR("A")="Was this site a field test site"
+10 DO ^DIR
+11 IF $DATA(DUOUT)!($DATA(DTOUT))!('Y)
Begin DoDot:2
+12 SET XPDABORT=1
+13 DO BMES^XPDUTL($$CJ^XLFSTR("Submit a ServiceNow ticket for assistance.",80))
+14 KILL ^XTMP(SRBACKUP,1)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
PRE ;
+1 NEW SRBACKUP
+2 SET SRBACKUP="SR"_$EXTRACT($TEXT(+1),3,5)_" PRE INSTALL BACKUP"
+3 ;Do not back up again if field test site already backed the file up.
+4 IF $DATA(^XTMP(SRBACKUP,1))
Begin DoDot:1
+5 DO BMES^XPDUTL($$CJ^XLFSTR("Backup of CPT EXCLUSIONS (#137) file not needed",80))
+6 DO BMES^XPDUTL($$CJ^XLFSTR("if backup was already performed and this is a field test site.",80))
End DoDot:1
QUIT
+7 SET ^XTMP(SRBACKUP,0)=$$FMADD^XLFDT(DT,120)_"^"_$GET(DT)_"^Backup of file 137 before update"
+8 DO BMES^XPDUTL($$CJ^XLFSTR("Backing up the CPT EXCLUSIONS file (#137) to ^XTMP("""_SRBACKUP_""")",80))
+9 MERGE ^XTMP(SRBACKUP,137)=^SRO(137)
SET ^XTMP(SRBACKUP,1)=DT
+10 DO BMES^XPDUTL($$CJ^XLFSTR("Backup complete.",80))
+11 QUIT
+12 ;
POST ; -- post-install process
+1 NEW SRI,SRJ,SRLIST,SRX,SRY,DA,X
+2 FOR SRJ=1:1
SET SRLIST=$PIECE($TEXT(ADDS+SRJ)," ;;",2)
if SRLIST=""
QUIT
Begin DoDot:1
+3 FOR SRI=1:1
SET SRX=$PIECE(SRLIST,",",SRI)
if SRX=""
QUIT
IF $DATA(^ICPT("B",SRX))
Begin DoDot:2
+4 SET SRY=$ORDER(^ICPT("B",SRX,0))
if SRY=""
QUIT
+5 ;Do not add if code is already in the file.
+6 IF '$DATA(^SRO(137,SRY))
Begin DoDot:3
+7 KILL DA,DIC,DD,DO,DINUM
SET (DINUM,X)=SRY
+8 SET DIC="^SRO(137,"
SET DIC(0)="L"
DO FILE^DICN
End DoDot:3
End DoDot:2
End DoDot:1
+9 DO BMES^XPDUTL($$CJ^XLFSTR(" Update of CPT EXCLUSIONS (#137) file completed.",80))
+10 QUIT
+11 ;
BACK ; -- rollback
+1 NEW SRBACKUP
+2 SET SRBACKUP="SR"_$EXTRACT($TEXT(+1),3,5)_" PRE INSTALL BACKUP"
+3 IF '$DATA(^XTMP(SRBACKUP))
Begin DoDot:1
+4 WRITE !,"Backup file has not been set yet or was set and was deleted after six months."
End DoDot:1
QUIT
+5 IF '$DATA(^SRO(137,0))#2
Begin DoDot:1
+6 WRITE !,"File #137 hasn't been set up yet, so no data to delete."
End DoDot:1
QUIT
+7 WRITE !,"Restoring file 137 from the backup..."
+8 KILL ^SRO(137)
+9 SET ^SRO(137,0)="CPT EXCLUSIONS^137P^^0"
+10 MERGE ^SRO(137)=^XTMP(SRBACKUP,137)
+11 ;Kill the backup in case the patch needs to be installed again.
+12 KILL ^XTMP(SRBACKUP)
+13 WRITE !!,"Rollback completed."
+14 QUIT
+15 ;
ADDS ;
+1 ;;0948T,0949T,0950T,0961T,0962T,0963T,0964T,0965T,0966T,0967T
+2 ;;0972T,0973T,0974T,0975T,0976T,0977T,0981T,0982T,0983T,0984T
+3 ;;0986T,0988T,0989T,0990T,0991T,0992T,0993T,0996T,0997T,0998T
+4 ;;0999T,1000T,1001T,1002T,1003T,1004T,1005T,1006T,1007T,1008T
+5 ;;1009T,1010T,1011T,1012T,1016T,1017T,1018T,1020T,1021T,1022T
+6 ;;1023T,1024T,1025T,47384,52443,55707,55708,55709,55710,55711
+7 ;;55712,55713,55714,55715,55877,64567,64654,64655,64656,64657
+8 ;;64658,64659,64728,70471,70472,70473,75577,77436,77437,77438
+9 ;;77439,81354,81524,87182,87183,87494,87627,87812,90382,90481
+10 ;;90482,90483,90484,90593,90612,90613,90631,90635,91124,91125
+11 ;;91323,92288,92628,92629,92631,92632,92634,92635,92636,92637
+12 ;;92638,92639,92641,92642,92930,92945,93145,93146,97007,97008
+13 ;;97009,98979,98984,98985,98986,99445,99470
+14 QUIT
+15 ;
