HDI1000B ;BPFO/JRP - HDI v1.0 POST-INSTALL ROUTINE (CONT);2/23/2005
;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
;
SERVERS() ;Fix server options (they need resource devices)
; Input: None
;Output: 0 = Stop post-install (error)
; 1 = Continue with post-install
N SRVR,RSRC,HDIMSG
;Fix VUID Server option
S SRVR="HDIS-FACILITY-DATA-SERVER"
S RSRC="HDIS VUID RESOURCE DEVICE"
S HDIMSG(1)=" "
S HDIMSG(2)="Making "_RSRC_" the resource device"
S HDIMSG(3)="for "_SRVR
S HDIMSG(4)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
I '$$FIXSRVR(SRVR,RSRC) Q 0
;Fix Status Server option
S SRVR="HDIS-STATUS-UPDATE-SERVER"
S RSRC="HDIS STATUS RESOURCE DEVICE"
S HDIMSG(1)=" "
S HDIMSG(2)="Making "_RSRC_" the resource device"
S HDIMSG(3)="for "_SRVR
S HDIMSG(4)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
I '$$FIXSRVR(SRVR,RSRC) Q 0
;Done
Q 1
;
FIXSRVR(SRVR,RSRC) ;Fix server option
; Input: SRVR - Name of server option
; RSRC - Name of resource device
;Output: 1 = Success 0 = Error/bad input
; Notes: Call assumes that all input have values
N HDIMSG,PTRSRVR,PTRRSRC
S SRVR=$G(SRVR)
S RSRC=$G(RSRC)
;Find option
S PTRSRVR=$$PTROPT(SRVR)
I 'PTRSRVR D Q 0
.I SRVR="" S SRVR="<null>"
.S HDIMSG(1)="**"
.S HDIMSG(2)="** Unable to find "_SRVR_" in the OPTION file (#19)"
.S HDIMSG(3)="** Post-installation will be halted"
.S HDIMSG(4)="**"
.D MES^XPDUTL(.HDIMSG) K HDIMSG
;Create/find resource device
S PTRRSRC=$$CR8RD(RSRC,1)
I 'PTRRSRC D Q 0
.I RSRC="" S RSRC="<null>"
.S HDIMSG(1)="**"
.S HDIMSG(2)="** Unable to find/create "_RSRC_" in the DEVICE file (#3.5)"
.S HDIMSG(3)="** Post-installation will be halted"
.S HDIMSG(4)="**"
.D MES^XPDUTL(.HDIMSG) K HDIMSG
;Attach resource device to server
I '$$RD4OPT(PTRRSRC,PTRSRVR) D Q 0
.S HDIMSG(1)="**"
.S HDIMSG(2)="** Unable to add "_RSRC_" as the resource"
.S HDIMSG(3)="** device for server option "_SRVR
.S HDIMSG(4)="** Post-installation will be halted"
.S HDIMSG(5)="**"
.D MES^XPDUTL(.HDIMSG) K HDIMSG
Q 1
;
CR8RD(NAME,SLOTS) ;Create resource device
; Input: NAME - Name of resource device to create
; SLOTS - Number of resource slots (defaults to 1)
;Output: Pointer to resource device (DEVICE file)
; 0 will be returned on error/bad input
; Notes: If the device NAME already exists, the pointer to that device
; will be returned. The definition of the device will not be
; checked and/or modified.
S NAME=$G(NAME)
I NAME="" Q 0
S SLOTS=+$G(SLOTS)
I SLOTS<1 S SLOTS=1
N PTRDVC,HDIMSG
;Device alread exist - return pointer to it
S PTRDVC=$$FIND1^DIC(3.5,"","X",NAME,"B","","HDIMSG")
I PTRDVC Q PTRDVC
;Create resource device
S PTRDVC=+$$RES^XUDHSET(NAME,NAME,SLOTS)
I PTRDVC<1 S PTRDVC=0
Q PTRDVC
;
PTROPT(NAME) ;Get pointer to option
; Input: NAME - Option name
;Output: Pointer to OPTION file (#19)
; Notes: 0 returned when option not found
N PTROPT,HDIMSG
S PTROPT=$$FIND1^DIC(19,"","X",$G(NAME),"B","","HDIMSG")
I $D(HDIMSG) Q 0
Q PTROPT
;
RD4OPT(PTRDVC,PTROPT) ;Attach resource device to option
; Input: PTRDVC - Pointer to DEVICE file (#3.5)
; PTROPT - Pointer to OPTION file (#19)
;Output: 1 = Success 0 = Error/Bad input
; Notes: Call assumes all input exists and is valid
N HDIFDA,HDIMSG
S PTRDVC=+$G(PTRDVC)
I 'PTRDVC Q 0
S PTROPT=+$G(PTROPT)
I 'PTROPT Q 0
S HDIFDA(19,PTROPT_",",227)=PTRDVC
D FILE^DIE("","HDIFDA","HDIMSG")
I $D(HDIMSG) Q 0
Q 1
;
ATTBUL() ;Attach HDIS Mail Groups to HDIS Bulletins
N HDISBIEN,HDISBNM,HDISERRF,HDISFDA,HDISGIEN,HDISGNM,HDISLNE,HDISMSG,HDISTXT
K HDIMSG
D BMES^XPDUTL("Attaching HDIS Mail Groups to HDIS Bulletins")
F HDISLNE=1:1 S HDISTXT=$P($T(BULGRP+HDISLNE),";;",2) Q:HDISTXT="END"!($G(HDISERRF)) D
. S HDISBNM=$P(HDISTXT,"^",1)
. S HDISBIEN=$$FIND1^DIC(3.6,"","X",HDISBNM,"","","")
. S HDISGNM=$P(HDISTXT,"^",2)
. S HDISGIEN=$$FIND1^DIC(3.8,"","X",HDISGNM,"","","")
. ;If Bulletin or Mail Group not found, error
. I HDISBIEN'>0!(HDISGIEN'>0) D
. . S HDIMSG(1)="**"
. . S HDIMSG(2)="** Bulletin "_HDISBNM_" or Mail Group "_HDISGNM_" not found"
. . D MES^XPDUTL(.HDIMSG) K HDIMSG
. . S HDISERRF=1
. ELSE D
. . ;Attach Mail Group to Bulletin
. . N HDISFDA,HDISIEN,HDISMSG
. . S HDISFDA(3.62,"?+2,"_HDISBIEN_",",.01)=HDISGIEN
. . D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
. . ;Check for error
. . I $D(HDISMSG("DIERR")) D
. . . S HDIMSG(1)="**"
. . . S HDIMSG(2)="** Unable to attach "_HDISGNM_" to "_HDISBNM
. . . D MES^XPDUTL(.HDIMSG) K HDIMSG
. . . S HDISERRF=1
. . ELSE D
. . . S HDIMSG(1)=" "
. . . S HDIMSG(2)=".."_HDISGNM_" Mail Group"_$S($G(HDISIEN(2,0))="?":" already",1:"")_" attached to "_HDISBNM_" Bulletin"
. . . D MES^XPDUTL(.HDIMSG) K HDIMSG
;Check for error
I $G(HDISERRF) D
. S HDIMSG(1)="** Post-installation will be halted"
. S HDIMSG(2)="**"
. D MES^XPDUTL(.HDIMSG) K HDIMSG
Q +$S($G(HDISERRF):0,1:1)
;
BULGRP ;Bulletin Name^Mail Group Name
;;HDIS ERRORS^HDIS ERRORS
;;HDIS NOTIFY ERT^HDIS ERT NOTIFICATION
;;HDIS NOTIFY HDR^HDIS HDR NOTIFICATION
;;HDIS XML MSG PROCESS ERROR^HDIS ERRORS
;;END
;
ATTREM() ;Attach HDIS Remote Members to HDIS Mail Groups
N HDISERRF,HDISFDA,HDISGIEN,HDISGNM,HDISLNE,HDISMSG,HDISRNM,HDISTXT
K HDIMSG
D BMES^XPDUTL("Attaching HDIS Remote Members to HDIS Mail Groups")
F HDISLNE=1:1 S HDISTXT=$P($T(REMMEM+HDISLNE),";;",2) Q:HDISTXT="END"!($G(HDISERRF)) D
. S HDISGNM=$P(HDISTXT,"^",1)
. S HDISGIEN=$$FIND1^DIC(3.8,"","X",HDISGNM,"","","")
. S HDISRNM=$P(HDISTXT,"^",2)
. ;If Mail Group not found, error
. I HDISGIEN'>0 D
. . S HDIMSG(1)="**"
. . S HDIMSG(2)="** Mail Group "_HDISGNM_" not found"
. . D MES^XPDUTL(.HDIMSG) K HDIMSG
. . S HDISERRF=1
. ELSE D
. . ;Attach Remote Member to Mail Group
. . N HDISFDA,HDISIEN,HDISMSG
. . S HDISFDA(3.812,"?+2,"_HDISGIEN_",",.01)=HDISRNM
. . D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
. . ;Check for error
. . I $D(HDISMSG("DIERR")) D
. . . S HDIMSG(1)="**"
. . . S HDIMSG(2)="** Unable to attach "_HDISRNM_" to "_HDISGNM
. . . D MES^XPDUTL(.HDIMSG) K HDIMSG
. . . S HDISERRF=1
. . ELSE D
. . . S HDIMSG(1)=" "
. . . S HDIMSG(2)=".."_HDISRNM_$S($G(HDISIEN(2,0))="?":" already",1:"")_" attached to "_HDISGNM
. . . D MES^XPDUTL(.HDIMSG) K HDIMSG
;Check for error
I $G(HDISERRF) D
. S HDIMSG(1)="** Post-installation will be halted"
. S HDIMSG(2)="**"
. D MES^XPDUTL(.HDIMSG) K HDIMSG
Q +$S($G(HDISERRF):0,1:1)
;
REMMEM ;Mail Group Name^Remote Member
;;HDIS ERRORS^G.HDIS ERRORS@DOMAIN.EXT
;;HDIS ERT NOTIFICATION^G.HDIS ERRORS@DOMAIN.EXT
;;HDIS ERT NOTIFICATION^G.HDIS ERT NOTIFICATION@DOMAIN.EXT
;;HDIS HDR NOTIFICATION^G.HDIS HDR NOTIFICATION@DOMAIN.EXT
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDI1000B 6875 printed Sep 23, 2025@19:32:13 Page 2
HDI1000B ;BPFO/JRP - HDI v1.0 POST-INSTALL ROUTINE (CONT);2/23/2005
+1 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
+2 ;
SERVERS() ;Fix server options (they need resource devices)
+1 ; Input: None
+2 ;Output: 0 = Stop post-install (error)
+3 ; 1 = Continue with post-install
+4 NEW SRVR,RSRC,HDIMSG
+5 ;Fix VUID Server option
+6 SET SRVR="HDIS-FACILITY-DATA-SERVER"
+7 SET RSRC="HDIS VUID RESOURCE DEVICE"
+8 SET HDIMSG(1)=" "
+9 SET HDIMSG(2)="Making "_RSRC_" the resource device"
+10 SET HDIMSG(3)="for "_SRVR
+11 SET HDIMSG(4)=" "
+12 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+13 IF '$$FIXSRVR(SRVR,RSRC)
QUIT 0
+14 ;Fix Status Server option
+15 SET SRVR="HDIS-STATUS-UPDATE-SERVER"
+16 SET RSRC="HDIS STATUS RESOURCE DEVICE"
+17 SET HDIMSG(1)=" "
+18 SET HDIMSG(2)="Making "_RSRC_" the resource device"
+19 SET HDIMSG(3)="for "_SRVR
+20 SET HDIMSG(4)=" "
+21 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+22 IF '$$FIXSRVR(SRVR,RSRC)
QUIT 0
+23 ;Done
+24 QUIT 1
+25 ;
FIXSRVR(SRVR,RSRC) ;Fix server option
+1 ; Input: SRVR - Name of server option
+2 ; RSRC - Name of resource device
+3 ;Output: 1 = Success 0 = Error/bad input
+4 ; Notes: Call assumes that all input have values
+5 NEW HDIMSG,PTRSRVR,PTRRSRC
+6 SET SRVR=$GET(SRVR)
+7 SET RSRC=$GET(RSRC)
+8 ;Find option
+9 SET PTRSRVR=$$PTROPT(SRVR)
+10 IF 'PTRSRVR
Begin DoDot:1
+11 IF SRVR=""
SET SRVR="<null>"
+12 SET HDIMSG(1)="**"
+13 SET HDIMSG(2)="** Unable to find "_SRVR_" in the OPTION file (#19)"
+14 SET HDIMSG(3)="** Post-installation will be halted"
+15 SET HDIMSG(4)="**"
+16 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
QUIT 0
+17 ;Create/find resource device
+18 SET PTRRSRC=$$CR8RD(RSRC,1)
+19 IF 'PTRRSRC
Begin DoDot:1
+20 IF RSRC=""
SET RSRC="<null>"
+21 SET HDIMSG(1)="**"
+22 SET HDIMSG(2)="** Unable to find/create "_RSRC_" in the DEVICE file (#3.5)"
+23 SET HDIMSG(3)="** Post-installation will be halted"
+24 SET HDIMSG(4)="**"
+25 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
QUIT 0
+26 ;Attach resource device to server
+27 IF '$$RD4OPT(PTRRSRC,PTRSRVR)
Begin DoDot:1
+28 SET HDIMSG(1)="**"
+29 SET HDIMSG(2)="** Unable to add "_RSRC_" as the resource"
+30 SET HDIMSG(3)="** device for server option "_SRVR
+31 SET HDIMSG(4)="** Post-installation will be halted"
+32 SET HDIMSG(5)="**"
+33 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
QUIT 0
+34 QUIT 1
+35 ;
CR8RD(NAME,SLOTS) ;Create resource device
+1 ; Input: NAME - Name of resource device to create
+2 ; SLOTS - Number of resource slots (defaults to 1)
+3 ;Output: Pointer to resource device (DEVICE file)
+4 ; 0 will be returned on error/bad input
+5 ; Notes: If the device NAME already exists, the pointer to that device
+6 ; will be returned. The definition of the device will not be
+7 ; checked and/or modified.
+8 SET NAME=$GET(NAME)
+9 IF NAME=""
QUIT 0
+10 SET SLOTS=+$GET(SLOTS)
+11 IF SLOTS<1
SET SLOTS=1
+12 NEW PTRDVC,HDIMSG
+13 ;Device alread exist - return pointer to it
+14 SET PTRDVC=$$FIND1^DIC(3.5,"","X",NAME,"B","","HDIMSG")
+15 IF PTRDVC
QUIT PTRDVC
+16 ;Create resource device
+17 SET PTRDVC=+$$RES^XUDHSET(NAME,NAME,SLOTS)
+18 IF PTRDVC<1
SET PTRDVC=0
+19 QUIT PTRDVC
+20 ;
PTROPT(NAME) ;Get pointer to option
+1 ; Input: NAME - Option name
+2 ;Output: Pointer to OPTION file (#19)
+3 ; Notes: 0 returned when option not found
+4 NEW PTROPT,HDIMSG
+5 SET PTROPT=$$FIND1^DIC(19,"","X",$GET(NAME),"B","","HDIMSG")
+6 IF $DATA(HDIMSG)
QUIT 0
+7 QUIT PTROPT
+8 ;
RD4OPT(PTRDVC,PTROPT) ;Attach resource device to option
+1 ; Input: PTRDVC - Pointer to DEVICE file (#3.5)
+2 ; PTROPT - Pointer to OPTION file (#19)
+3 ;Output: 1 = Success 0 = Error/Bad input
+4 ; Notes: Call assumes all input exists and is valid
+5 NEW HDIFDA,HDIMSG
+6 SET PTRDVC=+$GET(PTRDVC)
+7 IF 'PTRDVC
QUIT 0
+8 SET PTROPT=+$GET(PTROPT)
+9 IF 'PTROPT
QUIT 0
+10 SET HDIFDA(19,PTROPT_",",227)=PTRDVC
+11 DO FILE^DIE("","HDIFDA","HDIMSG")
+12 IF $DATA(HDIMSG)
QUIT 0
+13 QUIT 1
+14 ;
ATTBUL() ;Attach HDIS Mail Groups to HDIS Bulletins
+1 NEW HDISBIEN,HDISBNM,HDISERRF,HDISFDA,HDISGIEN,HDISGNM,HDISLNE,HDISMSG,HDISTXT
+2 KILL HDIMSG
+3 DO BMES^XPDUTL("Attaching HDIS Mail Groups to HDIS Bulletins")
+4 FOR HDISLNE=1:1
SET HDISTXT=$PIECE($TEXT(BULGRP+HDISLNE),";;",2)
if HDISTXT="END"!($GET(HDISERRF))
QUIT
Begin DoDot:1
+5 SET HDISBNM=$PIECE(HDISTXT,"^",1)
+6 SET HDISBIEN=$$FIND1^DIC(3.6,"","X",HDISBNM,"","","")
+7 SET HDISGNM=$PIECE(HDISTXT,"^",2)
+8 SET HDISGIEN=$$FIND1^DIC(3.8,"","X",HDISGNM,"","","")
+9 ;If Bulletin or Mail Group not found, error
+10 IF HDISBIEN'>0!(HDISGIEN'>0)
Begin DoDot:2
+11 SET HDIMSG(1)="**"
+12 SET HDIMSG(2)="** Bulletin "_HDISBNM_" or Mail Group "_HDISGNM_" not found"
+13 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+14 SET HDISERRF=1
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 ;Attach Mail Group to Bulletin
+17 NEW HDISFDA,HDISIEN,HDISMSG
+18 SET HDISFDA(3.62,"?+2,"_HDISBIEN_",",.01)=HDISGIEN
+19 DO UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
+20 ;Check for error
+21 IF $DATA(HDISMSG("DIERR"))
Begin DoDot:3
+22 SET HDIMSG(1)="**"
+23 SET HDIMSG(2)="** Unable to attach "_HDISGNM_" to "_HDISBNM
+24 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+25 SET HDISERRF=1
End DoDot:3
+26 IF '$TEST
Begin DoDot:3
+27 SET HDIMSG(1)=" "
+28 SET HDIMSG(2)=".."_HDISGNM_" Mail Group"_$SELECT($GET(HDISIEN(2,0))="?":" already",1:"")_" attached to "_HDISBNM_" Bulletin"
+29 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:3
End DoDot:2
End DoDot:1
+30 ;Check for error
+31 IF $GET(HDISERRF)
Begin DoDot:1
+32 SET HDIMSG(1)="** Post-installation will be halted"
+33 SET HDIMSG(2)="**"
+34 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
+35 QUIT +$SELECT($GET(HDISERRF):0,1:1)
+36 ;
BULGRP ;Bulletin Name^Mail Group Name
+1 ;;HDIS ERRORS^HDIS ERRORS
+2 ;;HDIS NOTIFY ERT^HDIS ERT NOTIFICATION
+3 ;;HDIS NOTIFY HDR^HDIS HDR NOTIFICATION
+4 ;;HDIS XML MSG PROCESS ERROR^HDIS ERRORS
+5 ;;END
+6 ;
ATTREM() ;Attach HDIS Remote Members to HDIS Mail Groups
+1 NEW HDISERRF,HDISFDA,HDISGIEN,HDISGNM,HDISLNE,HDISMSG,HDISRNM,HDISTXT
+2 KILL HDIMSG
+3 DO BMES^XPDUTL("Attaching HDIS Remote Members to HDIS Mail Groups")
+4 FOR HDISLNE=1:1
SET HDISTXT=$PIECE($TEXT(REMMEM+HDISLNE),";;",2)
if HDISTXT="END"!($GET(HDISERRF))
QUIT
Begin DoDot:1
+5 SET HDISGNM=$PIECE(HDISTXT,"^",1)
+6 SET HDISGIEN=$$FIND1^DIC(3.8,"","X",HDISGNM,"","","")
+7 SET HDISRNM=$PIECE(HDISTXT,"^",2)
+8 ;If Mail Group not found, error
+9 IF HDISGIEN'>0
Begin DoDot:2
+10 SET HDIMSG(1)="**"
+11 SET HDIMSG(2)="** Mail Group "_HDISGNM_" not found"
+12 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+13 SET HDISERRF=1
End DoDot:2
+14 IF '$TEST
Begin DoDot:2
+15 ;Attach Remote Member to Mail Group
+16 NEW HDISFDA,HDISIEN,HDISMSG
+17 SET HDISFDA(3.812,"?+2,"_HDISGIEN_",",.01)=HDISRNM
+18 DO UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
+19 ;Check for error
+20 IF $DATA(HDISMSG("DIERR"))
Begin DoDot:3
+21 SET HDIMSG(1)="**"
+22 SET HDIMSG(2)="** Unable to attach "_HDISRNM_" to "_HDISGNM
+23 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+24 SET HDISERRF=1
End DoDot:3
+25 IF '$TEST
Begin DoDot:3
+26 SET HDIMSG(1)=" "
+27 SET HDIMSG(2)=".."_HDISRNM_$SELECT($GET(HDISIEN(2,0))="?":" already",1:"")_" attached to "_HDISGNM
+28 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;Check for error
+30 IF $GET(HDISERRF)
Begin DoDot:1
+31 SET HDIMSG(1)="** Post-installation will be halted"
+32 SET HDIMSG(2)="**"
+33 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
+34 QUIT +$SELECT($GET(HDISERRF):0,1:1)
+35 ;
REMMEM ;Mail Group Name^Remote Member
+1 ;;HDIS ERRORS^G.HDIS ERRORS@DOMAIN.EXT
+2 ;;HDIS ERT NOTIFICATION^G.HDIS ERRORS@DOMAIN.EXT
+3 ;;HDIS ERT NOTIFICATION^G.HDIS ERT NOTIFICATION@DOMAIN.EXT
+4 ;;HDIS HDR NOTIFICATION^G.HDIS HDR NOTIFICATION@DOMAIN.EXT
+5 ;;END
