SD53B204.m

SD53B204 ;bp/cmf - Patch SD*5.3*204 post-init routine ; 12/06/99 

 ;;5.3;Scheduling;**204**;AUG 13, 1993

 ;

POST ;update c/s files

 ;

 ;initialize new pcmm parameter file fields

 ; add default value to RPC Time Limit field

 ; add default value to HL7 Transmit Limit field

 D BMESS("Updating PCMM files.")

 D MESS("Updating PCMM Parameter file.")

 N SCFDA,SC1ERR,SCX

 K SCFDA(1)

 S SCFDA(1,404.44,"1,",14)=30

 S SCFDA(1,404.44,"1,",15)=999999

 D FILE^DIE("","SCFDA(1)","SC1ERR")

 I $D(SC1ERR) D WMESS("PCMM Parameter file not updated properly.")

 ;

DSER ;disable old server entries (build active client list)

 D MESS("Disabling obsolete entries in Server Patch file.")

 N SC2LIST,SC2ERR,SCY,SC3LIST

 S SCX=$$ACTSER^SCMCUT("","SC2LIST")

 I 'SCX D MESS("No active Server Patch entries.") G P205

 S SCX=""

 F  S SCX=$O(SC2LIST(SCX)) Q:SCX']""  D

 . ;build active client list

 . S SCY=$$CLNLST^SCMCUT(SCX,"SC3LIST",1)

 . S SCY=0

 . F  S SCY=$O(^SCTM(404.45,"ACT",SCX,0)) Q:'SCY  D

 . . K SCFDA(2)

 . . S SCFDA(2,404.45,SCY_",",.04)=0

 . . D FILE^DIE("","SCFDA(2)","SC2ERR")

 . . Q

 . Q

 I $D(SC2ERR) D WMESS("Obsolete Server Patch entries not disabled.")

 ;

DCLI ;disable old client entries

 D MESS("Disabling obsolete entries in Client Patch file.")

 I '$D(SC3LIST) D MESS("No active Client Patch entries.") G P205

 N SC3ERR

 S SCX=""

 F  S SCX=$O(SC3LIST(SCX)) Q:SCX']""  D

 . K SCFDA(3)

 . S SCY=$O(^SCTM(404.46,"B",SCX,0))

 . S SCFDA(3,404.46,SCY_",",.02)=0

 . D FILE^DIE("","SCFDA(3)","SC3ERR")

 . Q

 I $D(SC3ERR) D WMESS("Obsolete Client Patch entries not disabled.")

 ;

P205 ;patch 205 record keeping

 D MESS("Updating SD*5.3*205 related entries.")

 S SCX=$$UPCLNLST^SCMCUT("SD*5.3*205^NullClient^1^0^0")

 I +SCX<1 D WMESS("SD*5.3*205 related entries not updated.")

 ;

P204 ;patch 204 record keeping

 D MESS("Updating SD*5.3*204 related entries.")

 S SCX=$$UPCLNLST^SCMCUT("SD*5.3*204^1.2.2.0^1^1^1")

 I +SCX<1 D WMESS("SD*5.3*204 related entries not updated.")

 ;

Q D MESS("")

 D MESS("PCMM files update finished.")

 Q

 ;

BMESS(SCX) ;

 D BMES^XPDUTL("******")

 D MESS(SCX)

 D MESS("")

 Q

 ;

WMESS(SCX) ;

 D MESS(" WARNING:")

 D MESS(" ."_SCX)

 Q

 ;

MESS(SCX) ;

 D MES^XPDUTL("."_SCX)

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SD53B204   2270     printed  Feb 19, 2025@00:12:05                                                                                                                                                                                                    Page 2

SD53B204  ;bp/cmf - Patch SD*5.3*204 post-init routine ; 12/06/99 

 +1       ;;5.3;Scheduling;**204**;AUG 13, 1993

 +2       ;

