source: FOIAVistA/tag/r/SURGERY-SR/SR100UTL.m@ 1569

Last change on this file since 1569 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1SR100UTL ;BIR/ADM - SR*3*100 INSTALL UTILITY ; [ 02/18/04 10:19 AM ]
2 ;;3.0; Surgery ;**100**;24 Jun 93
3 ;
4 ; Reference to EXTRACT^TIULQ supported by DBIA #2693
5 ; Reference to FILE^TIUSRVP supported by DBIA #3540
6 ; Reference to $$WHATITLE^TIUPUTU supported by DBIA #3351
7 ; Reference to $$DOCCLASS^TIULC1 supported by DBIA #3548
8 ;
9 Q
10PRE ; pre-install entry
11 ; delete ADIC, AUD, AUD1 x-refs, delete x-ref nodes
12 K DIE,DR,DIK,DA S DIK="^DD(130,.23,1,",DA=3,DA(1)=.23,DA(2)=130 D ^DIK
13 K DIK,DA S DIK="^DD(130,.232,1,",DA=2,DA(1)=.232,DA(2)=130 D ^DIK
14 K DIK,DA S DIK="^DD(130,15,1,",DA=1,DA(1)=15,DA(2)=130 D ^DIK
15 K DIK,DA,^SRF("AUD"),^SRF("ADIC")
16 Q
17POST ; post-install entry
18 ; delete file 136
19 I $D(^SRT(0)) S DIU="^SRT(",DIU(0)="DT" D EN^DIU2 K DIU
20 N I,SRPOS
21 F I=1:1:13 S SRPOS(I)=$G(XPDQUES("POS"_$S(I<10:"0",1:"")_I))
22 Q:SRPOS(4)=""
23 D PARAM
24 D NOW^%DTC S (SRNOW,ZTDTH)=$E(%,1,12),ZTRTN="EN1^SR100UTL",ZTDESC="SR*3*100 - Post-Install Process",ZTIO="",ZTSAVE("SRPOS*")="" D ^%ZTLOAD
25 D MES^XPDUTL(" SR*3*100 post-install process queued...")
26 ; delete unused new routines associated with SR*3*100 at test sites
27DEL F X="SRONP0","SRONP1" X ^%ZOSF("TEST") I $T D
28 .D MES^XPDUTL(" Deleting routine "_X_"...")
29 .X ^%ZOSF("DEL")
30 Q
31EN1 ; queued entry point
32 D BOST
33 D STUBS
34 I SRPOS(6) D MOVE
35MSG ; send mail message notification that post-insatll process is completed
36 S XMY(DUZ)="",XMSUB="SR*3*100 Post-Install Is Completed"
37 S SRTXT(1)="The post-install process for patch SR*3*100 is completed."
38 S XMDUZ=.5,XMTEXT="SRTXT("
39 N I D ^XMD S ZTREQ="@"
40 Q
41STUBS ; identify and create stub entries in TIU for reports to be signed
42 N SRDT,SRTN Q:SRPOS(5)=""
43 S SRDT=SRPOS(5)-".0001"
44 F S SRDT=$O(^SRF("AC",SRDT)) Q:'SRDT S SRTN=0 F S SRTN=$O(^SRF("AC",SRDT,SRTN)) Q:'SRTN D
45 .I $P($G(^SRF(SRTN,"NON")),"^")="Y" D NONOR Q
46 .I $P($G(^SRF(SRTN,.2)),"^",12) D
47 ..I '$P($G(^SRF(SRTN,"TIU")),"^") D OR^SROESX
48 ..I '$P($G(^SRF(SRTN,"TIU")),"^",2) D NR^SROESX
49 ..I '$P($G(^SRF(SRTN,"TIU")),"^",4),$P($G(^SRF(SRTN,.2)),"^",4),$$INUSE^SROESXA(SRTN) D AR^SROESXA
50 Q
51PARAM ; set default site parameters
52 N DIV,J,SRP,Y,Z
53 S SRP="^0^0" S $P(SRP,"^",4)=SRPOS(4)
54 S DIV=0 F S DIV=$O(^SRO(133,DIV)) Q:'DIV S ^SRO(133,DIV,.1)=SRP
55SRTAB ; activate surgery tab system-wide
56 D PUT^XPAR("SYS","ORWOR SHOW SURGERY TAB",1,1,.SRERR)
57 Q
58BOST ; convert Boston prototype cases
59 N DA,DIC,DIQ,DR,SRBOST,SREQ,SRERR,SRPAR,SRTITL,SRTN,SRX,SRY
60 ; quit if Boston software is not installed
61 I $$GET1^DID(130,523011,"","LABEL")'["OP NOTE POINTER" Q
62 S SRX=$$WHATITLE^TIUPUTU("OPERATION REPORT"),SRTITL=$P(SRX,"^") Q:'SRTITL
63 S SRPAR=$$DOCCLASS^TIULC1(SRTITL) Q:'SRPAR
64 S SRTN=0 F S SRTN=$O(^SRF(SRTN)) Q:'SRTN S SRBOST=$P($G(^SRF(SRTN,523)),"^",4) I SRBOST,'$P($G(^SRF(SRTN,"TIU")),"^") D
65 .D EXTRACT^TIULQ(SRBOST,"SRY",.SRERR,"1701")
66 .I $G(SRY(SRBOST,1701,"E"))="Case #: "_SRTN D K SRY
67 ..S $P(^SRF(SRTN,"TIU"),"^")=SRBOST
68 ..K SREQ S SREQ(.01)=SRTITL,SREQ(.04)=SRPAR,SREQ(1405)=SRTN_";SRF(" D FILE^TIUSRVP(.SRERR,SRBOST,.SREQ,1)
69 Q
70MOVE ; move reports for historical cases to TIU
71 N SRSD,SRRPT,SRINST,SRINSTP I SRPOS(7)="" S SRPOS(7)=SRPOS(5)
72 S SRSD=SRPOS(7),SRRPT(1)=SRPOS(8),SRRPT(2)=SRPOS(9),SRRPT(3)=SRPOS(10),SRRPT(4)=SRPOS(11),(SRINST,SRINSTP)="ALL DIVISIONS"
73 D MOVE^SROHIS
74 Q
75NONOR ; if dictated summary expected field is null, set to 0
76 I $P($G(^SRF(SRTN,"TIU")),"^",5)="" S $P(^SRF(SRTN,"TIU"),"^",5)=0
77 Q
Note: See TracBrowser for help on using the repository browser.