MAGQBUT4 ;WOIFO/RMP - BP Utilities  ;19 Nov 2001 1:23 PM
 ;;3.0;IMAGING;**7,8,48,20**;Apr 12, 2006
 ;; +---------------------------------------------------------------+
 ;; | Property of the US Government.                                |
 ;; | No permission to copy or redistribute this software is given. |
 ;; | Use of unreleased versions of this software requires the user |
 ;; | to execute a written test agreement with the VistA Imaging    |
 ;; | Development Office of the Department of Veterans Affairs,     |
 ;; | telephone (301) 734-0100.                                     |
 ;; |                                                               |
 ;; | The Food and Drug Administration classifies this software as  |
 ;; | a medical device.  As such, it may not be changed in any way. |
 ;; | Modifications to this software may result in an adulterated   |
 ;; | medical device under 21CFR820, the use of which is considered |
 ;; | to be a violation of US Federal Statutes.                     |
 ;; +---------------------------------------------------------------+
 ;;
 ;
 Q
CONV(ARR,ICT) ;Convert any single node array to FM Style multiple
 ;  The node subscripts of ARR are ignored, and not retained
 ; i.e.  ARR(34)=8
 ;       ARR("BLUE")=9
 ;       ARR("D")=10
 ; converts to
 ;      ARR(1,0)=8
 ;      ARR(2,0)=9
 ;      ARR(3,0)=10
 N I,ARO
 S ICT=0,I=""
 F  S I=$O(ARR(I)) Q:(I="")  D
 . S ICT=ICT+1
 . S ARO(ICT,0)=ARR(I)
 K ARR
 M ARR=ARO
 Q
