SR100UTL ;BIR/ADM - SR*3*100 INSTALL UTILITY ; [ 02/18/04 10:19 AM ]
;;3.0; Surgery ;**100**;24 Jun 93
;
; Reference to EXTRACT^TIULQ supported by DBIA #2693
; Reference to FILE^TIUSRVP supported by DBIA #3540
; Reference to $$WHATITLE^TIUPUTU supported by DBIA #3351
; Reference to $$DOCCLASS^TIULC1 supported by DBIA #3548
;
Q
PRE ; pre-install entry
; delete ADIC, AUD, AUD1 x-refs, delete x-ref nodes
K DIE,DR,DIK,DA S DIK="^DD(130,.23,1,",DA=3,DA(1)=.23,DA(2)=130 D ^DIK
K DIK,DA S DIK="^DD(130,.232,1,",DA=2,DA(1)=.232,DA(2)=130 D ^DIK
K DIK,DA S DIK="^DD(130,15,1,",DA=1,DA(1)=15,DA(2)=130 D ^DIK
K DIK,DA,^SRF("AUD"),^SRF("ADIC")
Q
POST ; post-install entry
; delete file 136
I $D(^SRT(0)) S DIU="^SRT(",DIU(0)="DT" D EN^DIU2 K DIU
N I,SRPOS
F I=1:1:13 S SRPOS(I)=$G(XPDQUES("POS"_$S(I<10:"0",1:"")_I))
Q:SRPOS(4)=""
D PARAM
D NOW^%DTC S (SRNOW,ZTDTH)=$E(%,1,12),ZTRTN="EN1^SR100UTL",ZTDESC="SR*3*100 - Post-Install Process",ZTIO="",ZTSAVE("SRPOS*")="" D ^%ZTLOAD
D MES^XPDUTL(" SR*3*100 post-install process queued...")
; delete unused new routines associated with SR*3*100 at test sites
DEL F X="SRONP0","SRONP1" X ^%ZOSF("TEST") I $T D
.D MES^XPDUTL(" Deleting routine "_X_"...")
.X ^%ZOSF("DEL")
Q
EN1 ; queued entry point
D BOST
D STUBS
I SRPOS(6) D MOVE
MSG ; send mail message notification that post-insatll process is completed
S XMY(DUZ)="",XMSUB="SR*3*100 Post-Install Is Completed"
S SRTXT(1)="The post-install process for patch SR*3*100 is completed."
S XMDUZ=.5,XMTEXT="SRTXT("
N I D ^XMD S ZTREQ="@"
Q
STUBS ; identify and create stub entries in TIU for reports to be signed
N SRDT,SRTN Q:SRPOS(5)=""
S SRDT=SRPOS(5)-".0001"
F S SRDT=$O(^SRF("AC",SRDT)) Q:'SRDT S SRTN=0 F S SRTN=$O(^SRF("AC",SRDT,SRTN)) Q:'SRTN D
.I $P($G(^SRF(SRTN,"NON")),"^")="Y" D NONOR Q
.I $P($G(^SRF(SRTN,.2)),"^",12) D
..I '$P($G(^SRF(SRTN,"TIU")),"^") D OR^SROESX
..I '$P($G(^SRF(SRTN,"TIU")),"^",2) D NR^SROESX
..I '$P($G(^SRF(SRTN,"TIU")),"^",4),$P($G(^SRF(SRTN,.2)),"^",4),$$INUSE^SROESXA(SRTN) D AR^SROESXA
Q
PARAM ; set default site parameters
N DIV,J,SRP,Y,Z
S SRP="^0^0" S $P(SRP,"^",4)=SRPOS(4)
S DIV=0 F S DIV=$O(^SRO(133,DIV)) Q:'DIV S ^SRO(133,DIV,.1)=SRP
SRTAB ; activate surgery tab system-wide
D PUT^XPAR("SYS","ORWOR SHOW SURGERY TAB",1,1,.SRERR)
Q
BOST ; convert Boston prototype cases
N DA,DIC,DIQ,DR,SRBOST,SREQ,SRERR,SRPAR,SRTITL,SRTN,SRX,SRY
; quit if Boston software is not installed
I $$GET1^DID(130,523011,"","LABEL")'["OP NOTE POINTER" Q
S SRX=$$WHATITLE^TIUPUTU("OPERATION REPORT"),SRTITL=$P(SRX,"^") Q:'SRTITL
S SRPAR=$$DOCCLASS^TIULC1(SRTITL) Q:'SRPAR
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
.D EXTRACT^TIULQ(SRBOST,"SRY",.SRERR,"1701")
.I $G(SRY(SRBOST,1701,"E"))="Case #: "_SRTN D K SRY
..S $P(^SRF(SRTN,"TIU"),"^")=SRBOST
..K SREQ S SREQ(.01)=SRTITL,SREQ(.04)=SRPAR,SREQ(1405)=SRTN_";SRF(" D FILE^TIUSRVP(.SRERR,SRBOST,.SREQ,1)
Q
MOVE ; move reports for historical cases to TIU
N SRSD,SRRPT,SRINST,SRINSTP I SRPOS(7)="" S SRPOS(7)=SRPOS(5)
S SRSD=SRPOS(7),SRRPT(1)=SRPOS(8),SRRPT(2)=SRPOS(9),SRRPT(3)=SRPOS(10),SRRPT(4)=SRPOS(11),(SRINST,SRINSTP)="ALL DIVISIONS"
D MOVE^SROHIS
Q
NONOR ; if dictated summary expected field is null, set to 0
I $P($G(^SRF(SRTN,"TIU")),"^",5)="" S $P(^SRF(SRTN,"TIU"),"^",5)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR100UTL 3471 printed Dec 13, 2024@02:37:56 Page 2
SR100UTL ;BIR/ADM - SR*3*100 INSTALL UTILITY ; [ 02/18/04 10:19 AM ]
+1 ;;3.0; Surgery ;**100**;24 Jun 93
+2 ;
+3 ; Reference to EXTRACT^TIULQ supported by DBIA #2693
+4 ; Reference to FILE^TIUSRVP supported by DBIA #3540
+5 ; Reference to $$WHATITLE^TIUPUTU supported by DBIA #3351
+6 ; Reference to $$DOCCLASS^TIULC1 supported by DBIA #3548
+7 ;
+8 QUIT
PRE ; pre-install entry
+1 ; delete ADIC, AUD, AUD1 x-refs, delete x-ref nodes
+2 KILL DIE,DR,DIK,DA
SET DIK="^DD(130,.23,1,"
SET DA=3
SET DA(1)=.23
SET DA(2)=130
DO ^DIK
+3 KILL DIK,DA
SET DIK="^DD(130,.232,1,"
SET DA=2
SET DA(1)=.232
SET DA(2)=130
DO ^DIK
+4 KILL DIK,DA
SET DIK="^DD(130,15,1,"
SET DA=1
SET DA(1)=15
SET DA(2)=130
DO ^DIK
+5 KILL DIK,DA,^SRF("AUD"),^SRF("ADIC")
+6 QUIT
POST ; post-install entry
+1 ; delete file 136
+2 IF $DATA(^SRT(0))
SET DIU="^SRT("
SET DIU(0)="DT"
DO EN^DIU2
KILL DIU
+3 NEW I,SRPOS
+4 FOR I=1:1:13
SET SRPOS(I)=$GET(XPDQUES("POS"_$SELECT(I<10:"0",1:"")_I))
+5 if SRPOS(4)=""
QUIT
+6 DO PARAM
+7 DO NOW^%DTC
SET (SRNOW,ZTDTH)=$EXTRACT(%,1,12)
SET ZTRTN="EN1^SR100UTL"
SET ZTDESC="SR*3*100 - Post-Install Process"
SET ZTIO=""
SET ZTSAVE("SRPOS*")=""
DO ^%ZTLOAD
+8 DO MES^XPDUTL(" SR*3*100 post-install process queued...")
+9 ; delete unused new routines associated with SR*3*100 at test sites
DEL FOR X="SRONP0","SRONP1"
XECUTE ^%ZOSF("TEST")
IF $TEST
Begin DoDot:1
+1 DO MES^XPDUTL(" Deleting routine "_X_"...")
+2 XECUTE ^%ZOSF("DEL")
End DoDot:1
+3 QUIT
EN1 ; queued entry point
+1 DO BOST
+2 DO STUBS
+3 IF SRPOS(6)
DO MOVE
MSG ; send mail message notification that post-insatll process is completed
+1 SET XMY(DUZ)=""
SET XMSUB="SR*3*100 Post-Install Is Completed"
+2 SET SRTXT(1)="The post-install process for patch SR*3*100 is completed."
+3 SET XMDUZ=.5
SET XMTEXT="SRTXT("
+4 NEW I
DO ^XMD
SET ZTREQ="@"
+5 QUIT
STUBS ; identify and create stub entries in TIU for reports to be signed
+1 NEW SRDT,SRTN
if SRPOS(5)=""
QUIT
+2 SET SRDT=SRPOS(5)-".0001"
+3 FOR
SET SRDT=$ORDER(^SRF("AC",SRDT))
if 'SRDT
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRDT,SRTN))
if 'SRTN
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
DO NONOR
QUIT
+5 IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)
Begin DoDot:2
+6 IF '$PIECE($GET(^SRF(SRTN,"TIU")),"^")
DO OR^SROESX
+7 IF '$PIECE($GET(^SRF(SRTN,"TIU")),"^",2)
DO NR^SROESX
+8 IF '$PIECE($GET(^SRF(SRTN,"TIU")),"^",4)
IF $PIECE($GET(^SRF(SRTN,.2)),"^",4)
IF $$INUSE^SROESXA(SRTN)
DO AR^SROESXA
End DoDot:2
End DoDot:1
+9 QUIT
PARAM ; set default site parameters
+1 NEW DIV,J,SRP,Y,Z
+2 SET SRP="^0^0"
SET $PIECE(SRP,"^",4)=SRPOS(4)
+3 SET DIV=0
FOR
SET DIV=$ORDER(^SRO(133,DIV))
if 'DIV
QUIT
SET ^SRO(133,DIV,.1)=SRP
SRTAB ; activate surgery tab system-wide
+1 DO PUT^XPAR("SYS","ORWOR SHOW SURGERY TAB",1,1,.SRERR)
+2 QUIT
BOST ; convert Boston prototype cases
+1 NEW DA,DIC,DIQ,DR,SRBOST,SREQ,SRERR,SRPAR,SRTITL,SRTN,SRX,SRY
+2 ; quit if Boston software is not installed
+3 IF $$GET1^DID(130,523011,"","LABEL")'["OP NOTE POINTER"
QUIT
+4 SET SRX=$$WHATITLE^TIUPUTU("OPERATION REPORT")
SET SRTITL=$PIECE(SRX,"^")
if 'SRTITL
QUIT
+5 SET SRPAR=$$DOCCLASS^TIULC1(SRTITL)
if 'SRPAR
QUIT
+6 SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF(SRTN))
if 'SRTN
QUIT
SET SRBOST=$PIECE($GET(^SRF(SRTN,523)),"^",4)
IF SRBOST
IF '$PIECE($GET(^SRF(SRTN,"TIU")),"^")
Begin DoDot:1
+7 DO EXTRACT^TIULQ(SRBOST,"SRY",.SRERR,"1701")
+8 IF $GET(SRY(SRBOST,1701,"E"))="Case #: "_SRTN
Begin DoDot:2
+9 SET $PIECE(^SRF(SRTN,"TIU"),"^")=SRBOST
+10 KILL SREQ
SET SREQ(.01)=SRTITL
SET SREQ(.04)=SRPAR
SET SREQ(1405)=SRTN_";SRF("
DO FILE^TIUSRVP(.SRERR,SRBOST,.SREQ,1)
End DoDot:2
KILL SRY
End DoDot:1
+11 QUIT
MOVE ; move reports for historical cases to TIU
+1 NEW SRSD,SRRPT,SRINST,SRINSTP
IF SRPOS(7)=""
SET SRPOS(7)=SRPOS(5)
+2 SET SRSD=SRPOS(7)
SET SRRPT(1)=SRPOS(8)
SET SRRPT(2)=SRPOS(9)
SET SRRPT(3)=SRPOS(10)
SET SRRPT(4)=SRPOS(11)
SET (SRINST,SRINSTP)="ALL DIVISIONS"
+3 DO MOVE^SROHIS
+4 QUIT
NONOR ; if dictated summary expected field is null, set to 0
+1 IF $PIECE($GET(^SRF(SRTN,"TIU")),"^",5)=""
SET $PIECE(^SRF(SRTN,"TIU"),"^",5)=0
+2 QUIT
