PRSXP50 ;WCIOFO/MGD-POST INIT FOR PATCH 50 CLASS LENGTH--9/01/99
;;4.0;PAID;**50**;Sep 21, 1995
;
; Post install loops through ^PRSE(452.1, and looks for any classes
; with a name that is exactly 53 characters long. For each unique
; class entry found the program will then see if the related file
; entries in the #452 are correct and if not it will update the
; entries.
;
Q
;
FIX ; Quit if patch has been previously installed
N NAME,REC,XNAME,DA,DR,DIE,TOTREC,BADREC,TOTCLASS
S (TOTREC,BADREC,TOTCLASS)=0
I $$PATCH^XPDUTL("PRS*4.0*50") D Q
.D BMES^XPDUTL(" Post install routine skipped since PRS*4*50 was previously installed.")
;
;
; Loop through ^PRSE(452.1, and looks for any unique classes with a
; name that is exactly 53 characters long.
;
S REC=0
D MES^XPDUTL(" Class Updated - # Records Updated")
D MES^XPDUTL(" __________________________________")
F S REC=$O(^PRSE(452.1,REC)) Q:'REC D
.S NAME=$P($G(^PRSE(452.1,REC,0)),U,1)
.S TOTCLASS=TOTCLASS+1
.; If class name is < 53 no problem so quit
.Q:$L(NAME)<53
.S XNAME=$E(NAME,1,52)
.; Quit if no entry in 452
.Q:'$D(^PRSE(452,"CLS",XNAME))
.; Get Record Number
.S DA=0
.S DIE="^PRSE(452,"
.S DR="1///^S X=NAME"
.S BADREC=0
.F S DA=$O(^PRSE(452,"CLS",XNAME,DA)) Q:'DA D
. .;For each record number update field #1
. .S BADREC=BADREC+1
. .D ^DIE
.D MES^XPDUTL(" "_NAME_" - "_BADREC)
.S TOTREC=TOTREC+BADREC
D BMES^XPDUTL(" "_TOTCLASS_" Classes were on file in 452.1.")
D MES^XPDUTL(" "_TOTREC_" Attendance records were updated in file 452.")
D BMES^XPDUTL(" Please delete routine PRSXP50 when installation is complete.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP50 1706 printed Nov 22, 2024@17:39:02 Page 2
PRSXP50 ;WCIOFO/MGD-POST INIT FOR PATCH 50 CLASS LENGTH--9/01/99
+1 ;;4.0;PAID;**50**;Sep 21, 1995
+2 ;
+3 ; Post install loops through ^PRSE(452.1, and looks for any classes
+4 ; with a name that is exactly 53 characters long. For each unique
+5 ; class entry found the program will then see if the related file
+6 ; entries in the #452 are correct and if not it will update the
+7 ; entries.
+8 ;
+9 QUIT
+10 ;
FIX ; Quit if patch has been previously installed
+1 NEW NAME,REC,XNAME,DA,DR,DIE,TOTREC,BADREC,TOTCLASS
+2 SET (TOTREC,BADREC,TOTCLASS)=0
+3 IF $$PATCH^XPDUTL("PRS*4.0*50")
Begin DoDot:1
+4 DO BMES^XPDUTL(" Post install routine skipped since PRS*4*50 was previously installed.")
End DoDot:1
QUIT
+5 ;
+6 ;
+7 ; Loop through ^PRSE(452.1, and looks for any unique classes with a
+8 ; name that is exactly 53 characters long.
+9 ;
+10 SET REC=0
+11 DO MES^XPDUTL(" Class Updated - # Records Updated")
+12 DO MES^XPDUTL(" __________________________________")
+13 FOR
SET REC=$ORDER(^PRSE(452.1,REC))
if 'REC
QUIT
Begin DoDot:1
+14 SET NAME=$PIECE($GET(^PRSE(452.1,REC,0)),U,1)
+15 SET TOTCLASS=TOTCLASS+1
+16 ; If class name is < 53 no problem so quit
+17 if $LENGTH(NAME)<53
QUIT
+18 SET XNAME=$EXTRACT(NAME,1,52)
+19 ; Quit if no entry in 452
+20 if '$DATA(^PRSE(452,"CLS",XNAME))
QUIT
+21 ; Get Record Number
+22 SET DA=0
+23 SET DIE="^PRSE(452,"
+24 SET DR="1///^S X=NAME"
+25 SET BADREC=0
+26 FOR
SET DA=$ORDER(^PRSE(452,"CLS",XNAME,DA))
if 'DA
QUIT
Begin DoDot:2
+27 ;For each record number update field #1
+28 SET BADREC=BADREC+1
+29 DO ^DIE
End DoDot:2
+30 DO MES^XPDUTL(" "_NAME_" - "_BADREC)
+31 SET TOTREC=TOTREC+BADREC
End DoDot:1
+32 DO BMES^XPDUTL(" "_TOTCLASS_" Classes were on file in 452.1.")
+33 DO MES^XPDUTL(" "_TOTREC_" Attendance records were updated in file 452.")
+34 DO BMES^XPDUTL(" Please delete routine PRSXP50 when installation is complete.")
+35 QUIT
