PSO7P735.m

PSO7P735 ;DAL/JCH - Post Install routine for patch PSO*7*735 ;8/9/2023

 ;;7.0;OUTPATIENT PHARMACY;**735**;DEC 1997;Build 6

 ;

 Q

 ;

POST ; Post Install Entry Point

 N DIFROM,DUZ

 S:'$G(DUZ) DUZ=.5

 ; Attach RPCs to menu

 D UPDVER("2.2.1.0")

 D RPCTOMENU

 Q

 ;

RPCTOMENU ; Add new PSO EPCS CRED RPC to PSO EPCS GUI CONTEXT menu.

 D ADDRPC("PSO EPCS CRED","PSO EPCS GUI CONTEXT")

 Q

 ;

UPDVER(GUIVER) ; Update EPCS GUI version in the PSO EPCS GUI CONTEXT option file (#19) entry

 N EPOPIENS,PSOFDA,PSOERR

 S:'$L(GUIVER) GUIVER="2.2.1.0"

 S EPOPIENS=$$FIND1^DIC(19,"","X","PSO EPCS GUI CONTEXT")

 S PSOFDA(19,EPOPIENS_",",1)="EPCS GUI Context version "_GUIVER

 D FILE^DIE(,"PSOFDA","PSOERR")

 S PSOERR=$G(PSOERR("DIERR",1,"TEXT",1)) I $L(PSOERR) D BMES^XPDUTL(PSOERR)

 Q

 ;

ADDRPC(RPCNAME,OPTNAME) ; Add RPCs

 N DA,DIC

 S DIC="^DIC(19,",DIC(0)="",X=OPTNAME D ^DIC

 I Y<0 D  Q

 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")

 . D MES^XPDUTL("Cannot find Option: """_OPTNAME_""".")

 . Q

 I '$D(^XWB(8994,"B",RPCNAME)) D  Q

 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")

 . D MES^XPDUTL("Cannot find RPC: """_RPCNAME_""".")

 . Q

 S DA(1)=+Y

 S DIC=DIC_DA(1)_",""RPC"","

 S DIC(0)="L" ; LAYGO should be allowed here

 S X=RPCNAME

 D ^DIC

 I Y<0 D  Q

 . D MES^XPDUTL("Error Adding RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")

 . Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSO7P735   1440     printed  Apr 09, 2024@21:25:49                                                                                                                                                                                                    Page 2

PSO7P735  ;DAL/JCH - Post Install routine for patch PSO*7*735 ;8/9/2023

 +1       ;;7.0;OUTPATIENT PHARMACY;**735**;DEC 1997;Build 6

 +2       ;

 +3        QUIT 

 +4       ;

POST      ; Post Install Entry Point

 +1        NEW DIFROM,DUZ

 +2        if '$GET(DUZ)

               SET DUZ=.5

 +3       ; Attach RPCs to menu

 +4        DO UPDVER("2.2.1.0")

 +5        DO RPCTOMENU

 +6        QUIT 

 +7       ;

RPCTOMENU ; Add new PSO EPCS CRED RPC to PSO EPCS GUI CONTEXT menu.

 +1        DO ADDRPC("PSO EPCS CRED","PSO EPCS GUI CONTEXT")

 +2        QUIT 

 +3       ;

UPDVER(GUIVER) ; Update EPCS GUI version in the PSO EPCS GUI CONTEXT option file (#19) entry

 +1        NEW EPOPIENS,PSOFDA,PSOERR

 +2        if '$LENGTH(GUIVER)

               SET GUIVER="2.2.1.0"

 +3        SET EPOPIENS=$$FIND1^DIC(19,"","X","PSO EPCS GUI CONTEXT")

 +4        SET PSOFDA(19,EPOPIENS_",",1)="EPCS GUI Context version "_GUIVER

 +5        DO FILE^DIE(,"PSOFDA","PSOERR")

 +6        SET PSOERR=$GET(PSOERR("DIERR",1,"TEXT",1))

           IF $LENGTH(PSOERR)

               DO BMES^XPDUTL(PSOERR)

 +7        QUIT 

 +8       ;

ADDRPC(RPCNAME,OPTNAME) ; Add RPCs

 +1        NEW DA,DIC

 +2        SET DIC="^DIC(19,"

           SET DIC(0)=""

           SET X=OPTNAME

           DO ^DIC

 +3        IF Y<0

               Begin DoDot:1

 +4                DO MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")

 +5                DO MES^XPDUTL("Cannot find Option: """_OPTNAME_""".")

 +6                QUIT 

               End DoDot:1

               QUIT 

 +7        IF '$DATA(^XWB(8994,"B",RPCNAME))

               Begin DoDot:1

 +8                DO MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")

 +9                DO MES^XPDUTL("Cannot find RPC: """_RPCNAME_""".")

 +10               QUIT 

               End DoDot:1

               QUIT 

 +11       SET DA(1)=+Y

 +12       SET DIC=DIC_DA(1)_",""RPC"","

 +13      ; LAYGO should be allowed here

           SET DIC(0)="L"

 +14       SET X=RPCNAME

 +15       DO ^DIC

 +16       IF Y<0

               Begin DoDot:1

 +17               DO MES^XPDUTL("Error Adding RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")

 +18               QUIT 

               End DoDot:1

               QUIT 

 +19       QUIT