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
;
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 ---[H[J[2J[HPSO7P735 1440 printed Dec 13, 2024@02:24:02 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 ;
+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
