SR100UTL.m

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

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