HDISVCUT ;CT/GRR ; 19 Apr 2006 10:57 AM
;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
BLDSTAT(HDISFILE,HDISFN,HDISSC,HDISSDT,HDISARRY) ;
N HDISOUT,CODE,HDISTDTX,Y
I HDISFILE=""!(HDISFN="")!(HDISARRY="") S HDISOUT=0_"^Parameter Missing" G QUIT
K @HDISARRY
S DIC=7115.3,DIC(0)="Z",X="DOMAIN STATUS UPDATE" D ^DIC K DIC
I Y<0 S HDISOUT=0_"^DOMAIN STATUS UPDATE Template Missing" G QUIT
S HDIST=+Y,HDISY=Y,HDISY(0)=Y(0)
S HDISSRC=$P($$SITE^VASITE(),"^",3)
S HDISPROD=$$PROD^XUPROD()
S HDISTDTX=$$FMTXML^HDISVU01(HDISSDT,"","")
S HDISMD=$G(^XMB("NETNAME"))
S @HDISARRY@(1)="<?xml version=""1.0"" encoding=""utf-8"" ?>"
;S @HDISARRY@(1)=$$XMLHDR^XOBVLIB()
S @HDISARRY@(2)="<"_$P(HDISY(0),"^",4)_" "_$G(^HDIS(7115.3,HDIST,1))_">"
N Z K Z D ZINIT
S Z(20)=HDISSRC
S Z(22)=HDISPROD
S Z(30)=HDISMD
S Z(60)=HDISFILE
S Z(70)=HDISFN
S Z(80)=HDISSC
S Z(90)=HDISTDTX
D XMLOUT^HDISXML(HDIST,"20,22,30,60,70,80,90,10/","Z",HDISARRY,.HDERR)
S HDISOUT=1
QUIT Q HDISOUT
;
ZINIT S Z(22)="" F Z=10:10:100 S Z(Z)=""
Q
;
;
BLDSND(HDISFILE,HDISFN,HDISSTCD,HDISSDT,HDISARRY,HDISINP) ;
;Updating of central server disabled (return success)
I $$GETSDIS^HDISVF03() Q 1
N HDISOUT
S:HDISSDT="" HDISSDT=DT
S:HDISARRY="" HDISARRY=$NA(^TMP("HDISSBUILD",$J))
S HDISOUT=$$BLDSTAT(HDISFILE,HDISFN,HDISSTCD,HDISSDT,HDISARRY)
I 'HDISOUT Q HDISOUT
S HDISOUT=$$SNDXML^HDISVM02(HDISARRY,2,HDISINP)
Q HDISOUT
;
STATUPD(FILE,FIELD,CODE,DATE) ;Encompassing local status update call
; Input : FILE - File number
; FIELD - Field number (defaults to .01)
; CODE - Status code to set (defaults to "not started")
; DATE - FileMan date/time to return status for (optional)
; (defaults to NOW)
;Output : 1 = Success 0^Text = Failure
; Notes : This call will update the local status, build the Status
; Update XML document, and forward the Status Update XML
; document to the centralized server
; : If time is not included with the date, 1 second past
; midnight will be used as the time
; : If an entry for the given file/field and date/time already
; exists, the existing entry will be updated to reflect the
; given status
N XMLARR,TMPARR,OUTPUT
;Check input
S FILE=+$G(FILE)
I 'FILE Q "0^Parameter FILE was not passed"
S FIELD=+$G(FIELD)
I 'FIELD S FIELD=.01
S CODE=+$G(CODE)
S DATE=+$G(DATE)
I 'DATE S DATE=$$NOW^XLFDT()
I '$P(DATE,".",2) S $P(DATE,".",2)="000001"
;Update local status
D SETSTAT^HDISVF01(FILE,FIELD,CODE,DATE,1)
;Updating of central server disabled (return success)
I $$GETSDIS^HDISVF03() Q 1
;Create status update xml doc and send to central server
S XMLARR=$NA(^TMP("HDISVCUT",$J,"XML"))
S TMPARR=$NA(^TMP("HDISVCUT",$J,"HDISINP"))
K @XMLARR,@TMPARR
S OUTPUT=$$BLDSND^HDISVCUT(FILE,FIELD,CODE,DATE,XMLARR,TMPARR)
K @XMLARR,@TMPARR
Q OUTPUT
;
VUID(HDDOM,HDROUT) ;Instantiate VUIDs for set of code fields
; Input:
; HDDOM - Domain Name (i.e. ORDERS)
; HDROUT - Routine containing VUID Sets-Of-Code data (i.e. HDI1005B)
;Output: 0 = Stop post-install (error)
; 1 = Continue with post-install
N HDIMSG
S HDIMSG(1)=" "
S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with "_HDDOM_" data"
S HDIMSG(3)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
I '$$VUIDL^HDISVU02(HDDOM,HDROUT) Q 0
Q 1
;
UPDTDOM(HDDOM,HDISDFFS) ;Add Domain info to the HDIS DOMAIN file
;
; Input: HDDOM - Domain Name
; HDISDFFS - Array containing File number set equal to Field Number (optional, .01 assumed)
; (i.e. HDISDFFS(100.01)="")
;Output: HDISERR - Set to 1 when error incurred
N HDIEN,HDIMSG
S HDIMSG(1)=" "
S HDIMSG(2)="Adding "_HDDOM_" Domain and related fields to"
S HDIMSG(3)="HDIS DOMAIN file (#7115.1)"
S HDIMSG(4)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
I '$$FINDDOM^HDISVF09(HDDOM,.HDISDFFS,1,.HDISDIEN,.HDISERRM) D Q 0
.N HDIEN,HDIMSG
.S HDIMSG(1)=" "
.S HDIMSG(2)="Error occurred when updating HDIS DOMAIN file."
.S HDIMSG(3)=HDISERRM
.S HDIMSG(4)=" "
.D MES^XPDUTL(.HDIMSG) K HDIMSG
Q 1
;
;
TESTACT() ;Set's the HDIS SYSTEM file fields to reflect a mirrored test account and remove any multiple entries
;
;Check file for multiple entries and delete if found
;PATCH 6
;
I $O(^HDISF(7118.21,1))>0 D ;multiple entries found
.N IEN,FDA,DA,DIK
.S IEN=1
.F S IEN=$O(^HDISF(7118.21,IEN)) Q:IEN'>0 D
..S DA=IEN
..S DIK="^HDISF(7118.21,"
..D ^DIK
K FDA(1)
S FDA(1,7118.21,"?+1,",.01)=$P($G(^HDISF(7118.21,1,0)),"^",1)
S FDA(1,7118.21,"?+1,",.02)=$G(^XMB("NETNAME"))
S FDA(1,7118.21,"?+1,",.03)=$$PROD^XUPROD()
D UPDATE^DIE("","FDA(1)","RSLT","ERR(1)")
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVCUT 4814 printed Sep 23, 2025@19:32:51 Page 2
HDISVCUT ;CT/GRR ; 19 Apr 2006 10:57 AM
+1 ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
BLDSTAT(HDISFILE,HDISFN,HDISSC,HDISSDT,HDISARRY) ;
+1 NEW HDISOUT,CODE,HDISTDTX,Y
+2 IF HDISFILE=""!(HDISFN="")!(HDISARRY="")
SET HDISOUT=0_"^Parameter Missing"
GOTO QUIT
+3 KILL @HDISARRY
+4 SET DIC=7115.3
SET DIC(0)="Z"
SET X="DOMAIN STATUS UPDATE"
DO ^DIC
KILL DIC
+5 IF Y<0
SET HDISOUT=0_"^DOMAIN STATUS UPDATE Template Missing"
GOTO QUIT
+6 SET HDIST=+Y
SET HDISY=Y
SET HDISY(0)=Y(0)
+7 SET HDISSRC=$PIECE($$SITE^VASITE(),"^",3)
+8 SET HDISPROD=$$PROD^XUPROD()
+9 SET HDISTDTX=$$FMTXML^HDISVU01(HDISSDT,"","")
+10 SET HDISMD=$GET(^XMB("NETNAME"))
+11 SET @HDISARRY@(1)="<?xml version=""1.0"" encoding=""utf-8"" ?>"
+12 ;S @HDISARRY@(1)=$$XMLHDR^XOBVLIB()
+13 SET @HDISARRY@(2)="<"_$PIECE(HDISY(0),"^",4)_" "_$GET(^HDIS(7115.3,HDIST,1))_">"
+14 NEW Z
KILL Z
DO ZINIT
+15 SET Z(20)=HDISSRC
+16 SET Z(22)=HDISPROD
+17 SET Z(30)=HDISMD
+18 SET Z(60)=HDISFILE
+19 SET Z(70)=HDISFN
+20 SET Z(80)=HDISSC
+21 SET Z(90)=HDISTDTX
+22 DO XMLOUT^HDISXML(HDIST,"20,22,30,60,70,80,90,10/","Z",HDISARRY,.HDERR)
+23 SET HDISOUT=1
QUIT QUIT HDISOUT
+1 ;
ZINIT SET Z(22)=""
FOR Z=10:10:100
SET Z(Z)=""
+1 QUIT
+2 ;
+3 ;
BLDSND(HDISFILE,HDISFN,HDISSTCD,HDISSDT,HDISARRY,HDISINP) ;
+1 ;Updating of central server disabled (return success)
+2 IF $$GETSDIS^HDISVF03()
QUIT 1
+3 NEW HDISOUT
+4 if HDISSDT=""
SET HDISSDT=DT
+5 if HDISARRY=""
SET HDISARRY=$NAME(^TMP("HDISSBUILD",$JOB))
+6 SET HDISOUT=$$BLDSTAT(HDISFILE,HDISFN,HDISSTCD,HDISSDT,HDISARRY)
+7 IF 'HDISOUT
QUIT HDISOUT
+8 SET HDISOUT=$$SNDXML^HDISVM02(HDISARRY,2,HDISINP)
+9 QUIT HDISOUT
+10 ;
STATUPD(FILE,FIELD,CODE,DATE) ;Encompassing local status update call
+1 ; Input : FILE - File number
+2 ; FIELD - Field number (defaults to .01)
+3 ; CODE - Status code to set (defaults to "not started")
+4 ; DATE - FileMan date/time to return status for (optional)
+5 ; (defaults to NOW)
+6 ;Output : 1 = Success 0^Text = Failure
+7 ; Notes : This call will update the local status, build the Status
+8 ; Update XML document, and forward the Status Update XML
+9 ; document to the centralized server
+10 ; : If time is not included with the date, 1 second past
+11 ; midnight will be used as the time
+12 ; : If an entry for the given file/field and date/time already
+13 ; exists, the existing entry will be updated to reflect the
+14 ; given status
+15 NEW XMLARR,TMPARR,OUTPUT
+16 ;Check input
+17 SET FILE=+$GET(FILE)
+18 IF 'FILE
QUIT "0^Parameter FILE was not passed"
+19 SET FIELD=+$GET(FIELD)
+20 IF 'FIELD
SET FIELD=.01
+21 SET CODE=+$GET(CODE)
+22 SET DATE=+$GET(DATE)
+23 IF 'DATE
SET DATE=$$NOW^XLFDT()
+24 IF '$PIECE(DATE,".",2)
SET $PIECE(DATE,".",2)="000001"
+25 ;Update local status
+26 DO SETSTAT^HDISVF01(FILE,FIELD,CODE,DATE,1)
+27 ;Updating of central server disabled (return success)
+28 IF $$GETSDIS^HDISVF03()
QUIT 1
+29 ;Create status update xml doc and send to central server
+30 SET XMLARR=$NAME(^TMP("HDISVCUT",$JOB,"XML"))
+31 SET TMPARR=$NAME(^TMP("HDISVCUT",$JOB,"HDISINP"))
+32 KILL @XMLARR,@TMPARR
+33 SET OUTPUT=$$BLDSND^HDISVCUT(FILE,FIELD,CODE,DATE,XMLARR,TMPARR)
+34 KILL @XMLARR,@TMPARR
+35 QUIT OUTPUT
+36 ;
VUID(HDDOM,HDROUT) ;Instantiate VUIDs for set of code fields
+1 ; Input:
+2 ; HDDOM - Domain Name (i.e. ORDERS)
+3 ; HDROUT - Routine containing VUID Sets-Of-Code data (i.e. HDI1005B)
+4 ;Output: 0 = Stop post-install (error)
+5 ; 1 = Continue with post-install
+6 NEW HDIMSG
+7 SET HDIMSG(1)=" "
+8 SET HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with "_HDDOM_" data"
+9 SET HDIMSG(3)=" "
+10 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+11 IF '$$VUIDL^HDISVU02(HDDOM,HDROUT)
QUIT 0
+12 QUIT 1
+13 ;
UPDTDOM(HDDOM,HDISDFFS) ;Add Domain info to the HDIS DOMAIN file
+1 ;
+2 ; Input: HDDOM - Domain Name
+3 ; HDISDFFS - Array containing File number set equal to Field Number (optional, .01 assumed)
+4 ; (i.e. HDISDFFS(100.01)="")
+5 ;Output: HDISERR - Set to 1 when error incurred
+6 NEW HDIEN,HDIMSG
+7 SET HDIMSG(1)=" "
+8 SET HDIMSG(2)="Adding "_HDDOM_" Domain and related fields to"
+9 SET HDIMSG(3)="HDIS DOMAIN file (#7115.1)"
+10 SET HDIMSG(4)=" "
+11 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+12 IF '$$FINDDOM^HDISVF09(HDDOM,.HDISDFFS,1,.HDISDIEN,.HDISERRM)
Begin DoDot:1
+13 NEW HDIEN,HDIMSG
+14 SET HDIMSG(1)=" "
+15 SET HDIMSG(2)="Error occurred when updating HDIS DOMAIN file."
+16 SET HDIMSG(3)=HDISERRM
+17 SET HDIMSG(4)=" "
+18 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
QUIT 0
+19 QUIT 1
+20 ;
+21 ;
TESTACT() ;Set's the HDIS SYSTEM file fields to reflect a mirrored test account and remove any multiple entries
+1 ;
+2 ;Check file for multiple entries and delete if found
+3 ;PATCH 6
+4 ;
+5 ;multiple entries found
IF $ORDER(^HDISF(7118.21,1))>0
Begin DoDot:1
+6 NEW IEN,FDA,DA,DIK
+7 SET IEN=1
+8 FOR
SET IEN=$ORDER(^HDISF(7118.21,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+9 SET DA=IEN
+10 SET DIK="^HDISF(7118.21,"
+11 DO ^DIK
End DoDot:2
End DoDot:1
+12 KILL FDA(1)
+13 SET FDA(1,7118.21,"?+1,",.01)=$PIECE($GET(^HDISF(7118.21,1,0)),"^",1)
+14 SET FDA(1,7118.21,"?+1,",.02)=$GET(^XMB("NETNAME"))
+15 SET FDA(1,7118.21,"?+1,",.03)=$$PROD^XUPROD()
+16 DO UPDATE^DIE("","FDA(1)","RSLT","ERR(1)")
+17 QUIT 1
+18 ;