POST      ;update c/s files

 +1       ;

 +2       ;initialize new pcmm parameter file fields

 +3       ; add default value to RPC Time Limit field

 +4       ; add default value to HL7 Transmit Limit field

 +5        DO BMESS("Updating PCMM files.")

 +6        DO MESS("Updating PCMM Parameter file.")

 +7        NEW SCFDA,SC1ERR,SCX

 +8        KILL SCFDA(1)

 +9        SET SCFDA(1,404.44,"1,",14)=30

 +10       SET SCFDA(1,404.44,"1,",15)=999999

 +11       DO FILE^DIE("","SCFDA(1)","SC1ERR")

 +12       IF $DATA(SC1ERR)

               DO WMESS("PCMM Parameter file not updated properly.")

 +13      ;

DSER      ;disable old server entries (build active client list)

 +1        DO MESS("Disabling obsolete entries in Server Patch file.")

 +2        NEW SC2LIST,SC2ERR,SCY,SC3LIST

 +3        SET SCX=$$ACTSER^SCMCUT("","SC2LIST")

 +4        IF 'SCX

               DO MESS("No active Server Patch entries.")

               GOTO P205

 +5        SET SCX=""

 +6        FOR 

               SET SCX=$ORDER(SC2LIST(SCX))

               if SCX']""

                   QUIT 

               Begin DoDot:1

 +7       ;build active client list

 +8                SET SCY=$$CLNLST^SCMCUT(SCX,"SC3LIST",1)

 +9                SET SCY=0

 +10               FOR 

                       SET SCY=$ORDER(^SCTM(404.45,"ACT",SCX,0))

                       if 'SCY

                           QUIT 

                       Begin DoDot:2

 +11                       KILL SCFDA(2)

 +12                       SET SCFDA(2,404.45,SCY_",",.04)=0

 +13                       DO FILE^DIE("","SCFDA(2)","SC2ERR")

 +14                       QUIT 

                       End DoDot:2

 +15               QUIT 

               End DoDot:1

 +16       IF $DATA(SC2ERR)

               DO WMESS("Obsolete Server Patch entries not disabled.")

 +17      ;

DCLI      ;disable old client entries

 +1        DO MESS("Disabling obsolete entries in Client Patch file.")

 +2        IF '$DATA(SC3LIST)

               DO MESS("No active Client Patch entries.")

               GOTO P205

 +3        NEW SC3ERR

 +4        SET SCX=""

 +5        FOR 

               SET SCX=$ORDER(SC3LIST(SCX))

               if SCX']""

                   QUIT 

               Begin DoDot:1

 +6                KILL SCFDA(3)

 +7                SET SCY=$ORDER(^SCTM(404.46,"B",SCX,0))

 +8                SET SCFDA(3,404.46,SCY_",",.02)=0

 +9                DO FILE^DIE("","SCFDA(3)","SC3ERR")

 +10               QUIT 

               End DoDot:1

 +11       IF $DATA(SC3ERR)

               DO WMESS("Obsolete Client Patch entries not disabled.")

 +12      ;

P205      ;patch 205 record keeping

 +1        DO MESS("Updating SD*5.3*205 related entries.")

 +2        SET SCX=$$UPCLNLST^SCMCUT("SD*5.3*205^NullClient^1^0^0")

 +3        IF +SCX<1

               DO WMESS("SD*5.3*205 related entries not updated.")

 +4       ;

P204      ;patch 204 record keeping

 +1        DO MESS("Updating SD*5.3*204 related entries.")

 +2        SET SCX=$$UPCLNLST^SCMCUT("SD*5.3*204^1.2.2.0^1^1^1")

 +3        IF +SCX<1

               DO WMESS("SD*5.3*204 related entries not updated.")

 +4       ;

Q          DO MESS("")

 +1        DO MESS("PCMM files update finished.")

 +2        QUIT 

 +3       ;

BMESS(SCX) ;

 +1        DO BMES^XPDUTL("******")

 +2        DO MESS(SCX)

 +3        DO MESS("")

 +4        QUIT 

 +5       ;

WMESS(SCX) ;

 +1        DO MESS(" WARNING:")

 +2        DO MESS(" ."_SCX)

 +3        QUIT 

 +4       ;

MESS(SCX) ;

 +1        DO MES^XPDUTL("."_SCX)

 +2        QUIT 

 +3       ;