PSS262PO ;BIR/KML-Post Install routine for patch PSS*1*262 ;10/19/2023
;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
;External reference to ^XOB(18.02 supported by DBIA 5814
;External reference to ^XOB(18.12 supported by DBIA 7204
;Reference to REGREST^XOBWLIB is supported by DBIA# 5421
;
; registers an additional entry to the WEB SERVICE FILE #18.02 in global ^XOB(18.02,
; defines an additional entry to the WEB SERVER FILE #18.12 in global ^XOB(18.12,
; performs web service calls to validate the server connections
; adds entries to the APSP INTERVENTION TYPE file (#9009032.3) in global ^APSPQA(32.3,
;
; *****************PLEASE REVIEW FOLLOWING STATEMENT*********************************
; BEFORE GO LIVE, THE WEB SERVER AND WEB SERVICE DETAILS FOR PSS PGX-HDR
; NEED TO BE ESTABLISHED. WHAT URLS WILL PRODUCTION SITES CONNECT TO? NOT TEST SERVERS WHICH IS WHAT
; IS PRESENTLY BEING PERFORMED BELOW
;
EN ; main
N PSSLN,HDRERROR,XMSUB
S (PSSLN,HDRERROR)=0
K ^TMP("PSS262PO",$J)
D HDRWS
D APSP
D MENUS
D MENUSA
D URL
I HDRERROR D REPORT("PSS PGX-HDR SERVICE","HDRERROR",.PSSLN) S XMSUB="PSS*1*262 Installation has Issues"
I 'HDRERROR D REPORT("Web Service definitions completed for PSS PGX-HDR SERVICE.","COMPLETE",.PSSLN) S XMSUB="PSS*1*262 Installation has completed."
D MAIL(XMSUB)
Q
;
HDRWS ; add the HDR web service, the HDR web server, and register
N WEBSERVICEIEN,WEBSERVERIEN,PSSSERVX S PSSSERVX=0
D BMES^XPDUTL(""),BMES^XPDUTL("Adding the new HDR server and HDR web service for MOCHA PGx:")
S WEBSERVICEIEN=$$WEBSERVICE("PSS PGX-HDR SERVICE","cds-wsclient/cds-service","/isAlive")
I 'WEBSERVICEIEN S HDRERROR=1 D REPORT("PSS PGX-HDR SERVICE has not been created","CREATE",.PSSLN)
S WEBSERVERIEN=$$WEBSERVER("PSS PGX-HDR SERVER",443,"hdrcluho.hdr.vaec.domain.ext","TRUE","encrypt_only_tlsv12",443)
I 'WEBSERVERIEN S HDRERROR=1 D REPORT("PSS PGX-HDR SERVER has not been created","CREATE",.PSSLN) Q
I PSSSERVX D SVR
I '$$ENABLEWS(WEBSERVERIEN,"PSS PGX-HDR SERVICE") S HDRERROR=1 D REPORT("PSS PGX-HDR SERVICE could not get enabled due to technical problems.","ENABLE",.PSSLN) Q
I '$$TESTWS(WEBSERVERIEN,"PSS PGX-HDR SERVICE",.PSSLN) D REPORT("PSS PGX-HDR SERVICE is not available.","CONNECT",.PSSLN)
Q
;
SVR ;Update server
N DR,DA,DIE,X,Y,DTOUT
S DA=WEBSERVERIEN,DIE=18.12,DR=".04////"_"hdrcluho.hdr.vaec.domain.ext" D ^DIE
I $$GET1^DIQ(18.12,WEBSERVERIEN,.04)'="hdrcluho.hdr.vaec.domain.ext" D REPORT("Invalid IP for PSS PGX-HDR SERVER","CREATE",.PSSLN) Q
Q
;
WEBSERVICE(PSSFLD01,PSSFLD200,PSSFLD201) ; add the new HDR web service to WEB SERVICE file (18.02)
; input:
; PSSFLD01 - name of the web service
; PSSFLD200 - CONTEXT ROOT of the web service
; PSSFLD201 - AVAILABILITY RESOURCE of the web service
; output:
; returns the ien of the newly created entry or if not created, then 0 is returned to indicate an error in registering
I $$FIND1^DIC(18.02,,"BX",PSSFLD01) D BMES^XPDUTL(" - The web service "_PSSFLD01_" is already defined.") Q 1
;register the web service (creates a new entry in file 18.02)
D REGREST^XOBWLIB(PSSFLD01,PSSFLD200,PSSFLD201) ; REGREST^XOBWLIB handles all messaging during post-install
Q $$FIND1^DIC(18.02,,"BX",PSSFLD01)
;
WEBSERVER(PSSFLD01,PSSFLD03,PSSFLD04,PSSFLD301,PSSFLD302,PSSFLD303) ; add the HDR web server to the WEB SERVER (#18.12) file
N SERVERIEN
S SERVERIEN=$$FIND1^DIC(18.12,,"BX",PSSFLD01) I SERVERIEN S PSSSERVX=1 D BMES^XPDUTL(" - The web server "_$G(PSSFLD01)_" is already defined.") Q SERVERIEN
N FDA,IENROOT,PSSERR
S FDA(18.12,"+1,",.01)=$G(PSSFLD01) ; NAME
S FDA(18.12,"+1,",.03)=$G(PSSFLD03) ; PORT
S FDA(18.12,"+1,",.04)=$G(PSSFLD04) ; SERVER ADDRESS
S FDA(18.12,"+1,",.06)="ENABLED" ; STATUS 1-ENABLED / 0-DISABLED
S FDA(18.12,"+1,",.07)=5 ; DEFAULT HTTP TIMEOUT
S FDA(18.12,"+1,",1.01)="NO" ; LOGIN REQUIRED
S FDA(18.12,"+1,",3.01)=$G(PSSFLD301) ; SSL ENABLED
S FDA(18.12,"+1,",3.02)=$G(PSSFLD302) ; SSL CONFIGURATION
S FDA(18.12,"+1,",3.03)=$G(PSSFLD303) ; SSL PORT
D UPDATE^DIE("E","FDA","IENROOT","PSSERR")
I $D(PSSERR) S SERVERIEN=0
E S SERVERIEN=IENROOT(1)
Q SERVERIEN
;
ENABLEWS(SERVERIEN,TEXT) ; enable the web service
;Output - 1 OR 0
; 1 = successfully enabled
; 0 = ERROR occurred during filing
N IENROOT,PSSERR,FDA
S FDA(18.121,"?+1,"_SERVERIEN_",",.01)=TEXT ; WEB SERVICE
S FDA(18.121,"?+1,"_SERVERIEN_",",.06)="ENABLED" ; STATUS 1-ENABLED / 0-DISABLED
D UPDATE^DIE("E","FDA","IENROOT","PSSERR")
I $D(PSSERR) S IENROOT(1)=0
Q IENROOT(1)
;
TESTWS(WSDA,SERVICE,LINE) ; -- test web services availability
D BMES^XPDUTL(""),BMES^XPDUTL("Testing the Web Service availability for "_SERVICE)
N PSSSRVR,PSSX,PSSDOTS,PSSI,PSSXX,ERROR,AVAIL,RESULTS
S (AVAIL,ERROR)=0
S RESULTS=1
S PSSSRVR=##class(xobw.WebServer).%OpenId(WSDA)
S PSSDOTS=1 ; -- write dots during check processing
S PSSX=PSSSRVR.checkWebServicesAvailability(PSSDOTS)
I PSSX]"",PSSX.Count()>0 D
. F PSSI=1:1:PSSX.Count() S PSSXX=PSSX.GetAt(PSSI) Q:PSSI="" D
. . S LINE=LINE+1
. . I PSSXX["ERROR" S ERROR=1
. . I PSSXX["PGX_ORDER_CHECKS is available" S AVAIL=1,^TMP("PSS262PO",$J,LINE)=$E(PSSXX,3,) D BMES^XPDUTL(" - "_$E(PSSXX,3,))
. . I PSSXX["PSS PGX-HDR SERVICE is available" S AVAIL=1,^TMP("PSS262PO",$J,LINE)=$E(PSSXX,3,) D BMES^XPDUTL(" - "_$E(PSSXX,3,))
I (ERROR)!('AVAIL) S RESULTS=0
Q RESULTS
;
APSP ; add intervention type entries to file 9009032.3
N X,PSSTYPE
D BMES^XPDUTL(""),BMES^XPDUTL("Adding the new intervention type entries to the APSP INTERVENTION TYPE"),BMES^XPDUTL(" (#9009032.3) file:")
F X=1:1:2 S PSSTYPE=$P($T(APSPTXT+X),";",2) D
. I $$FIND1^DIC(9009032.3,"","X",PSSTYPE,"B") D BMES^XPDUTL(" - "_PSSTYPE_" intervention type already exists.") Q
. D BMES^XPDUTL("Adding '"_PSSTYPE_"' Intervention Type")
. D ADDIT(PSSTYPE)
. I '$$FIND1^DIC(9009032.3,"","X",PSSTYPE,"B") D REPORT("Cannot create '"_PSSTYPE_"' Intervention Type.","CREATE",.PSSLN) Q
. D BMES^XPDUTL(" - Intervention Type '"_PSSTYPE_"' successfully added.")
Q
;
N PSSMENU,PSSMENUQ,PSSMENUR,PSSMENUA,PSSMENUC
S PSSMENUQ=0
D BMES^XPDUTL(""),BMES^XPDUTL("Restructuring the PSS menus:")
S PSSMENU=$$LKOPT^XPDMENU("PSS MGR") I 'PSSMENU D Q
.D REPORT("Cannot find PSS MGR Menu option.","CREATE",.PSSLN) Q
I $$FIND1^DIC(19.01,","_PSSMENU_",","X","PSS CHECK DRUG INTERACTION","B") D
.S PSSMENUR=$$DELETE^XPDMENU("PSS MGR","PSS CHECK DRUG INTERACTION")
.I PSSMENUR D BMES^XPDUTL(" - PSS CHECK DRUG INTERACTION removed from PSS MGR....") Q
.D REPORT("Unable to remove PSS CHECK DRUG INTERACTION from PSS MGR ....","CREATE",.PSSLN)
S PSSMENUC=0 F PSSMENUA="PSS CHECK DRUG INTERACTION","PSS CHECK PGX INTERACTION","PSS ORDER CHECK CHANGES","PSS REPORT LOCAL INTERACTIONS" D
.S PSSMENUC=PSSMENUC+1
.S PSSMENUR=$$ADD^XPDMENU("PSS ORDER CHECK MANAGEMENT",PSSMENUA,,PSSMENUC)
.I PSSMENUR D BMES^XPDUTL(" - "_PSSMENUA_" added to the PSS ORDER CHECK MANAGEMENT option.") Q
.D REPORT("Unable to add "_PSSMENUA_" to the PSS ORDER CHECK MANAGEMENT option.","CREATE",.PSSLN)
Q
;
N PSSMENA,PSSMENB
F PSSMENA="PSO USER1","PSO MANAGER","PSJU MGR","PSJI MGR" D
.S PSSMENB=$$ADD^XPDMENU(PSSMENA,"PSS CHECK PGX INTERACTION")
.I PSSMENB D BMES^XPDUTL(" - PSS CHECK PGX INTERACTION added to the "_PSSMENA_" Menu option.") Q
.D REPORT("Unable to add PSS CHECK PGX INTERACTION added to the "_PSSMENA_" Menu option.","CREATE",.PSSLN)
Q
;
URL ; Add PGx URL to Pharmacy System File
I '$D(^PS(59.7,1)) D REPORT("Pharmacy System (#59.7) File entry not found.","CREATE",.PSSLN)
S $P(^PS(59.7,1,"PGX"),"^")="https://bit.ly/VA-PGx"
Q
;
ADDIT(PSSTYPE) ; Add the new intervention type
N PSSFDA,PSSERR
S PSSFDA(9009032.3,"+1,",.01)=PSSTYPE
D UPDATE^DIE("","PSSFDA",,"PSSERR")
Q
;
APSPTXT ; the 2 new intervention types added to the APSP INTERVENTION file
;PHARMACOGENOMIC HIGH ORDER CHECK
;PHARMACOGENOMIC MEDIUM ORDER CHECK
Q
;
MAIL(XMSUB) ;Send mail message
N X,XMTEXT,XMY,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ,XMDUN
S XMDUZ="PSS*1*262 Install"
S XMTEXT="^TMP(""PSS262PO"",$J,"
S XMY("G.PSS ORDER CHECKS")=""
S XMY(DUZ)=""
N DIFROM D ^XMD
Q
;
REPORT(TEXT,ACTION,LINE) ; report activity during installation including error conditions
; Input -
; TEXT - text to report to end-user
; ACTION - what processing occurred
; LINE - line number for the mail message passed in by reference
D:ACTION="CREATE" 1
D:ACTION="HDRERROR" 2
D:ACTION="COMPLETE" 3
D:ACTION="CONNECT" 4
D:ACTION="ENABLE" 4
Q
;
1 D BMES^XPDUTL(" - "_TEXT),BMES^XPDUTL(" Please contact product support.")
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=" - "_TEXT
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=" Please log a SNOW Ticket and refer to this message."
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=""
Q
;
2 D BMES^XPDUTL("********************************************************************************")
D BMES^XPDUTL(" ** Due to error(s) "_TEXT_" definition is not complete. **")
D BMES^XPDUTL("********************************************************************************")
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=""
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)="** Due to error(s), "_TEXT_" definition is not complete. **"
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=""
Q
;
3 D BMES^XPDUTL(""),BMES^XPDUTL(TEXT),BMES^XPDUTL("")
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=""
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=TEXT
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=""
Q
;
4 D BMES^XPDUTL(" - "_TEXT),BMES^XPDUTL(" Please contact product support.")
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=" - "_TEXT
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=" Please log a SNOW ticket and refer to this message."
S LINE=LINE+1
S ^TMP("PSS262PO",$J,LINE)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS262PO 10072 printed Mar 25, 2026@15:53:47 Page 2
PSS262PO ;BIR/KML-Post Install routine for patch PSS*1*262 ;10/19/2023
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
+2 ;External reference to ^XOB(18.02 supported by DBIA 5814
+3 ;External reference to ^XOB(18.12 supported by DBIA 7204
+4 ;Reference to REGREST^XOBWLIB is supported by DBIA# 5421
+5 ;
+6 ; registers an additional entry to the WEB SERVICE FILE #18.02 in global ^XOB(18.02,
+7 ; defines an additional entry to the WEB SERVER FILE #18.12 in global ^XOB(18.12,
+8 ; performs web service calls to validate the server connections
+9 ; adds entries to the APSP INTERVENTION TYPE file (#9009032.3) in global ^APSPQA(32.3,
+10 ;
+11 ; *****************PLEASE REVIEW FOLLOWING STATEMENT*********************************
+12 ; BEFORE GO LIVE, THE WEB SERVER AND WEB SERVICE DETAILS FOR PSS PGX-HDR
+13 ; NEED TO BE ESTABLISHED. WHAT URLS WILL PRODUCTION SITES CONNECT TO? NOT TEST SERVERS WHICH IS WHAT
+14 ; IS PRESENTLY BEING PERFORMED BELOW
+15 ;
EN ; main
+1 NEW PSSLN,HDRERROR,XMSUB
+2 SET (PSSLN,HDRERROR)=0
+3 KILL ^TMP("PSS262PO",$JOB)
+4 DO HDRWS
+5 DO APSP
+6 DO MENUS
+7 DO MENUSA
+8 DO URL
+9 IF HDRERROR
DO REPORT("PSS PGX-HDR SERVICE","HDRERROR",.PSSLN)
SET XMSUB="PSS*1*262 Installation has Issues"
+10 IF 'HDRERROR
DO REPORT("Web Service definitions completed for PSS PGX-HDR SERVICE.","COMPLETE",.PSSLN)
SET XMSUB="PSS*1*262 Installation has completed."
+11 DO MAIL(XMSUB)
+12 QUIT
+13 ;
HDRWS ; add the HDR web service, the HDR web server, and register
+1 NEW WEBSERVICEIEN,WEBSERVERIEN,PSSSERVX
SET PSSSERVX=0
+2 DO BMES^XPDUTL("")
DO BMES^XPDUTL("Adding the new HDR server and HDR web service for MOCHA PGx:")
+3 SET WEBSERVICEIEN=$$WEBSERVICE("PSS PGX-HDR SERVICE","cds-wsclient/cds-service","/isAlive")
+4 IF 'WEBSERVICEIEN
SET HDRERROR=1
DO REPORT("PSS PGX-HDR SERVICE has not been created","CREATE",.PSSLN)
+5 SET WEBSERVERIEN=$$WEBSERVER("PSS PGX-HDR SERVER",443,"hdrcluho.hdr.vaec.domain.ext","TRUE","encrypt_only_tlsv12",443)
+6 IF 'WEBSERVERIEN
SET HDRERROR=1
DO REPORT("PSS PGX-HDR SERVER has not been created","CREATE",.PSSLN)
QUIT
+7 IF PSSSERVX
DO SVR
+8 IF '$$ENABLEWS(WEBSERVERIEN,"PSS PGX-HDR SERVICE")
SET HDRERROR=1
DO REPORT("PSS PGX-HDR SERVICE could not get enabled due to technical problems.","ENABLE",.PSSLN)
QUIT
+9 IF '$$TESTWS(WEBSERVERIEN,"PSS PGX-HDR SERVICE",.PSSLN)
DO REPORT("PSS PGX-HDR SERVICE is not available.","CONNECT",.PSSLN)
+10 QUIT
+11 ;
SVR ;Update server
+1 NEW DR,DA,DIE,X,Y,DTOUT
+2 SET DA=WEBSERVERIEN
SET DIE=18.12
SET DR=".04////"_"hdrcluho.hdr.vaec.domain.ext"
DO ^DIE
+3 IF $$GET1^DIQ(18.12,WEBSERVERIEN,.04)'="hdrcluho.hdr.vaec.domain.ext"
DO REPORT("Invalid IP for PSS PGX-HDR SERVER","CREATE",.PSSLN)
QUIT
+4 QUIT
+5 ;
WEBSERVICE(PSSFLD01,PSSFLD200,PSSFLD201) ; add the new HDR web service to WEB SERVICE file (18.02)
+1 ; input:
+2 ; PSSFLD01 - name of the web service
+3 ; PSSFLD200 - CONTEXT ROOT of the web service
+4 ; PSSFLD201 - AVAILABILITY RESOURCE of the web service
+5 ; output:
+6 ; returns the ien of the newly created entry or if not created, then 0 is returned to indicate an error in registering
+7 IF $$FIND1^DIC(18.02,,"BX",PSSFLD01)
DO BMES^XPDUTL(" - The web service "_PSSFLD01_" is already defined.")
QUIT 1
+8 ;register the web service (creates a new entry in file 18.02)
+9 ; REGREST^XOBWLIB handles all messaging during post-install
DO REGREST^XOBWLIB(PSSFLD01,PSSFLD200,PSSFLD201)
+10 QUIT $$FIND1^DIC(18.02,,"BX",PSSFLD01)
+11 ;
WEBSERVER(PSSFLD01,PSSFLD03,PSSFLD04,PSSFLD301,PSSFLD302,PSSFLD303) ; add the HDR web server to the WEB SERVER (#18.12) file
+1 NEW SERVERIEN
+2 SET SERVERIEN=$$FIND1^DIC(18.12,,"BX",PSSFLD01)
IF SERVERIEN
SET PSSSERVX=1
DO BMES^XPDUTL(" - The web server "_$GET(PSSFLD01)_" is already defined.")
QUIT SERVERIEN
+3 NEW FDA,IENROOT,PSSERR
+4 ; NAME
SET FDA(18.12,"+1,",.01)=$GET(PSSFLD01)
+5 ; PORT
SET FDA(18.12,"+1,",.03)=$GET(PSSFLD03)
+6 ; SERVER ADDRESS
SET FDA(18.12,"+1,",.04)=$GET(PSSFLD04)
+7 ; STATUS 1-ENABLED / 0-DISABLED
SET FDA(18.12,"+1,",.06)="ENABLED"
+8 ; DEFAULT HTTP TIMEOUT
SET FDA(18.12,"+1,",.07)=5
+9 ; LOGIN REQUIRED
SET FDA(18.12,"+1,",1.01)="NO"
+10 ; SSL ENABLED
SET FDA(18.12,"+1,",3.01)=$GET(PSSFLD301)
+11 ; SSL CONFIGURATION
SET FDA(18.12,"+1,",3.02)=$GET(PSSFLD302)
+12 ; SSL PORT
SET FDA(18.12,"+1,",3.03)=$GET(PSSFLD303)
+13 DO UPDATE^DIE("E","FDA","IENROOT","PSSERR")
+14 IF $DATA(PSSERR)
SET SERVERIEN=0
+15 IF '$TEST
SET SERVERIEN=IENROOT(1)
+16 QUIT SERVERIEN
+17 ;
ENABLEWS(SERVERIEN,TEXT) ; enable the web service
+1 ;Output - 1 OR 0
+2 ; 1 = successfully enabled
+3 ; 0 = ERROR occurred during filing
+4 NEW IENROOT,PSSERR,FDA
+5 ; WEB SERVICE
SET FDA(18.121,"?+1,"_SERVERIEN_",",.01)=TEXT
+6 ; STATUS 1-ENABLED / 0-DISABLED
SET FDA(18.121,"?+1,"_SERVERIEN_",",.06)="ENABLED"
+7 DO UPDATE^DIE("E","FDA","IENROOT","PSSERR")
+8 IF $DATA(PSSERR)
SET IENROOT(1)=0
+9 QUIT IENROOT(1)
+10 ;
TESTWS(WSDA,SERVICE,LINE) ; -- test web services availability
+1 DO BMES^XPDUTL("")
DO BMES^XPDUTL("Testing the Web Service availability for "_SERVICE)
+2 NEW PSSSRVR,PSSX,PSSDOTS,PSSI,PSSXX,ERROR,AVAIL,RESULTS
+3 SET (AVAIL,ERROR)=0
+4 SET RESULTS=1
+5 SET PSSSRVR=##class(xobw.WebServer).%OpenId(WSDA)
+6 ; -- write dots during check processing
SET PSSDOTS=1
+7 SET PSSX=PSSSRVR.checkWebServicesAvailability(PSSDOTS)
+8 IF PSSX]""
IF PSSX.Count()>0
Begin DoDot:1
+9 FOR PSSI=1:1:PSSX.Count()
SET PSSXX=PSSX.GetAt(PSSI)
if PSSI=""
QUIT
Begin DoDot:2
+10 SET LINE=LINE+1
+11 IF PSSXX["ERROR"
SET ERROR=1
+12 IF PSSXX["PGX_ORDER_CHECKS is available"
SET AVAIL=1
SET ^TMP("PSS262PO",$JOB,LINE)=$EXTRACT(PSSXX,3,)
DO BMES^XPDUTL(" - "_$EXTRACT(PSSXX,3,))
+13 IF PSSXX["PSS PGX-HDR SERVICE is available"
SET AVAIL=1
SET ^TMP("PSS262PO",$JOB,LINE)=$EXTRACT(PSSXX,3,)
DO BMES^XPDUTL(" - "_$EXTRACT(PSSXX,3,))
End DoDot:2
End DoDot:1
+14 IF (ERROR)!('AVAIL)
SET RESULTS=0
+15 QUIT RESULTS
+16 ;
APSP ; add intervention type entries to file 9009032.3
+1 NEW X,PSSTYPE
+2 DO BMES^XPDUTL("")
DO BMES^XPDUTL("Adding the new intervention type entries to the APSP INTERVENTION TYPE")
DO BMES^XPDUTL(" (#9009032.3) file:")
+3 FOR X=1:1:2
SET PSSTYPE=$PIECE($TEXT(APSPTXT+X),";",2)
Begin DoDot:1
+4 IF $$FIND1^DIC(9009032.3,"","X",PSSTYPE,"B")
DO BMES^XPDUTL(" - "_PSSTYPE_" intervention type already exists.")
QUIT
+5 DO BMES^XPDUTL("Adding '"_PSSTYPE_"' Intervention Type")
+6 DO ADDIT(PSSTYPE)
+7 IF '$$FIND1^DIC(9009032.3,"","X",PSSTYPE,"B")
DO REPORT("Cannot create '"_PSSTYPE_"' Intervention Type.","CREATE",.PSSLN)
QUIT
+8 DO BMES^XPDUTL(" - Intervention Type '"_PSSTYPE_"' successfully added.")
End DoDot:1
+9 QUIT
+10 ;
+1 NEW PSSMENU,PSSMENUQ,PSSMENUR,PSSMENUA,PSSMENUC
+2 SET PSSMENUQ=0
+3 DO BMES^XPDUTL("")
DO BMES^XPDUTL("Restructuring the PSS menus:")
+4 SET PSSMENU=$$LKOPT^XPDMENU("PSS MGR")
IF 'PSSMENU
Begin DoDot:1
+5 DO REPORT("Cannot find PSS MGR Menu option.","CREATE",.PSSLN)
QUIT
End DoDot:1
QUIT
+6 IF $$FIND1^DIC(19.01,","_PSSMENU_",","X","PSS CHECK DRUG INTERACTION","B")
Begin DoDot:1
+7 SET PSSMENUR=$$DELETE^XPDMENU("PSS MGR","PSS CHECK DRUG INTERACTION")
+8 IF PSSMENUR
DO BMES^XPDUTL(" - PSS CHECK DRUG INTERACTION removed from PSS MGR....")
QUIT
+9 DO REPORT("Unable to remove PSS CHECK DRUG INTERACTION from PSS MGR ....","CREATE",.PSSLN)
End DoDot:1
+10 SET PSSMENUC=0
FOR PSSMENUA="PSS CHECK DRUG INTERACTION","PSS CHECK PGX INTERACTION","PSS ORDER CHECK CHANGES","PSS REPORT LOCAL INTERACTIONS"
Begin DoDot:1
+11 SET PSSMENUC=PSSMENUC+1
+12 SET PSSMENUR=$$ADD^XPDMENU("PSS ORDER CHECK MANAGEMENT",PSSMENUA,,PSSMENUC)
+13 IF PSSMENUR
DO BMES^XPDUTL(" - "_PSSMENUA_" added to the PSS ORDER CHECK MANAGEMENT option.")
QUIT
+14 DO REPORT("Unable to add "_PSSMENUA_" to the PSS ORDER CHECK MANAGEMENT option.","CREATE",.PSSLN)
End DoDot:1
+15 QUIT
+16 ;
+1 NEW PSSMENA,PSSMENB
+2 FOR PSSMENA="PSO USER1","PSO MANAGER","PSJU MGR","PSJI MGR"
Begin DoDot:1
+3 SET PSSMENB=$$ADD^XPDMENU(PSSMENA,"PSS CHECK PGX INTERACTION")
+4 IF PSSMENB
DO BMES^XPDUTL(" - PSS CHECK PGX INTERACTION added to the "_PSSMENA_" Menu option.")
QUIT
+5 DO REPORT("Unable to add PSS CHECK PGX INTERACTION added to the "_PSSMENA_" Menu option.","CREATE",.PSSLN)
End DoDot:1
+6 QUIT
+7 ;
URL ; Add PGx URL to Pharmacy System File
+1 IF '$DATA(^PS(59.7,1))
DO REPORT("Pharmacy System (#59.7) File entry not found.","CREATE",.PSSLN)
+2 SET $PIECE(^PS(59.7,1,"PGX"),"^")="https://bit.ly/VA-PGx"
+3 QUIT
+4 ;
ADDIT(PSSTYPE) ; Add the new intervention type
+1 NEW PSSFDA,PSSERR
+2 SET PSSFDA(9009032.3,"+1,",.01)=PSSTYPE
+3 DO UPDATE^DIE("","PSSFDA",,"PSSERR")
+4 QUIT
+5 ;
APSPTXT ; the 2 new intervention types added to the APSP INTERVENTION file
+1 ;PHARMACOGENOMIC HIGH ORDER CHECK
+2 ;PHARMACOGENOMIC MEDIUM ORDER CHECK
+3 QUIT
+4 ;
MAIL(XMSUB) ;Send mail message
+1 NEW X,XMTEXT,XMY,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ,XMDUN
+2 SET XMDUZ="PSS*1*262 Install"
+3 SET XMTEXT="^TMP(""PSS262PO"",$J,"
+4 SET XMY("G.PSS ORDER CHECKS")=""
+5 SET XMY(DUZ)=""
+6 NEW DIFROM
DO ^XMD
+7 QUIT
+8 ;
REPORT(TEXT,ACTION,LINE) ; report activity during installation including error conditions
+1 ; Input -
+2 ; TEXT - text to report to end-user
+3 ; ACTION - what processing occurred
+4 ; LINE - line number for the mail message passed in by reference
+5 if ACTION="CREATE"
DO 1
+6 if ACTION="HDRERROR"
DO 2
+7 if ACTION="COMPLETE"
DO 3
+8 if ACTION="CONNECT"
DO 4
+9 if ACTION="ENABLE"
DO 4
+10 QUIT
+11 ;
1 DO BMES^XPDUTL(" - "_TEXT)
DO BMES^XPDUTL(" Please contact product support.")
+1 SET LINE=LINE+1
+2 SET ^TMP("PSS262PO",$JOB,LINE)=" - "_TEXT
+3 SET LINE=LINE+1
+4 SET ^TMP("PSS262PO",$JOB,LINE)=" Please log a SNOW Ticket and refer to this message."
+5 SET LINE=LINE+1
+6 SET ^TMP("PSS262PO",$JOB,LINE)=""
+7 QUIT
+8 ;
2 DO BMES^XPDUTL("********************************************************************************")
+1 DO BMES^XPDUTL(" ** Due to error(s) "_TEXT_" definition is not complete. **")
+2 DO BMES^XPDUTL("********************************************************************************")
+3 SET LINE=LINE+1
+4 SET ^TMP("PSS262PO",$JOB,LINE)=""
+5 SET LINE=LINE+1
+6 SET ^TMP("PSS262PO",$JOB,LINE)="** Due to error(s), "_TEXT_" definition is not complete. **"
+7 SET LINE=LINE+1
+8 SET ^TMP("PSS262PO",$JOB,LINE)=""
+9 QUIT
+10 ;
3 DO BMES^XPDUTL("")
DO BMES^XPDUTL(TEXT)
DO BMES^XPDUTL("")
+1 SET LINE=LINE+1
+2 SET ^TMP("PSS262PO",$JOB,LINE)=""
+3 SET LINE=LINE+1
+4 SET ^TMP("PSS262PO",$JOB,LINE)=TEXT
+5 SET LINE=LINE+1
+6 SET ^TMP("PSS262PO",$JOB,LINE)=""
+7 QUIT
+8 ;
4 DO BMES^XPDUTL(" - "_TEXT)
DO BMES^XPDUTL(" Please contact product support.")
+1 SET LINE=LINE+1
+2 SET ^TMP("PSS262PO",$JOB,LINE)=" - "_TEXT
+3 SET LINE=LINE+1
+4 SET ^TMP("PSS262PO",$JOB,LINE)=" Please log a SNOW ticket and refer to this message."
+5 SET LINE=LINE+1
+6 SET ^TMP("PSS262PO",$JOB,LINE)=""
+7 QUIT