MRGMULT(ARR,RT,RTDSC,CT) ;Merge the FM formatted array into a FM File
 ;   multiple field.
 ;   This isn't for general consumption.
 ; RT = FILE ROOT, RECORD NUMBER, NODE
 ; i.e.  "^MAG(2006.034,44,1,"   -> 44 is the IEN of MAG(2006.34
 ; RTDSC is the 2nd piece of the 0 node of the multiple field.
 S RT=$E(RT,1,$L(RT)-1)_")"
 S @RT@(0)=U_RTDSC_U_CT_U_CT ;  i.e.    ^2006.341A^13^13
 M @RT=ARR
 Q
DDLF(RESULTS,FILE,FIELD,FLAGS,ATTR) ;[MAG FLD ATT]
 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
 K X
 D FIELD^DID(FILE,FIELD,FLAGS,ATTR,"RESULTS","RESULTS")
 Q
DDFA(RESULTS) ;[MAG ATT LST]
 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
 K X
 D FIELDLST^DID(RESULTS)
 Q
DHRPC(RESULTS,FNAME,FLOC) ;[MAG DIRHASH]
 N TMP
 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
 K X
 S TMP=$$DIRHASH^MAGFILEB(FNAME,FLOC)
 S RESULTS=$S(TMP="":U,1:TMP)
 Q
GPACHX(PV) ; Get Package File Install History of Imaging
 N I,LCNT,MSG,PKG
 S LCNT=0
 S PV(0)="Version^Install Date"
 F PKG="IMAGING" D
 . N J,K,L,VERS,DATE,X,Y,%DT
 . S J=$O(^DIC(9.4,"B",PKG,"")) Q:'J
 . S VERS="" F  S VERS=$O(^DIC(9.4,J,22,"B",VERS)) Q:VERS=""  D
 . . N MSG,TAR
 . . S K=$O(^DIC(9.4,J,22,"B",VERS,""))
 . . D LIST^DIC(9.4901,","_K_","_J_",","@;.01;.02;.03","","","","","","","","TAR","MSG")
 . . Q:$D(MSG("DIERR"))
 . . S L=0 F  S L=$O(TAR("DILIST","ID",L)) Q:'L  D
 . . . S LCNT=LCNT+1
 . . . S PV(LCNT)=VERS_"P"_$P(TAR("DILIST","ID",L,".01"),"^",1)
 . . . S X=$P(TAR("DILIST","ID",L,".02"),"^",1) D ^%DT S DATE=$$FMTE^XLFDT(Y,2)
 . . . S PV(LCNT)=PV(LCNT)_"^"_$S(DATE["-1":"",1:DATE)
 . . . Q
 . . Q
 . Q
 Q
VOK(VER) ; Check for the appropriate BP Queue processor version
 ; This routine MAGQBUT4 will need to be released with each BP Update
 ; The variable CVERS will contain the current BP server version
 ;       ;;3.0;IMAGING;**7,13,8**;Jul 26, 2004
 N VN,I,CVERS,PNUM,SLINE,ALTVER
 S SLINE=$T(+2),ALTVER=","_$$TRIM($P(SLINE,"**",2))_","
 S PNUM=$$TRIM($P(SLINE,"**",2)),PNUM=$$TRIM($P(PNUM,",",$L(PNUM,",")))
 S CVERS=$$TRIM($P(SLINE,";",3))_"P"_PNUM
 Q $S(CVERS=VER:1,$P(VER,"P",2)["13":1,ALTVER[(","_$P(VER,"P",2)_","):1,1:0)
 ;
TRIM(X) ; remove both leading and trailing blanks
 N I,J
 F I=1:1:$L(X) Q:$E(X,I)'=" "
 F J=$L(X):-1:I Q:$E(X,J)'=" "
 Q $S($E(X,I,J)=" ":"",1:$E(X,I,J))
 ;
QCNT(RESULT,PLC,QUE) ; [MAGQ QCNT]
 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
 N CNT,DA,CQ,IA
 S (NODE,IA)="",RESULT=0
 S (CNT,IA)=0,DA=""
 S QP=$S($D(^MAGQUEUE(2006.031,"C",PLC,QUE)):$O(^MAGQUEUE(2006.031,"C",PLC,QUE,"")),1:"")
 S CQ=$S('QP:0,1:$P($G(^MAGQUEUE(2006.031,QP,0)),U,2))
 F  S DA=$O(^MAGQUEUE(2006.03,"C",PLC,QUE,DA)) Q:'DA  S CNT=CNT+1 I CQ<DA S IA=IA+1
 D QPUP(PLC,QUE,CNT,CQ,IA,QP) Q
 Q
 ;
QPUP(PLC,QUE,CNT,CQ,IA,QP) ;
 N IEN,DIC,VAL
 K VAL
 S VAL(1)=PLC,VAL(2)=QUE
 S QP=$S(QP:QP,1:$$FIND1^DIC(2006.031,"","QX",.VAL,"C","",""))
 ;I IEN>0 D  Q:IEN
 ;. S $P(^MAGQUEUE(2006.031,IEN,0),U,5)=CNT Q
 I 'QP D  Q
 . K DIE,FDA
 . S FDA(2006.031,"+1,",.01)=QUE
 . S FDA(2006.031,"+1,",.04)=PLC
 . S FDA(2006.031,"+1,",1)=CQ
 . S FDA(2006.031,"+1,",2)=IA
 . S FDA(2006.031,"+1,",3)=CNT
 . D UPDATE^DIE("U","FDA","","MAGQUP")
 . K DIE,FDA
 E  D
 . K DIE,FDA
 . S FDA(2006.031,QP_",",.01)=QUE
 . S FDA(2006.031,QP_",",.04)=PLC
 . S FDA(2006.031,QP_",",1)=CQ
 . S FDA(2006.031,QP_",",2)=IA
 . S FDA(2006.031,QP_",",3)=CNT
 . D FILE^DIE("","FDA","MAGERR")
 . K DIE,FDA
 Q
 ;
CPUD ;
 N PLC,INS,QUE
 S (INS,PLC)=""
 F  S INS=$O(^MAG(2006.1,"B",INS)) Q:INS=""  D
 . S PLC=$O(^MAG(2006.1,"B",INS,""))
 . S QUE="" F  S QUE=$O(^MAGQUEUE(2006.031,"C",PLC,QUE)) Q:QUE=""  D
 . . D QCNT^MAGQBUT4("",PLC,QUE)
 . . Q
 . Q
 Q
CNL(GL,IEN,NLC) ;  Check Network Location
 N MAGREF,MAG0,MAG1,PLC
 S NLC=NLC+1
 I '$G(IEN) Q ""
 S MAG0=$G(@(GL_IEN_",0)"))
 S MAGREF=+$P(MAG0,"^",3)            ; get file from raid
 I MAGREF=0 S MAGREF=+$P(MAG0,"^",5) ; get file from jukebox
 I 'MAGREF Q ""
 I '$D(^MAG(2005.2,MAGREF,0)) Q ""
 S PLC=$P($G(^MAG(2005.2,MAGREF,0)),U,10)
 Q:'PLC ""
 S PLC=$P($G(^MAG(2006.1,PLC,0)),U)
 Q $S('PLC:"",1:PLC)
CNSP(GL,IEN,NMSP,NSC) ;  Check NameSPace
 N NMSPC,MAG0,FNAM,INSTIEN
 S NSC=NSC+1
 S MAG0=$G(@(GL_IEN_",0)"))
 S FNAM=$P(MAG0,U,2)
 S NMSPC=$TR($P(FNAM,"."),"0123456789","")
 Q:NMSPC="" ""
 S INSTIEN=$S($D(NMSP(NMSPC)):$O(NMSP(NMSPC,"")),1:"")
 Q INSTIEN
ACQUD(LIMIT) ;
 N I,TMP,CNT
 S (I,CNT)=0
 F  S I=$O(^TMP($J,"CHANGE_IEN",I)) Q:I=""  D
 . S TMP=$G(^TMP($J,"CHANGE_IEN",I))
 . D DFNIQ^MAGQBPG1("","Original Acquisition Site at IEN: "_$P(TMP,U,3)_" Value: "_$P(TMP,U)_" New value: "_$P(TMP,U,2),0)
 . S CNT=CNT+1
 . I (CNT+1)>LIMIT D
 . . D DFNIQ^MAGQBPG1("Post Install Acquisition Site field Updates","",1)
 . . S CNT=0
 . . Q
 . Q
 D DFNIQ^MAGQBPG1("Post Install Acquisition Site field Updates","",1)
 K ^TMP($J,"CHANGE_IEN"),TMP
 Q
NMSP(TMPA) ;
 N IEN,INS,TMP,I,J
 S INS="" F  S INS=$O(^MAG(2006.1,"B",INS)) Q:INS=""  S IEN="" D
 . S IEN=$O(^MAG(2006.1,"B",INS,IEN)) Q:IEN=""  D  Q
 . . S TMP=","_$$UPPER^MAGQE4($$INIS^MAGQBPG2(IEN))_"," D  Q
 . . . F I=2:1 S J=$P(TMP,",",I) Q:J=""  S TMPA(J,INS)=""
 . . . Q
 S J="" F  S J=$O(TMPA(J)) Q:J=""  S INS=$O(TMPA(J,"")) K:($O(TMPA(J,INS))]"") TMPA(J)
 Q
CLRQ ; Clears the Queue file and Queue Pointer files
 N DA,DIK,FILE,IEN
 F FILE=2006.03,2006.031 D
 . S IEN=0 F  S IEN=$O(^MAGQUEUE(FILE,IEN)) Q:'IEN  D
 . . S DIK="^MAGQUEUE("_FILE_","
 . . S DA=IEN,DA(1)=FILE D ^DIK
 K DIK,DA
 Q
 ; We add RPC to MAG WINDOWS Option this way instead of sending Option : MAG WINDOWS
 ; If we send MAG WINDOWS Option, the last one installed will overwrite others.
 ; ADDRPC copied from Patch 51, added the call "D MES^XPDUTL(" instead of "W !"
ADDRPC(RPCNAME,OPTNAME) ;
 N DA,DIC
 S DIC="^DIC(19,",DIC(0)="",X=OPTNAME D ^DIC
 I Y<0 D  Q
 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
 . D MES^XPDUTL("Cannot find Option: """_OPTNAME_""".")
 . Q
 I '$D(^XWB(8994,"B",RPCNAME)) D  Q
 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
 . D MES^XPDUTL("Cannot find RPC: """_RPCNAME_""".")
 . Q
 S DA(1)=+Y
 I $D(^DIC(19,+Y,"RPC","B",$O(^XWB(8994,"B",RPCNAME,"")))) D  Q
 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
 . D MES^XPDUTL("RPC: """_RPCNAME_""" is already a member of """_OPTNAME_""".")
 . Q
 S DIC=DIC_DA(1)_",""RPC"","
 S DIC(0)="L" ; LAYGO should be allowed here
 S X=RPCNAME
 D ^DIC
 I Y<0 D  Q
 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
 . D MES^XPDUTL("Cannot find RPC: """_RPCNAME_""".")
 . Q
 Q
INS(XP,DUZ,DATE,IDA) ;
 N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
 D GETENV^%ZOSV
 S CNT=0
 S CNT=CNT+1,MAGMSG(CNT)="PACKAGE INSTALL"
 S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
 S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_XP
 S CNT=CNT+1,MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XP)
 S ST=$$GET1^DIQ(9.7,IDA,11,"I")
 S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
 S CT=$$GET1^DIQ(9.7,IDA,17,"I") S:+CT'=CT CT=$$NOW^XLFDT
 S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
 S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
 S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
 S COM=$$GET1^DIQ(9.7,IDA,6,"I")
 S CNT=CNT+1,MAGMSG(CNT)="FILE COMMENT: "_COM
 S CNT=CNT+1,MAGMSG(CNT)="DATE: "_DATE
 S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,IDA,9,"E")
 S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,IDA,.01,"E")
 S DDATE=$$GET1^DIQ(9.7,IDA,51,"I")
 S CNT=CNT+1,MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
 S XMSUB=XP_" INSTALLATION"
 S XMID=$G(DUZ) S:'XMID XMID=.5
 S XMY(XMID)=""
 S XMY("G.MAG SERVER")=""
 S:$G(MAGDUZ) XMY(MAGDUZ)=""
 S XMSUB=$E(XMSUB,1,63)
 D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
 I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message," K XMERR
 Q
 ;