- SROESXP ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/16/04 09:30 AM ]
- ;;3.0; Surgery ;**100,129**;24 Jun 93
- ;** NOTICE: This routine is part of an implementation of a nationally
- ;** controlled procedure. Local modifications to this routine
- ;** are prohibited.
- ;
- ; Reference to $$WHATITLE^TIUPUTU supported by DBIA #3351
- ; Reference to DELETE^TIUSRVP supported by DBIA #3535
- ; Reference to MAKE^TIUSRVP supported by DBIA #3535
- ; Reference to UPDATE^TIUSRVP supported by DBIA #3535
- ;
- Q
- SCOND(X1,X2) ; set condition for AESP x-ref
- N SRADD,SRI,X1NULL,X2NULL S (X1NULL,X2NULL)=0
- F SRI=1,2 S:X1(SRI)="" X1NULL=1 S:X2(SRI)="" X2NULL=1
- I X1NULL&'X2NULL S SRADD=1
- E S SRADD=0
- I SRADD,'X(2) S SRADD=0
- I X1(1)=X2(1),'X1(2),X2(2) S SRADD=1
- Q SRADD
- KCOND(X1,X2) ; kill condition for AESP x-ref
- N SRDEL,SRI,X1NULL,X2NULL S (X1NULL,X2NULL)=0
- F SRI=1,2 S:X1(SRI)="" X1NULL=1 S:X2(SRI)="" X2NULL=1
- I X2NULL&'X1NULL S SRDEL=1
- E S SRDEL=0
- I SRDEL,'X(2) S SRDEL=0
- I X1(1)=X2(1),'X2(2),X1(2) S SRDEL=1
- Q SRDEL
- AESP ; set logic for AESP cross-reference
- N SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK
- S SRTN=DA I '$P($G(^SRF(SRTN,"NON")),"^",5)!'$P($G(^SRF(SRTN,"TIU")),"^",5) Q
- S ZTDESC="Surgery Non-OR Procedure Report Stub",ZTRTN="PR^SROESXP",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD
- Q
- PR ; create stub entry in TIU for non-OR procedure report
- N DFN,DIC,SR0,SRACODE,SRATT,SRAY,SRD,SRDIV,SRDOC,SRLOC,SRPROV,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,VSTR,X,Y
- I '$P($G(^SRF(SRTN,"NON")),"^",5)!'$P($G(^SRF(SRTN,"TIU")),"^",5) D END Q
- S SRD=$P($G(^SRF(SRTN,"TIU")),"^",3) I SRD D END Q
- S SRX=$$WHATITLE^TIUPUTU("PROCEDURE REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
- S SRDIV=$$SITE^SROUTL0(SRTN),SR0=^SRF(SRTN,0),DFN=$P(SR0,"^") D LOC
- S X=$G(^SRF(SRTN,"NON")),SRATT=$P(X,"^",7),SRPROV=$P(X,"^",6)
- S SRACODE=$P($G(^SRF(SRTN,.1)),"^",10)
- I 'SRATT D
- .I "159"[SRACODE S SRATT=SRPROV Q
- .I SRDIV,'$P(^SRO(133,SRDIV,0),"^",19) S SRATT=SRPROV
- S SRAY(.02)=DFN,SRAY(.05)=1,(SRAY(1202),SRAY(1204))=SRPROV,SRAY(1205)=SRLOC,(SRAY(1208),SRAY(1209))=SRATT,SRAY(1301)=$P(SR0,"^",9),SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
- S (VDT,VLOC,VSIT)=""
- S (SRAY(1301),VDT)=$P($G(^SRF(SRTN,"NON")),"^",4),VSIT=$P(SR0,"^",15)
- I 'VSIT S VLOC=SRLOC
- I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";"_$S(+$D(^DPT(DFN,.1)):"I",1:"E")
- D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU D
- .F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",3)=SRTIU L -^SRF("TIU"_SRTN) Q
- END S ZTREQ="@"
- Q
- LOC ; get patient location
- N SRDEF,SROR,SRT,SRWARD,VAIP S VAIP("D")=$P($G(^SRF(SRTN,"NON")),"^",4) D IN5^VADPT
- S SRWARD=$P(VAIP(5),"^"),(SRDEF,SRLOC)="",SROR=$P($G(^SRF(SRTN,"NON")),"^",2)
- I SRWARD K DA,DIC,DIQ,DR S DA=SRWARD,DIC=42,DR="44",DIQ="SRT",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR S SRLOC=$G(SRT(42,SRWARD,44,"I"))
- S SRDEF=$P($G(^SRO(133,SRDIV,0)),"^",23)
- I SRDEF="" S X="SURGERY OP REPORT NON-COUNT",DIC(0)="M",DIC="^SC(" D ^DIC K DIC I +Y>0 S SRDEF=+Y
- S SRLOC=$S(SRLOC:SRLOC,SRDEF:SRDEF,SROR:SROR,1:"")
- Q
- STATUS(SRSTAT) ; update status
- K SRAY S SRAY(.05)=SRSTAT D UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)
- Q
- KAESP ; kill logic for the AESP cross-reference
- N SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK S SRTN=DA
- S ZTDESC="Surgery Non-OR Procedure Report Delete Stub",ZTRTN="KSTUB^SROESXP",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD
- Q
- KSTUB ; delete stub in TIU for unsigned procedure report (non-OR)
- N SRERR,SRTIU
- S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",3) I SRTIU D DELETE^TIUSRVP(.SRERR,SRTIU,,1) I 'SRERR D
- .F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",3)="" L -^SRF("TIU"_SRTN) Q
- D END
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROESXP 3707 printed Feb 19, 2025@00:10:14 Page 2
- SROESXP ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/16/04 09:30 AM ]
- +1 ;;3.0; Surgery ;**100,129**;24 Jun 93
- +2 ;** NOTICE: This routine is part of an implementation of a nationally
- +3 ;** controlled procedure. Local modifications to this routine
- +4 ;** are prohibited.
- +5 ;
- +6 ; Reference to $$WHATITLE^TIUPUTU supported by DBIA #3351
- +7 ; Reference to DELETE^TIUSRVP supported by DBIA #3535
- +8 ; Reference to MAKE^TIUSRVP supported by DBIA #3535
- +9 ; Reference to UPDATE^TIUSRVP supported by DBIA #3535
- +10 ;
- +11 QUIT
- SCOND(X1,X2) ; set condition for AESP x-ref
- +1 NEW SRADD,SRI,X1NULL,X2NULL
- SET (X1NULL,X2NULL)=0
- +2 FOR SRI=1,2
- if X1(SRI)=""
- SET X1NULL=1
- if X2(SRI)=""
- SET X2NULL=1
- +3 IF X1NULL&'X2NULL
- SET SRADD=1
- +4 IF '$TEST
- SET SRADD=0
- +5 IF SRADD
- IF 'X(2)
- SET SRADD=0
- +6 IF X1(1)=X2(1)
- IF 'X1(2)
- IF X2(2)
- SET SRADD=1
- +7 QUIT SRADD
- KCOND(X1,X2) ; kill condition for AESP x-ref
- +1 NEW SRDEL,SRI,X1NULL,X2NULL
- SET (X1NULL,X2NULL)=0
- +2 FOR SRI=1,2
- if X1(SRI)=""
- SET X1NULL=1
- if X2(SRI)=""
- SET X2NULL=1
- +3 IF X2NULL&'X1NULL
- SET SRDEL=1
- +4 IF '$TEST
- SET SRDEL=0
- +5 IF SRDEL
- IF 'X(2)
- SET SRDEL=0
- +6 IF X1(1)=X2(1)
- IF 'X2(2)
- IF X1(2)
- SET SRDEL=1
- +7 QUIT SRDEL
- AESP ; set logic for AESP cross-reference
- +1 NEW SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK
- +2 SET SRTN=DA
- IF '$PIECE($GET(^SRF(SRTN,"NON")),"^",5)!'$PIECE($GET(^SRF(SRTN,"TIU")),"^",5)
- QUIT
- +3 SET ZTDESC="Surgery Non-OR Procedure Report Stub"
- SET ZTRTN="PR^SROESXP"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- SET ZTSAVE("SRTN")=""
- DO ^%ZTLOAD
- +4 QUIT
- PR ; create stub entry in TIU for non-OR procedure report
- +1 NEW DFN,DIC,SR0,SRACODE,SRATT,SRAY,SRD,SRDIV,SRDOC,SRLOC,SRPROV,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,VSTR,X,Y
- +2 IF '$PIECE($GET(^SRF(SRTN,"NON")),"^",5)!'$PIECE($GET(^SRF(SRTN,"TIU")),"^",5)
- DO END
- QUIT
- +3 SET SRD=$PIECE($GET(^SRF(SRTN,"TIU")),"^",3)
- IF SRD
- DO END
- QUIT
- +4 SET SRX=$$WHATITLE^TIUPUTU("PROCEDURE REPORT")
- SET TITLE=$PIECE(SRX,"^")
- IF 'TITLE
- QUIT
- +5 SET SRDIV=$$SITE^SROUTL0(SRTN)
- SET SR0=^SRF(SRTN,0)
- SET DFN=$PIECE(SR0,"^")
- DO LOC
- +6 SET X=$GET(^SRF(SRTN,"NON"))
- SET SRATT=$PIECE(X,"^",7)
- SET SRPROV=$PIECE(X,"^",6)
- +7 SET SRACODE=$PIECE($GET(^SRF(SRTN,.1)),"^",10)
- +8 IF 'SRATT
- Begin DoDot:1
- +9 IF "159"[SRACODE
- SET SRATT=SRPROV
- QUIT
- +10 IF SRDIV
- IF '$PIECE(^SRO(133,SRDIV,0),"^",19)
- SET SRATT=SRPROV
- End DoDot:1
- +11 SET SRAY(.02)=DFN
- SET SRAY(.05)=1
- SET (SRAY(1202),SRAY(1204))=SRPROV
- SET SRAY(1205)=SRLOC
- SET (SRAY(1208),SRAY(1209))=SRATT
- SET SRAY(1301)=$PIECE(SR0,"^",9)
- SET SRAY(1405)=SRTN_";SRF("
- SET SRAY(1701)="Case #: "_SRTN
- +12 SET (VDT,VLOC,VSIT)=""
- +13 SET (SRAY(1301),VDT)=$PIECE($GET(^SRF(SRTN,"NON")),"^",4)
- SET VSIT=$PIECE(SR0,"^",15)
- +14 IF 'VSIT
- SET VLOC=SRLOC
- +15 IF VLOC
- SET SRAY(1211)=VLOC
- SET VSTR=VLOC_";"_VDT_";"_$SELECT(+$DATA(^DPT(DFN,.1)):"I",1:"E")
- +16 DO MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$GET(VSTR),1,1)
- IF SRTIU
- Begin DoDot:1
- +17 FOR
- LOCK +^SRF("TIU"_SRTN):5
- IF $TEST
- SET $PIECE(^SRF(SRTN,"TIU"),"^",3)=SRTIU
- LOCK -^SRF("TIU"_SRTN)
- QUIT
- End DoDot:1
- END SET ZTREQ="@"
- +1 QUIT
- LOC ; get patient location
- +1 NEW SRDEF,SROR,SRT,SRWARD,VAIP
- SET VAIP("D")=$PIECE($GET(^SRF(SRTN,"NON")),"^",4)
- DO IN5^VADPT
- +2 SET SRWARD=$PIECE(VAIP(5),"^")
- SET (SRDEF,SRLOC)=""
- SET SROR=$PIECE($GET(^SRF(SRTN,"NON")),"^",2)
- +3 IF SRWARD
- KILL DA,DIC,DIQ,DR
- SET DA=SRWARD
- SET DIC=42
- SET DR="44"
- SET DIQ="SRT"
- SET DIQ(0)="I"
- DO EN^DIQ1
- KILL DA,DIC,DIQ,DR
- SET SRLOC=$GET(SRT(42,SRWARD,44,"I"))
- +4 SET SRDEF=$PIECE($GET(^SRO(133,SRDIV,0)),"^",23)
- +5 IF SRDEF=""
- SET X="SURGERY OP REPORT NON-COUNT"
- SET DIC(0)="M"
- SET DIC="^SC("
- DO ^DIC
- KILL DIC
- IF +Y>0
- SET SRDEF=+Y
- +6 SET SRLOC=$SELECT(SRLOC:SRLOC,SRDEF:SRDEF,SROR:SROR,1:"")
- +7 QUIT
- STATUS(SRSTAT) ; update status
- +1 KILL SRAY
- SET SRAY(.05)=SRSTAT
- DO UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)
- +2 QUIT
- KAESP ; kill logic for the AESP cross-reference
- +1 NEW SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK
- SET SRTN=DA
- +2 SET ZTDESC="Surgery Non-OR Procedure Report Delete Stub"
- SET ZTRTN="KSTUB^SROESXP"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- SET ZTSAVE("SRTN")=""
- DO ^%ZTLOAD
- +3 QUIT
- KSTUB ; delete stub in TIU for unsigned procedure report (non-OR)
- +1 NEW SRERR,SRTIU
- +2 SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",3)
- IF SRTIU
- DO DELETE^TIUSRVP(.SRERR,SRTIU,,1)
- IF 'SRERR
- Begin DoDot:1
- +3 FOR
- LOCK +^SRF("TIU"_SRTN):5
- IF $TEST
- SET $PIECE(^SRF(SRTN,"TIU"),"^",3)=""
- LOCK -^SRF("TIU"_SRTN)
- QUIT
- End DoDot:1
- +4 DO END
- +5 QUIT