Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SRSCHUN1

SRSCHUN1.m

Go to the documentation of this file.
  1. SRSCHUN1 ;B'HAM ISC/MAM - MAKE UNREQUESTED OPERATION (optional fields); [ 04/26/97 3:15 PM ]
  1. ;;3.0;Surgery;**34,47,58,67,107,177,184**;24 Jun 93;Build 35
  1. ;
  1. ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
  1. ;
  1. ANES W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?14,"SCHEDULE UNREQUESTED OPERATION: ANESTHESIA PERSONNEL",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE
  1. K DA,DIE,DR S DIE=130,DA=SRTN,DR=".31T;.34T" D ^DIE K DA,DIE,DR Q:$D(DTOUT) G:$D(Y) SS
  1. PROC W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?14,"SCHEDULE UNREQUESTED OPERATION: PROCEDURE INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE
  1. S SROPER=$P(^SRF(SRTN,"OP"),"^") K SROPS,MM,MMM S:$L(SROPER)<55 SROPS(1)=SROPER I $L(SROPER)>54 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
  1. W !,"Principal Procedure: ",?26,SROPS(1) I $D(SROPS(2)) W !,?26,SROPS(2) I $D(SROPS(3)) W !,?26,SROPS(3)
  1. I $D(SREQ(27)) W !,"Principal Procedure Code (CPT): "_$P(SREQ(27),"^",2)
  1. K DR S DR="" I '$D(SREQ(27)) S DR="27T;"
  1. S DR=DR_".42T;60T",DR(2,130.16)=".01T;3T;1.5T",DA=SRTN,DIE=130 D ^DIE K DR,DA Q:$D(DTOUT) G:$D(Y) SS
  1. BLOOD W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"SCHEDULE UNREQUESTED OPERATION: BLOOD INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
  1. D ^SROBLOD Q:$D(SRT) G:$D(SRDUOUT) SS
  1. OTH S SRICDV=$$ICDSTR^SROICD(SRTN)
  1. W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"SCHEDULE UNREQUESTED OPERATION: OTHER INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
  1. ;JAS - 03/25/14 - PATCH 177 - Changes for ICD-10
  1. K DR I SRICDV["9" S DR="[SRSCHED-UNREQUESTED]"
  1. E S DR="[SRSCHED-UNREQUESTED-ICD10]"
  1. S DIE=130,DA=SRTN D ^DIE K DR S:$D(DTOUT) SRDUOUT=1 I $D(SRODR) D ^SROCON1
  1. ;End of 177
  1. Q:$D(SRDUOUT)
  1. ;
  1. SS S SRICDV=$$ICDSTR^SROICD(SRTN)
  1. D RT K DA,DR,DIC,DIE S DR=$S($$SPIN^SRTOVRF():"[SRSRES-SCHED1]",1:"[SRSRES-SCHED]"),DIE=130,DA=SRTN D EN2^SROVAR K Q3("VIEW") S SPD=$$CHKS^SRSCOR(SRTN) D ^SRCUSS
  1. I SPD'=$$CHKS^SRSCOR(SRTN) S ^TMP("CSLSUR1",$J)=""
  1. K DR S SRSOUT=1 D:$D(SRODR) ^SROCON1 D RISK^SROAUTL3,^SROPCE1
  1. S SROERR=SRTN K SRTX D ^SROERR0
  1. Q
  1. LOOP ; break procedure if greater than 54 charcaters
  1. S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<55 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
  1. Q
  1. RT ; start RT logging
  1. I $D(XRTL) S XRTN="SRSCHUN1" D T0^%ZOSV
  1. Q