PRSXP50.m

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 ---PRSXP50   1706     printed  Apr 09, 2024@21:27:19                                                                                                                                                                                                     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