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

HDISVCUT.m

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