MAGIPT20 ;Post init routine to queue site activity at install.
;;3.0;IMAGING;**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. |
;; +---------------------------------------------------------------+
;;
POST ;
N INDEX,INSTIEN,CON,AI,I
S INSTIEN=$$KSP^XUPARAM("INST")
I '$P($G(^MAG(2006.1,$O(^MAG(2006.1," "),-1),0)),U) D
. S CON=0
. D BMES^XPDUTL("Non-consolidated conversion, Queue file Clearing: "_$$FMTE^XLFDT($$NOW^XLFDT))
. D CLRQ^MAGQBUT4
. D BMES^XPDUTL("Non-consolidated conversion, PLACE setting: "_$$FMTE^XLFDT($$NOW^XLFDT))
. D SETPL
. D BMES^XPDUTL("Non-consolidated conversion, SITEID PROCESS: "_$$FMTE^XLFDT($$NOW^XLFDT))
. D SITEID
. Q
E S CON=1
S INDEX=0 F S INDEX=$O(^MAG(2006.1,INDEX)) Q:'INDEX D ;set Import security ON by default
. I $P($G(^MAG(2006.1,INDEX,3)),U,12)'?1N S $P(^MAG(2006.1,INDEX,3),U,12)="1"
D BMES^XPDUTL("Queue Pointer Update: "_$$FMTE^XLFDT($$NOW^XLFDT))
D CPUD^MAGQBUT4
D BMES^XPDUTL("Workstation Session Place Indexing: "_$$FMTE^XLFDT($$NOW^XLFDT))
D WSUP(6)
D REMTASK^MAGQE4
D STTASK^MAGQE4
D POSTI^MAGQBUT
D BMES^XPDUTL("Site Parameter PLACE Indexing: "_$$FMTE^XLFDT($$NOW^XLFDT))
S ^MAG(2006.1,"CONSOLIDATED")="YES"
S INDEX="A" K ^MAG(2006.1,INDEX)
F S INDEX=$O(^MAG(2006.1,INDEX)) Q:($E(INDEX,1)'="A") I INDEX'="AC",INDEX'="AD" K ^MAG(2006.1,INDEX)
D BMES^XPDUTL("Updating MAG WINDOWS: "_$$FMTE^XLFDT($$NOW^XLFDT))
D ADDRPC^MAGQBUT4("MAGQ COQ","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ QCNT","MAG WINDOWS")
D ADDRPC^MAGQBUT4("XUS GET TOKEN","MAG WINDOWS")
D ADDRPC^MAGQBUT4("XWB GET VARIABLE VALUE","MAG WINDOWS")
D BMES^XPDUTL("Image and Queue file Indexing: "_$$FMTE^XLFDT($$NOW^XLFDT))
D INDEX
D BMES^XPDUTL("Medical Division Evaluation: "_$$FMTE^XLFDT($$NOW^XLFDT))
D AI^MAGQBUT5(.AI)
S I="" F S I=$O(AI(I)) Q:I="" D BMES^XPDUTL(AI(I))
D BMES^XPDUTL("If there are Medical Divisions that have no Imaging Site parameter")
D BMES^XPDUTL("affiliations you will want to setup Associated Institutions using the")
D BMES^XPDUTL("site parameter window on the Background Processor.")
K AI
D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
D BMES^XPDUTL("Install complete: "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
INDEX ; Re-index actually (2006.03 & 2006.031 Are rebuilt during the conversion)
N IEN,FILE,CNT,IENA,TMPACQ,TINSTIEN,ERRCNT,I,IEN,INSTDA,SAVE,SITEARAY,SITEDA
N STATION,GIC,NLC,NSC,MESSAGE,GL,NMSP,GRPOBJ,VALUE,DIC,X,Y,LIMIT,CHANGE,TMP,FNUM
S (ERRCNT,IEN,CNT,GIC,NLC,NSC,CHANGE)=0,NMSP=""
S DIC=4.3,X=^XMB("NETNAME")
D ^DIC K DIC
S:+Y LIMIT=+$$GET1^DIQ(4.3,+Y,16.1,"","RP","")
S LIMIT=$S(LIMIT:LIMIT,1:2000)
D STATION
D NMSP^MAGQBUT4(.NMSP)
S GL=""
F D SCAN^MAGQBPG1(.IEN,"F",.GL) D Q:'IEN
. Q:'IEN
. S CNT=CNT+1
. S FNUM=$S(GL[2005.1:2005.1,GL[2005:2005,1:"")
. S GRPOBJ=0
. I (CNT#1000)=0 W "."
. I (CNT#80000)=0 W !
. S TMPACQ=$P($G(^MAG(FNUM,IEN,100)),U,3)
. I (TMPACQ'=""),$D(SITEARAY(TMPACQ)) S TINSTIEN=TMPACQ
. E S TINSTIEN=$S('CON:INSTIEN,TMPACQ=INSTIEN:TMPACQ,1:$$GI(TMPACQ,INSTIEN,GL,IEN,FNUM))
. I TINSTIEN="" D
. . D DFNIQ^MAGQBPG1("","Invalid Acquisition Site for image: "_IEN_" the value in question is: "_TMPACQ,0)
. . S ERRCNT=ERRCNT+1
. . I (ERRCNT+1)>LIMIT D
. . . D DFNIQ^MAGQBPG1("Post Install error in Acquisition Site Validation","",1)
. . . S ERRCNT=0 Q
. E D
. . I TMPACQ'=TINSTIEN S $P(^MAG(FNUM,IEN,100),U,3)=TINSTIEN
. . S:(FNUM=2005) ^MAG(2005,"D",TINSTIEN,IEN)=""
. . Q
. I CON,TINSTIEN'="",TMPACQ'=TINSTIEN S ^TMP($J,"CHANGE_IEN",CHANGE+1)=TMPACQ_U_TINSTIEN_U_IEN,CHANGE=CHANGE+1
. S FILE=$P($G(^MAG(FNUM,IEN,0)),U,2) Q:'$D(FILE) Q:$L(FILE)<9
. S FILE=$P(FILE,".")
. K ^MAG(FNUM,"F",$E(FILE,1,30),IEN),^MAG(FNUM,"f",$E(FILE,1,30),IEN)
. S ^MAG(FNUM,"F",$E(FILE,1,30),IEN)=""
. Q
I ERRCNT>0 D DFNIQ^MAGQBPG1("Post Install error in Acquisition Site Validation","",1)
I CHANGE>0 D ACQUD^MAGQBUT4(LIMIT)
K NMSP,SITEARAY,STATION
K ^MAG(2005.2,"B"),^MAG(2005.2,"C"),^MAG(2005.2,"D"),^MAG(2005.2,"E"),^MAG(2005.2,"F")
K ^MAG(2005.2,"AC")
S DIK="^MAG(2005.2," D IXALL^DIK
K ^MAG(2006.1,"B"),^MAG(2006.1,"AC"),^MAG(2006.1,"AD")
S DIK="^MAG(2006.1," D IXALL^DIK
K ^MAG(2006.8,"C"),^MAG(2006.8,"D"),^MAG(2006.8,"B"),^MAG(2006.8,"E")
S DIK="^MAG(2006.8," D IXALL^DIK
K ^MAGQUEUE(2006.03,"B"),^MAGQUEUE(2006.03,"C"),^MAGQUEUE(2006.03,"D"),^MAGQUEUE(2006.03,"E"),^MAGQUEUE(2006.03,"F")
S DIK="^MAGQUEUE(2006.03," D IXALL^DIK
K ^MAGQUEUE(2006.031,"B"),^MAGQUEUE(2006.031,"C")
S DIK="^MAGQUEUE(2006.031," D IXALL^DIK
K ^MAGQUEUE(2006.032,"B"),^MAGQUEUE(2006.032,"C")
S DIK="^MAGQUEUE(2006.032," D IXALL^DIK
K DIK
I GIC>1 D
. S MESSAGE="It was necessary to attempt to recover the Acquisition site for this install"
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="using the following methods: "
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="$$GI: "_GIC_", this is the 'get institution' method, "
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="using the Institution file 'D' cross-reference."
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="$$CNL: "_NLC_", this is the 'network location file lookup method' for this image."
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="$$CNSP: "_NSC_", this is the 'image file namespace' method."
. D BMES^XPDUTL(MESSAGE)
. Q
Q
GI(TMPACQ,INSTIEN,GL,IEN,FNUM) ; Get institution
N TMPI
S VALUE=""
S GIC=GIC+1
I TMPACQ'="",$D(STATION("PROBLEM",TMPACQ)) S TMPACQ=""
I TMPACQ'="" D Q:VALUE VALUE
. S TMPI=$O(STATION("STATION",TMPACQ,""))
. S VALUE=$S(TMPI="":"",$D(SITEARAY(TMPI)):TMPI,1:"")
. Q
I GRPOBJ=0&($D(^MAG(FNUM,IEN,1,0))) D Q VALUE
. NEW IENX,IENY
. S IENX=$O(^MAG(FNUM,IEN,1,0))
. I IENX="" Q
. S GRPOBJ=1
. S IENY=$P(^MAG(FNUM,IEN,1,IENX,0),U)
. S TMPACQ=$P($G(^MAG(FNUM,IENY,100)),U,3)
. I (TMPACQ'=""),$D(SITEARAY(TMPACQ)) S VALUE=TMPACQ
. E S VALUE=$S('CON:INSTIEN,TMPACQ=INSTIEN:TMPACQ,1:$$GI(TMPACQ,INSTIEN,GL,IENY))
. Q
S VALUE=$$CNL^MAGQBUT4(GL,IEN,.NLC)
Q:VALUE VALUE
S VALUE=$$CNSP^MAGQBUT4(GL,IEN,.NMSP,.NSC)
Q VALUE
SETPL ;
N IEN,NAME,DR,DA,DIE,X,Y,PLACE,FILE
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
F FILE=2005.2,2006.8 D
. S (NAME,IEN)="" F S NAME=$O(^MAG(FILE,"B",NAME)) Q:NAME="" D
. . S IEN=$O(^MAG(FILE,"B",NAME,""))
. . S DR=".04///^S X=PLACE",DA=IEN,DIE=FILE D ^DIE
. . Q
S FILE=2006.032,(NAME,IEN)=""
F S NAME=$O(^MAGQUEUE(FILE,"B",NAME)) Q:NAME="" D
. S IEN=$O(^MAGQUEUE(FILE,"B",NAME,""))
. S DR=".04///^S X=PLACE",DA=IEN,DIE=FILE D ^DIE
. Q
Q
WSUP(MONTHS) ;
N EDATE,PLACE,SDATE,IEN,DEFP,CNT,ZNODE,DAYS
S DAYS=MONTHS*(365/12)
S DEFP=$$KSP^XUPARAM("INST")
S EDATE=$$FMADD^XLFDT($$NOW^XLFDT,-DAYS,"","","")
S IEN=$O(^MAG(2006.82," "),-1),CNT=0
F S IEN=$O(^MAG(2006.82,IEN),-1) Q:'IEN S SDATE=$P($G(^MAG(2006.82,IEN,0)),U,3) Q:SDATE<EDATE D
. S CNT=CNT+1
. W:(CNT#1000)=0 "."
. W:(CNT#80000)=0 !
. S PLACE=$P($G(^MAG(2006.82,IEN,1)),U,4)
. S PLACE=$S(PLACE:PLACE,1:DEFP)
. S ^MAG(2006.82,"APL",PLACE,SDATE,IEN)=""
Q
SITEID ;
N FDA,MSG,IEN
S IEN=$O(^MAG(2006.1,"A"),-1)_","
S FDA(2006.1,IEN,.01)=$$KSP^XUPARAM("INST")
D FILE^DIE("E","FDA","MSG")
Q
STATION ; make Imaging Site Parameters (2006.1) file a local array
; find problems in the "D" cross reference of the Institution file
N I,IEN,INSTDA,SAVE,SITEDA
S INSTDA="" F S INSTDA=$O(^MAG(2006.1,"B",INSTDA)) Q:INSTDA="" S SITEDA="" D
. S SITEDA=$O(^MAG(2006.1,"B",INSTDA,SITEDA)) Q:SITEDA="" D
. . S SITEARAY(INSTDA,SITEDA)=""
. . Q
. Q
K ^TMP($J,"MAG_STATION")
S STATION=""
F S STATION=$O(^DIC(4,"D",STATION)) Q:STATION="" S IEN="" D
. F I=1:1 S IEN=$O(^DIC(4,"D",STATION,IEN)) Q:IEN="" D
. . S ^TMP($J,"MAG_STATION",STATION)=I
. . S ^TMP($J,"MAG_STATION",STATION,IEN)=""
. . Q
. Q
S STATION=""
F S STATION=$O(^TMP($J,"MAG_STATION",STATION)) Q:STATION="" D
. S SAVE=""
. S STATION("STATION",STATION)=^TMP($J,"MAG_STATION",STATION)
. I ^TMP($J,"MAG_STATION",STATION)>1 S STATION("PROBLEM",STATION)=""
. S IEN=""
. F S IEN=$O(^TMP($J,"MAG_STATION",STATION,IEN)) Q:IEN="" D
. . S STATION("STATION",STATION,IEN)=""
. . I $D(^DIC(4,STATION))&(STATION'=IEN) S STATION("PROBLEM",STATION)=""
. . I $D(SITEARAY(IEN)) S SAVE=1
. . Q
. I SAVE=1 Q
. K STATION("STATION",STATION)
. Q
K ^TMP($J,"MAG_STATION")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIPT20 9245 printed Nov 22, 2024@17:16:43 Page 2
MAGIPT20 ;Post init routine to queue site activity at install.
+1 ;;3.0;IMAGING;**20**;Apr 12, 2006
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed |
+12 ;; | in any way. Modifications to this software may result in an |
+13 ;; | adulterated medical device under 21CFR820, the use of which |
+14 ;; | is considered to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
POST ;
+1 NEW INDEX,INSTIEN,CON,AI,I
+2 SET INSTIEN=$$KSP^XUPARAM("INST")
+3 IF '$PIECE($GET(^MAG(2006.1,$ORDER(^MAG(2006.1," "),-1),0)),U)
Begin DoDot:1
+4 SET CON=0
+5 DO BMES^XPDUTL("Non-consolidated conversion, Queue file Clearing: "_$$FMTE^XLFDT($$NOW^XLFDT))
+6 DO CLRQ^MAGQBUT4
+7 DO BMES^XPDUTL("Non-consolidated conversion, PLACE setting: "_$$FMTE^XLFDT($$NOW^XLFDT))
+8 DO SETPL
+9 DO BMES^XPDUTL("Non-consolidated conversion, SITEID PROCESS: "_$$FMTE^XLFDT($$NOW^XLFDT))
+10 DO SITEID
+11 QUIT
End DoDot:1
+12 IF '$TEST
SET CON=1
+13 ;set Import security ON by default
SET INDEX=0
FOR
SET INDEX=$ORDER(^MAG(2006.1,INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+14 IF $PIECE($GET(^MAG(2006.1,INDEX,3)),U,12)'?1N
SET $PIECE(^MAG(2006.1,INDEX,3),U,12)="1"
End DoDot:1
+15 DO BMES^XPDUTL("Queue Pointer Update: "_$$FMTE^XLFDT($$NOW^XLFDT))
+16 DO CPUD^MAGQBUT4
+17 DO BMES^XPDUTL("Workstation Session Place Indexing: "_$$FMTE^XLFDT($$NOW^XLFDT))
+18 DO WSUP(6)
+19 DO REMTASK^MAGQE4
+20 DO STTASK^MAGQE4
+21 DO POSTI^MAGQBUT
+22 DO BMES^XPDUTL("Site Parameter PLACE Indexing: "_$$FMTE^XLFDT($$NOW^XLFDT))
+23 SET ^MAG(2006.1,"CONSOLIDATED")="YES"
+24 SET INDEX="A"
KILL ^MAG(2006.1,INDEX)
+25 FOR
SET INDEX=$ORDER(^MAG(2006.1,INDEX))
if ($EXTRACT(INDEX,1)'="A")
QUIT
IF INDEX'="AC"
IF INDEX'="AD"
KILL ^MAG(2006.1,INDEX)
+26 DO BMES^XPDUTL("Updating MAG WINDOWS: "_$$FMTE^XLFDT($$NOW^XLFDT))
+27 DO ADDRPC^MAGQBUT4("MAGQ COQ","MAG WINDOWS")
+28 DO ADDRPC^MAGQBUT4("MAGQ QCNT","MAG WINDOWS")
+29 DO ADDRPC^MAGQBUT4("XUS GET TOKEN","MAG WINDOWS")
+30 DO ADDRPC^MAGQBUT4("XWB GET VARIABLE VALUE","MAG WINDOWS")
+31 DO BMES^XPDUTL("Image and Queue file Indexing: "_$$FMTE^XLFDT($$NOW^XLFDT))
+32 DO INDEX
+33 DO BMES^XPDUTL("Medical Division Evaluation: "_$$FMTE^XLFDT($$NOW^XLFDT))
+34 DO AI^MAGQBUT5(.AI)
+35 SET I=""
FOR
SET I=$ORDER(AI(I))
if I=""
QUIT
DO BMES^XPDUTL(AI(I))
+36 DO BMES^XPDUTL("If there are Medical Divisions that have no Imaging Site parameter")
+37 DO BMES^XPDUTL("affiliations you will want to setup Associated Institutions using the")
+38 DO BMES^XPDUTL("site parameter window on the Background Processor.")
+39 KILL AI
+40 DO INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
+41 DO BMES^XPDUTL("Install complete: "_$$FMTE^XLFDT($$NOW^XLFDT))
+42 QUIT
INDEX ; Re-index actually (2006.03 & 2006.031 Are rebuilt during the conversion)
+1 NEW IEN,FILE,CNT,IENA,TMPACQ,TINSTIEN,ERRCNT,I,IEN,INSTDA,SAVE,SITEARAY,SITEDA
+2 NEW STATION,GIC,NLC,NSC,MESSAGE,GL,NMSP,GRPOBJ,VALUE,DIC,X,Y,LIMIT,CHANGE,TMP,FNUM
+3 SET (ERRCNT,IEN,CNT,GIC,NLC,NSC,CHANGE)=0
SET NMSP=""
+4 SET DIC=4.3
SET X=^XMB("NETNAME")
+5 DO ^DIC
KILL DIC
+6 if +Y
SET LIMIT=+$$GET1^DIQ(4.3,+Y,16.1,"","RP","")
+7 SET LIMIT=$SELECT(LIMIT:LIMIT,1:2000)
+8 DO STATION
+9 DO NMSP^MAGQBUT4(.NMSP)
+10 SET GL=""
+11 FOR
DO SCAN^MAGQBPG1(.IEN,"F",.GL)
Begin DoDot:1
+12 if 'IEN
QUIT
+13 SET CNT=CNT+1
+14 SET FNUM=$SELECT(GL[2005.1:2005.1,GL[2005:2005,1:"")
+15 SET GRPOBJ=0
+16 IF (CNT#1000)=0
WRITE "."
+17 IF (CNT#80000)=0
WRITE !
+18 SET TMPACQ=$PIECE($GET(^MAG(FNUM,IEN,100)),U,3)
+19 IF (TMPACQ'="")
IF $DATA(SITEARAY(TMPACQ))
SET TINSTIEN=TMPACQ
+20 IF '$TEST
SET TINSTIEN=$SELECT('CON:INSTIEN,TMPACQ=INSTIEN:TMPACQ,1:$$GI(TMPACQ,INSTIEN,GL,IEN,FNUM))
+21 IF TINSTIEN=""
Begin DoDot:2
+22 DO DFNIQ^MAGQBPG1("","Invalid Acquisition Site for image: "_IEN_" the value in question is: "_TMPACQ,0)
+23 SET ERRCNT=ERRCNT+1
+24 IF (ERRCNT+1)>LIMIT
Begin DoDot:3
+25 DO DFNIQ^MAGQBPG1("Post Install error in Acquisition Site Validation","",1)
+26 SET ERRCNT=0
QUIT
End DoDot:3
End DoDot:2
+27 IF '$TEST
Begin DoDot:2
+28 IF TMPACQ'=TINSTIEN
SET $PIECE(^MAG(FNUM,IEN,100),U,3)=TINSTIEN
+29 if (FNUM=2005)
SET ^MAG(2005,"D",TINSTIEN,IEN)=""
+30 QUIT
End DoDot:2
+31 IF CON
IF TINSTIEN'=""
IF TMPACQ'=TINSTIEN
SET ^TMP($JOB,"CHANGE_IEN",CHANGE+1)=TMPACQ_U_TINSTIEN_U_IEN
SET CHANGE=CHANGE+1
+32 SET FILE=$PIECE($GET(^MAG(FNUM,IEN,0)),U,2)
if '$DATA(FILE)
QUIT
if $LENGTH(FILE)<9
QUIT
+33 SET FILE=$PIECE(FILE,".")
+34 KILL ^MAG(FNUM,"F",$EXTRACT(FILE,1,30),IEN),^MAG(FNUM,"f",$EXTRACT(FILE,1,30),IEN)
+35 SET ^MAG(FNUM,"F",$EXTRACT(FILE,1,30),IEN)=""
+36 QUIT
End DoDot:1
if 'IEN
QUIT
+37 IF ERRCNT>0
DO DFNIQ^MAGQBPG1("Post Install error in Acquisition Site Validation","",1)
+38 IF CHANGE>0
DO ACQUD^MAGQBUT4(LIMIT)
+39 KILL NMSP,SITEARAY,STATION
+40 KILL ^MAG(2005.2,"B"),^MAG(2005.2,"C"),^MAG(2005.2,"D"),^MAG(2005.2,"E"),^MAG(2005.2,"F")
+41 KILL ^MAG(2005.2,"AC")
+42 SET DIK="^MAG(2005.2,"
DO IXALL^DIK
+43 KILL ^MAG(2006.1,"B"),^MAG(2006.1,"AC"),^MAG(2006.1,"AD")
+44 SET DIK="^MAG(2006.1,"
DO IXALL^DIK
+45 KILL ^MAG(2006.8,"C"),^MAG(2006.8,"D"),^MAG(2006.8,"B"),^MAG(2006.8,"E")
+46 SET DIK="^MAG(2006.8,"
DO IXALL^DIK
+47 KILL ^MAGQUEUE(2006.03,"B"),^MAGQUEUE(2006.03,"C"),^MAGQUEUE(2006.03,"D"),^MAGQUEUE(2006.03,"E"),^MAGQUEUE(2006.03,"F")
+48 SET DIK="^MAGQUEUE(2006.03,"
DO IXALL^DIK
+49 KILL ^MAGQUEUE(2006.031,"B"),^MAGQUEUE(2006.031,"C")
+50 SET DIK="^MAGQUEUE(2006.031,"
DO IXALL^DIK
+51 KILL ^MAGQUEUE(2006.032,"B"),^MAGQUEUE(2006.032,"C")
+52 SET DIK="^MAGQUEUE(2006.032,"
DO IXALL^DIK
+53 KILL DIK
+54 IF GIC>1
Begin DoDot:1
+55 SET MESSAGE="It was necessary to attempt to recover the Acquisition site for this install"
+56 DO BMES^XPDUTL(MESSAGE)
+57 SET MESSAGE="using the following methods: "
+58 DO BMES^XPDUTL(MESSAGE)
+59 SET MESSAGE="$$GI: "_GIC_", this is the 'get institution' method, "
+60 DO BMES^XPDUTL(MESSAGE)
+61 SET MESSAGE="using the Institution file 'D' cross-reference."
+62 DO BMES^XPDUTL(MESSAGE)
+63 SET MESSAGE="$$CNL: "_NLC_", this is the 'network location file lookup method' for this image."
+64 DO BMES^XPDUTL(MESSAGE)
+65 SET MESSAGE="$$CNSP: "_NSC_", this is the 'image file namespace' method."
+66 DO BMES^XPDUTL(MESSAGE)
+67 QUIT
End DoDot:1
+68 QUIT
GI(TMPACQ,INSTIEN,GL,IEN,FNUM) ; Get institution
+1 NEW TMPI
+2 SET VALUE=""
+3 SET GIC=GIC+1
+4 IF TMPACQ'=""
IF $DATA(STATION("PROBLEM",TMPACQ))
SET TMPACQ=""
+5 IF TMPACQ'=""
Begin DoDot:1
+6 SET TMPI=$ORDER(STATION("STATION",TMPACQ,""))
+7 SET VALUE=$SELECT(TMPI="":"",$DATA(SITEARAY(TMPI)):TMPI,1:"")
+8 QUIT
End DoDot:1
if VALUE
QUIT VALUE
+9 IF GRPOBJ=0&($DATA(^MAG(FNUM,IEN,1,0)))
Begin DoDot:1
+10 NEW IENX,IENY
+11 SET IENX=$ORDER(^MAG(FNUM,IEN,1,0))
+12 IF IENX=""
QUIT
+13 SET GRPOBJ=1
+14 SET IENY=$PIECE(^MAG(FNUM,IEN,1,IENX,0),U)
+15 SET TMPACQ=$PIECE($GET(^MAG(FNUM,IENY,100)),U,3)
+16 IF (TMPACQ'="")
IF $DATA(SITEARAY(TMPACQ))
SET VALUE=TMPACQ
+17 IF '$TEST
SET VALUE=$SELECT('CON:INSTIEN,TMPACQ=INSTIEN:TMPACQ,1:$$GI(TMPACQ,INSTIEN,GL,IENY))
+18 QUIT
End DoDot:1
QUIT VALUE
+19 SET VALUE=$$CNL^MAGQBUT4(GL,IEN,.NLC)
+20 if VALUE
QUIT VALUE
+21 SET VALUE=$$CNSP^MAGQBUT4(GL,IEN,.NMSP,.NSC)
+22 QUIT VALUE
SETPL ;
+1 NEW IEN,NAME,DR,DA,DIE,X,Y,PLACE,FILE
+2 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+3 FOR FILE=2005.2,2006.8
Begin DoDot:1
+4 SET (NAME,IEN)=""
FOR
SET NAME=$ORDER(^MAG(FILE,"B",NAME))
if NAME=""
QUIT
Begin DoDot:2
+5 SET IEN=$ORDER(^MAG(FILE,"B",NAME,""))
+6 SET DR=".04///^S X=PLACE"
SET DA=IEN
SET DIE=FILE
DO ^DIE
+7 QUIT
End DoDot:2
End DoDot:1
+8 SET FILE=2006.032
SET (NAME,IEN)=""
+9 FOR
SET NAME=$ORDER(^MAGQUEUE(FILE,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+10 SET IEN=$ORDER(^MAGQUEUE(FILE,"B",NAME,""))
+11 SET DR=".04///^S X=PLACE"
SET DA=IEN
SET DIE=FILE
DO ^DIE
+12 QUIT
End DoDot:1
+13 QUIT
WSUP(MONTHS) ;
+1 NEW EDATE,PLACE,SDATE,IEN,DEFP,CNT,ZNODE,DAYS
+2 SET DAYS=MONTHS*(365/12)
+3 SET DEFP=$$KSP^XUPARAM("INST")
+4 SET EDATE=$$FMADD^XLFDT($$NOW^XLFDT,-DAYS,"","","")
+5 SET IEN=$ORDER(^MAG(2006.82," "),-1)
SET CNT=0
+6 FOR
SET IEN=$ORDER(^MAG(2006.82,IEN),-1)
if 'IEN
QUIT
SET SDATE=$PIECE($GET(^MAG(2006.82,IEN,0)),U,3)
if SDATE<EDATE
QUIT
Begin DoDot:1
+7 SET CNT=CNT+1
+8 if (CNT#1000)=0
WRITE "."
+9 if (CNT#80000)=0
WRITE !
+10 SET PLACE=$PIECE($GET(^MAG(2006.82,IEN,1)),U,4)
+11 SET PLACE=$SELECT(PLACE:PLACE,1:DEFP)
+12 SET ^MAG(2006.82,"APL",PLACE,SDATE,IEN)=""
End DoDot:1
+13 QUIT
SITEID ;
+1 NEW FDA,MSG,IEN
+2 SET IEN=$ORDER(^MAG(2006.1,"A"),-1)_","
+3 SET FDA(2006.1,IEN,.01)=$$KSP^XUPARAM("INST")
+4 DO FILE^DIE("E","FDA","MSG")
+5 QUIT
STATION ; make Imaging Site Parameters (2006.1) file a local array
+1 ; find problems in the "D" cross reference of the Institution file
+2 NEW I,IEN,INSTDA,SAVE,SITEDA
+3 SET INSTDA=""
FOR
SET INSTDA=$ORDER(^MAG(2006.1,"B",INSTDA))
if INSTDA=""
QUIT
SET SITEDA=""
Begin DoDot:1
+4 SET SITEDA=$ORDER(^MAG(2006.1,"B",INSTDA,SITEDA))
if SITEDA=""
QUIT
Begin DoDot:2
+5 SET SITEARAY(INSTDA,SITEDA)=""
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 KILL ^TMP($JOB,"MAG_STATION")
+9 SET STATION=""
+10 FOR
SET STATION=$ORDER(^DIC(4,"D",STATION))
if STATION=""
QUIT
SET IEN=""
Begin DoDot:1
+11 FOR I=1:1
SET IEN=$ORDER(^DIC(4,"D",STATION,IEN))
if IEN=""
QUIT
Begin DoDot:2
+12 SET ^TMP($JOB,"MAG_STATION",STATION)=I
+13 SET ^TMP($JOB,"MAG_STATION",STATION,IEN)=""
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 SET STATION=""
+17 FOR
SET STATION=$ORDER(^TMP($JOB,"MAG_STATION",STATION))
if STATION=""
QUIT
Begin DoDot:1
+18 SET SAVE=""
+19 SET STATION("STATION",STATION)=^TMP($JOB,"MAG_STATION",STATION)
+20 IF ^TMP($JOB,"MAG_STATION",STATION)>1
SET STATION("PROBLEM",STATION)=""
+21 SET IEN=""
+22 FOR
SET IEN=$ORDER(^TMP($JOB,"MAG_STATION",STATION,IEN))
if IEN=""
QUIT
Begin DoDot:2
+23 SET STATION("STATION",STATION,IEN)=""
+24 IF $DATA(^DIC(4,STATION))&(STATION'=IEN)
SET STATION("PROBLEM",STATION)=""
+25 IF $DATA(SITEARAY(IEN))
SET SAVE=1
+26 QUIT
End DoDot:2
+27 IF SAVE=1
QUIT
+28 KILL STATION("STATION",STATION)
+29 QUIT
End DoDot:1
+30 KILL ^TMP($JOB,"MAG_STATION")
+31 QUIT
+32 ;
