- 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 Jan 18, 2025@02:57:57 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 ;