Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSN513PO

PSN513PO.m

Go to the documentation of this file. 
  1. PSN513PO ;BIR/SJA-Post install routine for patch PSN*4*513 ; 19 Jan 2017  1:20 PM
  1.  ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
  1.  ;
  1.  Q
  1. POST ; -- post-install entry
  1.  N II,PSNA,ITEM,PSNSVR1 S PSSMXUA2=1
  1.  ; delete invalid hazard waste entries 
  1.  S II=0 F  S II=$O(^PSNDF(50.68,II)) Q:'II  D
  1.  . I $G(^PSNDF(50.68,II,"HAZTODIS2",0))=0 K ^PSNDF(50.68,II,"HAZTODIS2",0)
  1.  ;
  1.  D BMES^XPDUTL("Rebuilding National Drug File Menu....")
  1.  D ADD
  1.  D BMES^XPDUTL("Rebuilding menus complete.")
  1.  D PPSN
  1.  D SETWS
  1.  S PSNSVR1=$$FILESRVR("PPSN","vaausppsapp21.aac.domain.ext",443)
  1.  D SERVICE("UPDATE_STATUS","PPSN",PSNSVR1) ; add web service to web server
  1.  Q
  1.  ;
  1. ADD ; -- add new menu option and update order for PSNMGR & PSN PPS MENU
  1.  S PSNA=$$ADD^XPDMENU("PSNMGR","PSNPMIS PRINT","PMIS",9)
  1.  S PSNA=$$ADD^XPDMENU("PSNMGR","PSN MED GUIDE","FDA",10)
  1.  S PSNA=$$ADD^XPDMENU("PSNMGR","PSN PPS MENU","PPS",20)
  1.  D BMES^XPDUTL("  PSN PPS MENU option "_$S('+$G(PSNA):"NOT ",1:"")_"added to menu PSNMGR")
  1.  D BMES^XPDUTL("Updating PSN PPS MENU menu display order...")
  1.  S ITEM="PSN PPS SCHEDULE DOWNLOAD",PSNA=$$ADD^XPDMENU("PSN PPS MENU",ITEM,"SD",1) D MSG(ITEM,PSNA)
  1.  S ITEM="PSN PPS SCHEDULE INSTALL",PSNA=$$ADD^XPDMENU("PSN PPS MENU",ITEM,"SI",2)
  1.  S ITEM="PSN PPS MANUAL DOWNLOAD",PSNA=$$ADD^XPDMENU("PSN PPS MENU",ITEM,"MD",3)
  1.  S ITEM="PSN PPS MANUAL INSTALL",PSNA=$$ADD^XPDMENU("PSN PPS MENU",ITEM,"MI",4)
  1.  S ITEM="PSN PPS REJECT FILE",PSNA=$$ADD^XPDMENU("PSN PPS MENU",ITEM,"RJ",5)
  1.  S ITEM="PSN PPS PARAM",PSNA=$$ADD^XPDMENU("PSN PPS MENU",ITEM,"SP",6)
  1.  D MES^XPDUTL("Display order updated")
  1.  Q
  1. MSG(ITEM,PSNA) ; -- write message
  1.  D BMES^XPDUTL("  "_ITEM_" option "_$S('+$G(PSNA):"NOT ",1:"")_"added to menu PSN PPS MENU")
  1.  Q
  1. PPSN ; -- add new entry in ^PS(57.23 if it doesn't exist
  1.  Q:$O(^PS(57.23,0))
  1.  N PSNTN,RADD,RUSR
  1.  K DA,DIC S X="PPSN",DIC="^PS(57.23,",DIC(0)="L" D FILE^DICN K DIC
  1.  S PSNTN=+Y
  1.  S RADD="vaausmocftpprd01.aac.domain.ext",RUSR="presftp"
  1.  S DA=PSNTN,DIE=57.23,DR="2///0;8///0;9///N;10///N;20///"_RADD_";22///"_RUSR_";45///Y" D ^DIE K DR
  1.  S $P(^PS(59.7,1,10),"^",12)="P"
  1.  Q
  1.  ;
  1. SETWS ;define UPDATE_STATUS web service
  1.  N PSSWSERV,PSSWSER2,PPSWPPSN,PSSWSCNT,PSSWSMSG,PSSWSSTA,PSSWSERR,DA,DIE,DIC,DR,X,Y,DLAYGO,WSARR
  1.  S (PSSWSERR,PSSWSCNT)=0,PSSMXUA2=1
  1.  S DIC="^XOB(18.12,",X="PPSN",DIC(0)="X" D ^DIC
  1.  I Y<1 D
  1.  .D BMES^XPDUTL("  Creating PPSN web server.") S PSSMXUA2=PSSMXUA2+1
  1.  .S WSARR("WSDL FILE")=""
  1.  .S WSARR("CACHE PACKAGE NAME")=""
  1.  .S WSARR("WEB SERVICE NAME")="PPSN"
  1.  .S WSARR("AVAILABILITY RESOURCE")="?wsdl"
  1.  .S XOBSTAT=$$GENPORT^XOBWLIB(.WSARR)
  1.  .S DIC="^XOB(18.12,",X="PPSN",DIC(0)=X
  1.  S PPSWPPSN=+Y K DIC  ;find the PPSN web server IEN
  1.  D BMES^XPDUTL("Beginning UPDATE_STATUS Web Service definition for PPSN web server: ")
  1.  S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Beginning UPDATE_STATUS Web Service definition: " S PSSMXUA2=PSSMXUA2+1
  1.  I PPSWPPSN=-1 D  G SETWSQT
  1.  .D BMES^XPDUTL("     PPSN Web Server is not defined. Please contact product support.") S PSSWSERR=1
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="  PPSN Web Server isn't defined and UPDATE_STATUS Web Service couldn't be" S PSSMXUA2=PSSMXUA2+1
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="     created.  Please log a National Help Desk Ticket and refer to this message." S PSSMXUA2=PSSMXUA2+1
  1. SETWS2 ;
  1.  S DIC="^XOB(18.02,",X="UPDATE_STATUS",DIC(0)="X" D ^DIC S PSSWSERV=+Y ;get the IEN for the UPDATE_STATUS web service
  1.  I +Y<1,PSSWSCNT=0 D REGREST^XOBWLIB("UPDATE_STATUS","/PRE/ndf/update/","status") H 3 S PSSWSCNT=1 G SETWS2  ;if not there register the web service
  1.  I +Y<1 D  H 3 G SETWSQT
  1.  .D BMES^XPDUTL("  UPDATE_STATUS web service has NOT been created. Please contact product support.")
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="  UPDATE_STATUS web service has NOT been defined.  Please log a" S PSSMXUA2=PSSMXUA2+1,PSSWSERR=1
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="  National Help Desk ticket and refer to this message." S PSSMXUA2=PSSMXUA2+1
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" " S PSSMXUA2=PSSMXUA2+1
  1.  S PSSWSMSG=$S(PSSWSCNT=0:"UPDATE_STATUS web service was previously defined.  No action taken.",1:"UPDATE_STATUS web service has been defined.")
  1.  S @XPDGREF@("PSSMLMSG",PSSMXUA2)="  "_PSSWSMSG S PSSMXUA2=PSSMXUA2+1
  1.  D BMES^XPDUTL("     "_PSSWSMSG)
  1.  ;
  1.  K DIC,DIE,DA,DR,X,Y
  1.  S DIC="^XOB(18.12,"_PPSWPPSN_",100,",X="UPDATE_STATUS",DIC(0)="X" D ^DIC S PSSWSER2=+Y
  1.  L +^XOB(18.12,PPSWPPSN):20 I '$T D  H 3 G SETWSQT
  1.  .D BMES^XPDUTL("     Unable to lock file 18.12 to enable UPDATE_STATUS web service. Please ")
  1.  .D BMES^XPDUTL("     contact product support.")
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="  Unable to lock file 18.12 to enable UPDATE_STATUS web service." S PSSMXUA2=PSSMXUA2+1
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="  Please contact the National Help Desk and refer to this message." S PSSMXUA2=PSSMXUA2+1,PSSWSERR=1
  1.  I PSSWSER2=-1 D PSSENABL G SETWSQT
  1.  S PSSWSSTA=$$GET1^DIQ(18.121,PSSWSER2_",1",".06","I")
  1.  I PSSWSSTA=-1 D PSSENABL G SETWSQT
  1.  I PSSWSSTA=""!(PSSWSSTA=0) D PSSENAB2 G SETWSQT
  1.  I PSSWSSTA D
  1.  .D BMES^XPDUTL("     UPDATE_STATUS web service was previously enabled.  No action taken.")
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="  UPDATE_STATUS web service was previously enabled. No action taken." S PSSMXUA2=PSSMXUA2+1
  1. SETWSQT ;
  1.  L -^XOB(18.12,PPSWPPSN)
  1.  I $G(PSSWSERR) D
  1.  .D BMES^XPDUTL("  **************************************************************************")
  1.  .D BMES^XPDUTL("  ** Due to error(s), UPDATE_STATUS web service definition is not complete. **")
  1.  .D BMES^XPDUTL("  **************************************************************************")
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="*** Due to error(s), UPDATE_STATUS web service definition is not complete." S PSSMXUA2=PSSMXUA2+1
  1.  I '$G(PSSWSERR) D BMES^XPDUTL("Web Service definition process is complete for PPSN web server.") D
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Web Service definition process is complete." S PSSMXUA2=PSSMXUA2+1
  1.  D LINE
  1.  Q
  1.  ;
  1. LINE ;
  1.  S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" " S PSSMXUA2=PSSMXUA2+1
  1.  Q
  1.  ;
  1. PSSENABL ;
  1.  S DIC="^XOB(18.12,"_PPSWPPSN_",100,",DLAYGO=18.121,DIC(0)="L",DA(1)=PPSWPPSN,X="UPDATE_STATUS" D ^DIC S PSSWSER2=+Y
  1. PSSENAB2 ;
  1.  S DIE="^XOB(18.12,"_PPSWPPSN_",100,",DR=".06///ENABLE",DA(1)=PPSWPPSN,DA=PSSWSER2 D ^DIE
  1.  S PSSWSSTA=$$GET1^DIQ(18.121,PSSWSER2_",1",".06","I")
  1.  I PSSWSSTA D
  1.  .D BMES^XPDUTL("     UPDATE_STATUS web service has been enabled.")
  1.  .S @XPDGREF@("PSSMLMSG",PSSMXUA2)="  UPDATE_STATUS web service has been enabled." S PSSMXUA2=PSSMXUA2+1
  1.  Q
  1.  ;
  1. FILESRVR(PSNSRVR,PSNADRS,PSNPORT) ; File a new record in file #18.12 or edit existing
  1.  ; Input: PSNSRVR - web server name
  1.  ;        PSNADRS - web server address
  1.  ;        PSNPORT - port number
  1.  ; Output:
  1.  ;        Function Value - Returns IEN of record on success, 0 on failure
  1.  ;
  1.  N FDA,FDAI,PSNERR,PSNIENS,PSNIEN,DIERR
  1.  S PSNIEN=+$$FIND1^DIC(18.12,"","BX",PSNSRVR,"","","")
  1.  ;
  1.  ; If record doesn't already exist, create new
  1.  I PSNIEN S PSNIENS=PSNIEN_","
  1.  E  S PSNIENS="+1,"
  1.  D BMES^XPDUTL($S(PSNIEN:"Updating",1:"Creating")_" PPSN Web Server...")
  1.  S @XPDGREF@("PSSMLMSG",PSSMXUA2)=$S(PSNIEN:"Updating",1:"Creating")_" PPSN Web Server..."
  1.  S PSSMXUA2=PSSMXUA2+1
  1.  ;
  1.  ; Set up FDA with field values
  1.  S FDA(18.12,PSNIENS,.01)=$G(PSNSRVR) ;server name
  1.  S FDA(18.12,PSNIENS,.03)=$G(PSNPORT) ;ws port nbr
  1.  I 'PSNIEN S FDA(18.12,PSNIENS,.04)=$G(PSNADRS) ;server address
  1.  S FDA(18.12,PSNIENS,.06)=1 ;status
  1.  S FDA(18.12,PSNIENS,.07)=30 ;timeout
  1.  S FDA(18.12,PSNIENS,3.01)=1 ;ssl enabled
  1.  S FDA(18.12,PSNIENS,3.02)="encrypt_only" ;SSL configuration
  1.  S FDA(18.12,PSNIENS,3.03)=443 ;SSL port number
  1.  ;
  1.  I PSNIEN D  ;update current record
  1.  . D FILE^DIE("K","FDA","PSNERR")
  1.  . I $D(PSNERR) D
  1.  . . D DISPERR($NA(PSNERR),PSSMXUA2)
  1.  . . S PSNIEN=0
  1.  E  D  ;create new record
  1.  . D UPDATE^DIE("","FDA","FDAI","PSNERR")
  1.  . I $D(PSNERR) D
  1.  . . D DISPERR($NA(PSNERR),PSSMXUA2)
  1.  . . S PSNIEN=0
  1.  . E  D
  1.  . . S PSNIEN=$G(FDAI(1))
  1.  ;
  1.  Q $S($G(PSNIEN)>0:PSNIEN,1:0)
  1.  ;
  1. SERVICE(SVCS,SRVR,SVRIEN) ; add web service to web server
  1.  ; Input: SVCS   - web service name
  1.  ;        SRVR   - web server name
  1.  ;        SVRIEN - web server ien
  1.  ;
  1.  N SVCIEN,PSNIENS,PSNFDA,PSNFDAI,PSNERR,DIERR
  1.  ;
  1.  S SVCIEN=+$$FIND1^DIC(18.02,"","BX",SVCS,"","","")
  1.  I '$D(^XOB(18.12,"AB",SVCIEN,SVRIEN)) D
  1.  . ;add sub rec
  1.  . S PSNIENS="+1,"_SVRIEN_","
  1.  . S PSNFDA(18.121,PSNIENS,.01)=SVCIEN ;service ien
  1.  . S PSNFDA(18.121,PSNIENS,.06)=1 ;status
  1.  . D UPDATE^DIE("","PSNFDA","PSNFDAI","PSNERR")
  1.  . I $D(DIERR) D
  1.  . . D DISPERR($NA(PSNERR))
  1.  . . D MES^XPDUTL(" o  ERROR occurred registering WEB SERVICE '"_SVCS_"' to WEB SERVER '"_SRVR_"'")
  1.  . . D MES^XPDUTL(" ")
  1.  . E  D
  1.  . . D MES^XPDUTL(" o  WEB SERVICE '"_SVCS_"' was registered to WEB SERVER '"_SRVR_"'")
  1.  . . D MES^XPDUTL(" ")
  1.  . D CLEAN^DILF
  1.  E  D
  1.  . D MES^XPDUTL(" o  WEB SERVICE '"_SVCS_"' already registered to WEB SERVER '"_SRVR_"'")
  1.  . D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. DISPERR(PSNARR,PSSMXUA2) ; display error message
  1.  N PSNOUT,PSNI
  1.  W !,"Database Server Error Information:" S PSSMXUA2=PSSMXUA2+1
  1.  D MSG^DIALOG("AE",.PSNOUT,70,"",PSNARR)
  1.  F PSNI=1:1 Q:$D(PSNOUT(PSNI))=0  W !,$G(PSNOUT(PSNI)) S PSSMXUA2=PSSMXUA2+1
  1.  Q
  1.  ;