SROXR1 ;B'HAM ISC/MAM - CROSS REFERENCES (CONT) ;10/05/04
;;3.0; Surgery ;**34,72,79,100,134**;24 Jun 93
ATT ; ATT x-ref on surgeon to update attend surg
N SRDIV,SREQ S SRDIV=$$SITE^SROUTL0(DA) Q:'SRDIV
I $P(^SRO(133,SRDIV,0),"^",19)'=0 Q
S SREQ(130,DA_",",.164)=X D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
Q
KATT ; kill logic for ATT x-ref
Q
ATTP ; ATTP x-ref on provider to update attend provider
N SRDIV,SREQ S SRDIV=$$SITE^SROUTL0(DA) Q:'SRDIV
I $P(^SRO(133,SRDIV,0),"^",19)'=0 Q
S SREQ(130,DA_",",124)=X D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
Q
KATTP ; kill logic for ATTP x-ref
Q
AR ; 'AR' x-ref on the 'DATE OF OPERATION'
; field in the SURGERY file (130)
Q:'$D(^SRF(DA,"REQ")) I $P(^SRF(DA,"REQ"),"^")'=1 Q
I $D(^SRF(DA,31)),$P(^(31),"^",4) Q
S:$E(X,1,7)'<DT DFN=$P(^SRF(DA,0),"^"),^SRF("AR",$E(X,1,7),DFN,DA)=""
Q
KAR ; 'KILL' logic of the 'AR' x-ref on the 'DATE OF
; OPERATION' field in the SURGERY file (130)
S DFN=$P(^SRF(DA,0),"^") K ^SRF("AR",$E(X,1,7),DFN,DA)
Q
SP ; set 'ASP' and 'AOR' x-refs when date is changed
I $P(^SRF(DA,0),"^",4) S ^SRF("ASP",$P(^(0),"^",4),$E(X,1,7),DA)=DA
OR I $P(^SRF(DA,0),"^",2) S ^SRF("AOR",$P(^(0),"^",2),$E(X,1,7),DA)=""
Q
KSP ; kill 'ASP' and 'AOR' x-refs when date is changed
I $P(^SRF(DA,0),"^",4) K ^SRF("ASP",$P(^(0),"^",4),$E(X,1,7),DA)
KOR S DFN=$P(^SRF(DA,0),"^") I $P(^SRF(DA,0),"^",2) K ^SRF("AOR",$P(^(0),"^",2),$E(X,1,7),DA)
Q
IV ; delete IV orders
S SRT("X")=X D NOW^%DTC S X=SRT("X"),X1=$E(%,1,12) D MINS^SRSUTL2
I X>1440 D OUT Q
I X>60 D
.D EN^DDIOL("A considerable amount of time has passed since the "_$S($P($G(^SRF(SRTN,"NON")),"^")="Y":"procedure",1:"operation")_" start",,"!!,?2")
.D EN^DDIOL("time and the present time.",,"!,?2")
D IV1
OUT S X=SRT("X") K SRT,X1,Y
Q
IV1 K DIR W ! S DIR("?",1)="Enter 'YES' to cancel current IV orders. Enter 'NO' or '^' to continue",DIR("?")="without cancelling the patient's current IV orders.",DIR("B")=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":"NO",1:"YES")
S DIR("A")="Do you want to cancel all current IV orders for this patient (Y/N)",DIR(0)="Y" D ^DIR I $D(DTOUT)!(Y=0)!$D(DUOUT) Q
S X="PSIVACT" X ^%ZOSF("TEST") Q:'$T
S ZTDESC="Cancel IV Orders from Surgery",ZTDTH=$H,ZTIO="",ZTRTN="DCOR^SROXR1",ZTSAVE("PSIVRES")="SURGERY PACKAGE",ZTSAVE("DFN")=DFN N X,Y D ^%ZTLOAD
Q
DCOR ; entry for tasked job to cancel IVs
D DCOR^PSIVACT S ZTREQ="@"
Q
END K DFN,I,S,SRSC1,SRSDAT,SRSOR
Q
STAFF ; update STAFF/RESIDENT field
S STAFF="R" I $D(^XUSEC("SR STAFF SURGEON",X)) S STAFF="S"
S $P(^SRF(DA,.1),"^",3)=STAFF
Q
KSTAFF ; update STAFF/RESIDENT when deleted
S $P(^SRF(DA,.1),"^",3)=""
Q
ANES ; update ANESTHETIST CATEGORY field
N SRASITE,SRAML,SRACAT S SRASITE=$O(^SRO(133,0)) I SRASITE S SRAML=$P(^SRO(133,SRASITE,0),"^",4)
S SRACAT=$S($D(^XUSEC("SR ANESTHESIOLOGIST",X)):"A",$D(^XUSEC("SR SURGEON",X)):"A",$D(^XUSEC("SR NURSE ANESTHETIST",X)):"N",1:"O")
I SRACAT="A",SRAML'=$P($G(^VA(200,X,5)),"^",2) S SRACAT="O"
S $P(^SRF(DA,.3),"^",8)=SRACAT K SRASITE,SRAML,SRACAT
Q
KANES ; update ANESTHETIST CATEGORY when deleted
S $P(^SRF(DA,.3),"^",8)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROXR1 3161 printed Dec 13, 2024@02:46:45 Page 2
SROXR1 ;B'HAM ISC/MAM - CROSS REFERENCES (CONT) ;10/05/04
+1 ;;3.0; Surgery ;**34,72,79,100,134**;24 Jun 93
ATT ; ATT x-ref on surgeon to update attend surg
+1 NEW SRDIV,SREQ
SET SRDIV=$$SITE^SROUTL0(DA)
if 'SRDIV
QUIT
+2 IF $PIECE(^SRO(133,SRDIV,0),"^",19)'=0
QUIT
+3 SET SREQ(130,DA_",",.164)=X
DO FILE^DIE("","SREQ","^TMP(""SR"",$J)")
+4 QUIT
KATT ; kill logic for ATT x-ref
+1 QUIT
ATTP ; ATTP x-ref on provider to update attend provider
+1 NEW SRDIV,SREQ
SET SRDIV=$$SITE^SROUTL0(DA)
if 'SRDIV
QUIT
+2 IF $PIECE(^SRO(133,SRDIV,0),"^",19)'=0
QUIT
+3 SET SREQ(130,DA_",",124)=X
DO FILE^DIE("","SREQ","^TMP(""SR"",$J)")
+4 QUIT
KATTP ; kill logic for ATTP x-ref
+1 QUIT
AR ; 'AR' x-ref on the 'DATE OF OPERATION'
+1 ; field in the SURGERY file (130)
+2 if '$DATA(^SRF(DA,"REQ"))
QUIT
IF $PIECE(^SRF(DA,"REQ"),"^")'=1
QUIT
+3 IF $DATA(^SRF(DA,31))
IF $PIECE(^(31),"^",4)
QUIT
+4 if $EXTRACT(X,1,7)'<DT
SET DFN=$PIECE(^SRF(DA,0),"^")
SET ^SRF("AR",$EXTRACT(X,1,7),DFN,DA)=""
+5 QUIT
KAR ; 'KILL' logic of the 'AR' x-ref on the 'DATE OF
+1 ; OPERATION' field in the SURGERY file (130)
+2 SET DFN=$PIECE(^SRF(DA,0),"^")
KILL ^SRF("AR",$EXTRACT(X,1,7),DFN,DA)
+3 QUIT
SP ; set 'ASP' and 'AOR' x-refs when date is changed
+1 IF $PIECE(^SRF(DA,0),"^",4)
SET ^SRF("ASP",$PIECE(^(0),"^",4),$EXTRACT(X,1,7),DA)=DA
OR IF $PIECE(^SRF(DA,0),"^",2)
SET ^SRF("AOR",$PIECE(^(0),"^",2),$EXTRACT(X,1,7),DA)=""
+1 QUIT
KSP ; kill 'ASP' and 'AOR' x-refs when date is changed
+1 IF $PIECE(^SRF(DA,0),"^",4)
KILL ^SRF("ASP",$PIECE(^(0),"^",4),$EXTRACT(X,1,7),DA)
KOR SET DFN=$PIECE(^SRF(DA,0),"^")
IF $PIECE(^SRF(DA,0),"^",2)
KILL ^SRF("AOR",$PIECE(^(0),"^",2),$EXTRACT(X,1,7),DA)
+1 QUIT
IV ; delete IV orders
+1 SET SRT("X")=X
DO NOW^%DTC
SET X=SRT("X")
SET X1=$EXTRACT(%,1,12)
DO MINS^SRSUTL2
+2 IF X>1440
DO OUT
QUIT
+3 IF X>60
Begin DoDot:1
+4 DO EN^DDIOL("A considerable amount of time has passed since the "_$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":"procedure",1:"operation")_" start",,"!!,?2")
+5 DO EN^DDIOL("time and the present time.",,"!,?2")
End DoDot:1
+6 DO IV1
OUT SET X=SRT("X")
KILL SRT,X1,Y
+1 QUIT
IV1 KILL DIR
WRITE !
SET DIR("?",1)="Enter 'YES' to cancel current IV orders. Enter 'NO' or '^' to continue"
SET DIR("?")="without cancelling the patient's current IV orders."
SET DIR("B")=$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":"NO",1:"YES")
+1 SET DIR("A")="Do you want to cancel all current IV orders for this patient (Y/N)"
SET DIR(0)="Y"
DO ^DIR
IF $DATA(DTOUT)!(Y=0)!$DATA(DUOUT)
QUIT
+2 SET X="PSIVACT"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+3 SET ZTDESC="Cancel IV Orders from Surgery"
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTRTN="DCOR^SROXR1"
SET ZTSAVE("PSIVRES")="SURGERY PACKAGE"
SET ZTSAVE("DFN")=DFN
NEW X,Y
DO ^%ZTLOAD
+4 QUIT
DCOR ; entry for tasked job to cancel IVs
+1 DO DCOR^PSIVACT
SET ZTREQ="@"
+2 QUIT
END KILL DFN,I,S,SRSC1,SRSDAT,SRSOR
+1 QUIT
STAFF ; update STAFF/RESIDENT field
+1 SET STAFF="R"
IF $DATA(^XUSEC("SR STAFF SURGEON",X))
SET STAFF="S"
+2 SET $PIECE(^SRF(DA,.1),"^",3)=STAFF
+3 QUIT
KSTAFF ; update STAFF/RESIDENT when deleted
+1 SET $PIECE(^SRF(DA,.1),"^",3)=""
+2 QUIT
ANES ; update ANESTHETIST CATEGORY field
+1 NEW SRASITE,SRAML,SRACAT
SET SRASITE=$ORDER(^SRO(133,0))
IF SRASITE
SET SRAML=$PIECE(^SRO(133,SRASITE,0),"^",4)
+2 SET SRACAT=$SELECT($DATA(^XUSEC("SR ANESTHESIOLOGIST",X)):"A",$DATA(^XUSEC("SR SURGEON",X)):"A",$DATA(^XUSEC("SR NURSE ANESTHETIST",X)):"N",1:"O")
+3 IF SRACAT="A"
IF SRAML'=$PIECE($GET(^VA(200,X,5)),"^",2)
SET SRACAT="O"
+4 SET $PIECE(^SRF(DA,.3),"^",8)=SRACAT
KILL SRASITE,SRAML,SRACAT
+5 QUIT
KANES ; update ANESTHETIST CATEGORY when deleted
+1 SET $PIECE(^SRF(DA,.3),"^",8)=""
+2 QUIT
