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

HDI1000B.m

Go to the documentation of this file. 
  1. HDI1000B ;BPFO/JRP - HDI v1.0 POST-INSTALL ROUTINE (CONT);2/23/2005
  1.  ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
  1.  ;
  1. SERVERS() ;Fix server options (they need resource devices)
  1.  ; Input: None
  1.  ;Output: 0 = Stop post-install (error)
  1.  ;        1 = Continue with post-install
  1.  N SRVR,RSRC,HDIMSG
  1.  ;Fix VUID Server option
  1.  S SRVR="HDIS-FACILITY-DATA-SERVER"
  1.  S RSRC="HDIS VUID RESOURCE DEVICE"
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="Making "_RSRC_" the resource device"
  1.  S HDIMSG(3)="for "_SRVR
  1.  S HDIMSG(4)=" "
  1.  D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  I '$$FIXSRVR(SRVR,RSRC) Q 0
  1.  ;Fix Status Server option
  1.  S SRVR="HDIS-STATUS-UPDATE-SERVER"
  1.  S RSRC="HDIS STATUS RESOURCE DEVICE"
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="Making "_RSRC_" the resource device"
  1.  S HDIMSG(3)="for "_SRVR
  1.  S HDIMSG(4)=" "
  1.  D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  I '$$FIXSRVR(SRVR,RSRC) Q 0
  1.  ;Done
  1.  Q 1
  1.  ;
  1. FIXSRVR(SRVR,RSRC) ;Fix server option
  1.  ; Input: SRVR - Name of server option
  1.  ;        RSRC - Name of resource device
  1.  ;Output: 1 = Success     0 = Error/bad input
  1.  ; Notes: Call assumes that all input have values
  1.  N HDIMSG,PTRSRVR,PTRRSRC
  1.  S SRVR=$G(SRVR)
  1.  S RSRC=$G(RSRC)
  1.  ;Find option
  1.  S PTRSRVR=$$PTROPT(SRVR)
  1.  I 'PTRSRVR D  Q 0
  1.  .I SRVR="" S SRVR="<null>"
  1.  .S HDIMSG(1)="**"
  1.  .S HDIMSG(2)="** Unable to find "_SRVR_" in the OPTION file (#19)"
  1.  .S HDIMSG(3)="** Post-installation will be halted"
  1.  .S HDIMSG(4)="**"
  1.  .D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ;Create/find resource device
  1.  S PTRRSRC=$$CR8RD(RSRC,1)
  1.  I 'PTRRSRC D  Q 0
  1.  .I RSRC="" S RSRC="<null>"
  1.  .S HDIMSG(1)="**"
  1.  .S HDIMSG(2)="** Unable to find/create "_RSRC_" in the DEVICE file (#3.5)"
  1.  .S HDIMSG(3)="** Post-installation will be halted"
  1.  .S HDIMSG(4)="**"
  1.  .D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ;Attach resource device to server
  1.  I '$$RD4OPT(PTRRSRC,PTRSRVR) D  Q 0
  1.  .S HDIMSG(1)="**"
  1.  .S HDIMSG(2)="** Unable to add "_RSRC_" as the resource"
  1.  .S HDIMSG(3)="** device for server option "_SRVR
  1.  .S HDIMSG(4)="** Post-installation will be halted"
  1.  .S HDIMSG(5)="**"
  1.  .D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  Q 1
  1.  ;
  1. CR8RD(NAME,SLOTS) ;Create resource device
  1.  ; Input: NAME - Name of resource device to create
  1.  ;        SLOTS - Number of resource slots (defaults to 1)
  1.  ;Output: Pointer to resource device (DEVICE file)
  1.  ;        0 will be returned on error/bad input
  1.  ; Notes: If the device NAME already exists, the pointer to that device
  1.  ;        will be returned.  The definition of the device will not be
  1.  ;        checked and/or modified.
  1.  S NAME=$G(NAME)
  1.  I NAME="" Q 0
  1.  S SLOTS=+$G(SLOTS)
  1.  I SLOTS<1 S SLOTS=1
  1.  N PTRDVC,HDIMSG
  1.  ;Device alread exist - return pointer to it
  1.  S PTRDVC=$$FIND1^DIC(3.5,"","X",NAME,"B","","HDIMSG")
  1.  I PTRDVC Q PTRDVC
  1.  ;Create resource device
  1.  S PTRDVC=+$$RES^XUDHSET(NAME,NAME,SLOTS)
  1.  I PTRDVC<1 S PTRDVC=0
  1.  Q PTRDVC
  1.  ;
  1. PTROPT(NAME) ;Get pointer to option
  1.  ; Input: NAME - Option name
  1.  ;Output: Pointer to OPTION file (#19)
  1.  ; Notes: 0 returned when option not found
  1.  N PTROPT,HDIMSG
  1.  S PTROPT=$$FIND1^DIC(19,"","X",$G(NAME),"B","","HDIMSG")
  1.  I $D(HDIMSG) Q 0
  1.  Q PTROPT
  1.  ;
  1. RD4OPT(PTRDVC,PTROPT) ;Attach resource device to option
  1.  ; Input: PTRDVC - Pointer to DEVICE file (#3.5)
  1.  ;        PTROPT - Pointer to OPTION file (#19)
  1.  ;Output: 1 = Success     0 = Error/Bad input
  1.  ; Notes: Call assumes all input exists and is valid
  1.  N HDIFDA,HDIMSG
  1.  S PTRDVC=+$G(PTRDVC)
  1.  I 'PTRDVC Q 0
  1.  S PTROPT=+$G(PTROPT)
  1.  I 'PTROPT Q 0
  1.  S HDIFDA(19,PTROPT_",",227)=PTRDVC
  1.  D FILE^DIE("","HDIFDA","HDIMSG")
  1.  I $D(HDIMSG) Q 0
  1.  Q 1
  1.  ;
  1. ATTBUL() ;Attach HDIS Mail Groups to HDIS Bulletins
  1.  N HDISBIEN,HDISBNM,HDISERRF,HDISFDA,HDISGIEN,HDISGNM,HDISLNE,HDISMSG,HDISTXT
  1.  K HDIMSG
  1.  D BMES^XPDUTL("Attaching HDIS Mail Groups to HDIS Bulletins")
  1.  F HDISLNE=1:1 S HDISTXT=$P($T(BULGRP+HDISLNE),";;",2) Q:HDISTXT="END"!($G(HDISERRF))  D
  1.  . S HDISBNM=$P(HDISTXT,"^",1)
  1.  . S HDISBIEN=$$FIND1^DIC(3.6,"","X",HDISBNM,"","","")
  1.  . S HDISGNM=$P(HDISTXT,"^",2)
  1.  . S HDISGIEN=$$FIND1^DIC(3.8,"","X",HDISGNM,"","","")
  1.  . ;If Bulletin or Mail Group not found, error
  1.  . I HDISBIEN'>0!(HDISGIEN'>0) D
  1.  . . S HDIMSG(1)="**"
  1.  . . S HDIMSG(2)="** Bulletin "_HDISBNM_" or Mail Group "_HDISGNM_" not found"
  1.  . . D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  . . S HDISERRF=1
  1.  . ELSE  D
  1.  . . ;Attach Mail Group to Bulletin
  1.  . . N HDISFDA,HDISIEN,HDISMSG
  1.  . . S HDISFDA(3.62,"?+2,"_HDISBIEN_",",.01)=HDISGIEN
  1.  . . D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
  1.  . . ;Check for error
  1.  . . I $D(HDISMSG("DIERR")) D
  1.  . . . S HDIMSG(1)="**"
  1.  . . . S HDIMSG(2)="** Unable to attach "_HDISGNM_" to "_HDISBNM
  1.  . . . D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  . . . S HDISERRF=1
  1.  . . ELSE  D
  1.  . . . S HDIMSG(1)=" "
  1.  . . . S HDIMSG(2)=".."_HDISGNM_" Mail Group"_$S($G(HDISIEN(2,0))="?":" already",1:"")_" attached to "_HDISBNM_" Bulletin"
  1.  . . . D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ;Check for error
  1.  I $G(HDISERRF) D
  1.  . S HDIMSG(1)="** Post-installation will be halted"
  1.  . S HDIMSG(2)="**"
  1.  . D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  Q +$S($G(HDISERRF):0,1:1)
  1.  ;
  1. BULGRP ;Bulletin Name^Mail Group Name
  1.  ;;HDIS ERRORS^HDIS ERRORS
  1.  ;;HDIS NOTIFY ERT^HDIS ERT NOTIFICATION
  1.  ;;HDIS NOTIFY HDR^HDIS HDR NOTIFICATION
  1.  ;;HDIS XML MSG PROCESS ERROR^HDIS ERRORS
  1.  ;;END
  1.  ;
  1. ATTREM() ;Attach HDIS Remote Members to HDIS Mail Groups
  1.  N HDISERRF,HDISFDA,HDISGIEN,HDISGNM,HDISLNE,HDISMSG,HDISRNM,HDISTXT
  1.  K HDIMSG
  1.  D BMES^XPDUTL("Attaching HDIS Remote Members to HDIS Mail Groups")
  1.  F HDISLNE=1:1 S HDISTXT=$P($T(REMMEM+HDISLNE),";;",2) Q:HDISTXT="END"!($G(HDISERRF))  D
  1.  . S HDISGNM=$P(HDISTXT,"^",1)
  1.  . S HDISGIEN=$$FIND1^DIC(3.8,"","X",HDISGNM,"","","")
  1.  . S HDISRNM=$P(HDISTXT,"^",2)
  1.  . ;If Mail Group not found, error
  1.  . I HDISGIEN'>0 D
  1.  . . S HDIMSG(1)="**"
  1.  . . S HDIMSG(2)="** Mail Group "_HDISGNM_" not found"
  1.  . . D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  . . S HDISERRF=1
  1.  . ELSE  D
  1.  . . ;Attach Remote Member to Mail Group
  1.  . . N HDISFDA,HDISIEN,HDISMSG
  1.  . . S HDISFDA(3.812,"?+2,"_HDISGIEN_",",.01)=HDISRNM
  1.  . . D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
  1.  . . ;Check for error
  1.  . . I $D(HDISMSG("DIERR")) D
  1.  . . . S HDIMSG(1)="**"
  1.  . . . S HDIMSG(2)="** Unable to attach "_HDISRNM_" to "_HDISGNM
  1.  . . . D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  . . . S HDISERRF=1
  1.  . . ELSE  D
  1.  . . . S HDIMSG(1)=" "
  1.  . . . S HDIMSG(2)=".."_HDISRNM_$S($G(HDISIEN(2,0))="?":" already",1:"")_" attached to "_HDISGNM
  1.  . . . D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ;Check for error
  1.  I $G(HDISERRF) D
  1.  . S HDIMSG(1)="** Post-installation will be halted"
  1.  . S HDIMSG(2)="**"
  1.  . D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  Q +$S($G(HDISERRF):0,1:1)
  1.  ;
  1. REMMEM ;Mail Group Name^Remote Member
  1.  ;;HDIS ERRORS^G.HDIS ERRORS@DOMAIN.EXT
  1.  ;;HDIS ERT NOTIFICATION^G.HDIS ERRORS@DOMAIN.EXT
  1.  ;;HDIS ERT NOTIFICATION^G.HDIS ERT NOTIFICATION@DOMAIN.EXT
  1.  ;;HDIS HDR NOTIFICATION^G.HDIS HDR NOTIFICATION@DOMAIN.EXT
  1.  ;;END