SD53157P.m

SD53157P ;ALB/JLU;POST INIT FOR PATCH SD*5.3*157;10/15/98

 ;;5.3;Scheduling;**157**;Aug 13, 1993

 ;

EN ;Main entry point

 N PARIEN,PCMM,PCMMOUT,PCMMERR,PCMMPAR

 ;

 D FIND^DIC(3.8,"",.01,"X","SCMC PCMM REASSIGNMENT","","","","","PCMMOUT","PCMMERR")

 ;

 ;check for error from call

 I $D(PCMMERR("DIERR")) D  G EXIT

 .D BMES^XPDUTL("An error has been recorded:")

 .D MES^XPDUTL(PCMMERR("DIERR",1,"TEXT",1))

 .Q

 ;

 ;check to see if the mail group was installed.

 I +$G(PCMMOUT("DILIST",0))<1 D  G EXIT

 .D BMES^XPDUTL("Could not find the SCMC PCMM REASSIGNMENT mail group.")

 .D MES^XPDUTL("The REASSIGNMENT MAIL GROUP parameter will not be populated.  Consult")

 .D MES^XPDUTL("National VISTA Support.")

 .Q

 ;

 ;get scheduling parameter file entry

 S PARIEN=$O(^SD(404.91,0))

 I 'PARIEN D BMES^XPDUTL("No entry exists in the Scheduling Parameter file.  No update occured.") G EXIT

 I $P(^SD(404.91,PARIEN,"PCMM"),U,4)]"" D BMES^XPDUTL("REASSIGNMENT MAIL GROUP Parameter already populated.  No updating performed.") G EXIT

 ;

 D CLEAN

 ;stuffing mail group into pcmm parameter.

 S PCMMPAR(404.91,PARIEN_",",804)="SCMC PCMM REASSIGNMENT"

 D FILE^DIE("E","PCMMPAR","PCMMERR")

 I $D(PCMMERR("DIERR")) D  G EXIT

 .D BMES^XPDUTL("The Scheduling Parameter file field REASSIGNMENT MAIL GROUP, could")

 .D MES^XPDUTL("not be updated.  The following error has occured.")

 .D BMES^XPDUTL(PCMMERR("DIERR",1,"TEXT",1))

 .Q

 D BMES^XPDUTL("The Scheduling Parameter file field REASSIGNMENT MAIL GROUP has been updated.")

 ;

EXIT D CLEAN

 Q

 ;

CLEAN ;

 K PCMMERR("DIERR"),PCMMOUT("DILIST")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SD53157P   1619     printed  Apr 09, 2024@22:02:33                                                                                                                                                                                                    Page 2

SD53157P  ;ALB/JLU;POST INIT FOR PATCH SD*5.3*157;10/15/98

 +1       ;;5.3;Scheduling;**157**;Aug 13, 1993

 +2       ;

EN        ;Main entry point

 +1        NEW PARIEN,PCMM,PCMMOUT,PCMMERR,PCMMPAR

 +2       ;

 +3        DO FIND^DIC(3.8,"",.01,"X","SCMC PCMM REASSIGNMENT","","","","","PCMMOUT","PCMMERR")

 +4       ;

 +5       ;check for error from call

 +6        IF $DATA(PCMMERR("DIERR"))

               Begin DoDot:1

 +7                DO BMES^XPDUTL("An error has been recorded:")

 +8                DO MES^XPDUTL(PCMMERR("DIERR",1,"TEXT",1))

 +9                QUIT 

               End DoDot:1

               GOTO EXIT

 +10      ;

 +11      ;check to see if the mail group was installed.

 +12       IF +$GET(PCMMOUT("DILIST",0))<1

               Begin DoDot:1

 +13               DO BMES^XPDUTL("Could not find the SCMC PCMM REASSIGNMENT mail group.")

 +14               DO MES^XPDUTL("The REASSIGNMENT MAIL GROUP parameter will not be populated.  Consult")

 +15               DO MES^XPDUTL("National VISTA Support.")

 +16               QUIT 

               End DoDot:1

               GOTO EXIT

 +17      ;

 +18      ;get scheduling parameter file entry

 +19       SET PARIEN=$ORDER(^SD(404.91,0))

 +20       IF 'PARIEN

               DO BMES^XPDUTL("No entry exists in the Scheduling Parameter file.  No update occured.")

               GOTO EXIT

 +21       IF $PIECE(^SD(404.91,PARIEN,"PCMM"),U,4)]""

               DO BMES^XPDUTL("REASSIGNMENT MAIL GROUP Parameter already populated.  No updating performed.")

               GOTO EXIT

 +22      ;

 +23       DO CLEAN

 +24      ;stuffing mail group into pcmm parameter.

 +25       SET PCMMPAR(404.91,PARIEN_",",804)="SCMC PCMM REASSIGNMENT"

 +26       DO FILE^DIE("E","PCMMPAR","PCMMERR")

 +27       IF $DATA(PCMMERR("DIERR"))

               Begin DoDot:1

 +28               DO BMES^XPDUTL("The Scheduling Parameter file field REASSIGNMENT MAIL GROUP, could")

 +29               DO MES^XPDUTL("not be updated.  The following error has occured.")

 +30               DO BMES^XPDUTL(PCMMERR("DIERR",1,"TEXT",1))

 +31               QUIT 

               End DoDot:1

               GOTO EXIT

 +32       DO BMES^XPDUTL("The Scheduling Parameter file field REASSIGNMENT MAIL GROUP has been updated.")

 +33      ;

EXIT       DO CLEAN

 +1        QUIT 

 +2       ;

CLEAN     ;

 +1        KILL PCMMERR("DIERR"),PCMMOUT("DILIST")

 +2        QUIT