- SRSRQST1 ;B'HAM ISC/MAM,ADM - MAKE REQUEST (optional fields); [ 04/26/97 3:23 PM ]
- ;;3.0;Surgery;**12,34,37,47,58,67,107,177,184**;24 Jun 93;Build 35
- ;
- ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
- ;
- D:SRWL REF W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"OPERATION REQUEST: PROCEDURE INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE
- 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=""
- W !,"Principal Procedure: ",?26,SROPS(1) I $D(SROPS(2)) W !,?26,SROPS(2) I $D(SROPS(3)) W !,?26,SROPS(3)
- I $D(SREQ(27)) W !,"Principal Procedure Code (CPT): "_$P(SREQ(27),"^",2)
- S SRSPEC=$P(^SRF(SRTN,0),"^",4),SRAVG=""
- K DR S DR="" I '$D(SREQ(27)) S DR="27T;"
- S DR=DR_".42T;S SRSCPT=$P(^SRF(SRTN,""OP""),""^"",2) D ^SRSAVG;37T//^S X=SRAVG;60T",DR(2,130.16)=".01T;3T;1.5T",DA=SRTN,DIE=130 D ^DIE K DR,DA G:$D(DTOUT) REQ G:$D(Y) SS
- BLOOD W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"OPERATION REQUEST: BLOOD INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
- D ^SROBLOD G:$D(SRT) REQ G:$D(SRDUOUT) SS
- OTH S SRICDV=$$ICDSTR^SROICD(SRTN) W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"OPERATION REQUEST: OTHER INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
- ;JAS - 03/26/14 - PATCH 177 - Changes for ICD-10
- K DR I SRICDV["9" S DR="[SREQUEST]"
- E S DR="[SREQUEST-ICD10]"
- S DIE=130,DA=SRTN D ^DIE K DR S:$D(DTOUT) SRDUOUT=1 I $D(SRODR) D ^SROCON1
- ;End OF 177
- I $D(SRDUOUT) G REQ
- SS S SRICDV=$$ICDSTR^SROICD(SRTN) D RT K DA,DR,DIC,DIE
- S DR=$S($$SPIN^SRTOVRF():"[SRSRES-ENTRY1]",1:"[SRSRES-ENTRY]"),DIE=130,DA=SRTN D EN2^SROVAR K Q3("VIEW")
- S SPD=$$CHKS^SRSCOR(SRTN) D ^SRCUSS
- I SPD'=$$CHKS^SRSCOR(SRTN) S ^TMP("CSLSUR1",$J)=""
- K DR D:$D(SRODR) ^SROCON1 D RISK^SROAUTL3,REQ^SROPCE1 D:'$D(SRCC) REQ
- S SROERR=SRTN K SRTX D ^SROERR0
- Q
- LOOP ; break procedure if greater than 54 charcaters
- 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
- Q
- RT ; start RT logging
- I $D(XRTL) S XRTN="SRSRQST1" D T0^%ZOSV
- Q
- REF S REFER="",SREFER=$O(^SRO(133.8,"B",SRSER,0)) I $O(^SRO(133.8,SREFER,1,$P(SRW(SRW),"^",2),1,0)) S REFER=^SRO(133.8,SREFER,1,$P(SRW(SRW),"^",2),1,1,0)
- I REFER'="" S ^SRF(SRTN,18,0)="^130.03A^1^1",^SRF(SRTN,18,1,0)=REFER,^SRF(SRTN,18,"B",$P(REFER,"^"),1)=""
- DIK K DA,DIK S DA(1)=SREFER,DA=$P(SRW(SRW),"^",2),DIK="^SRO(133.8,"_DA(1)_",1," D ^DIK
- Q
- REQ ; print request message
- W !!,"A request has been made for "_SRNM_" on "_$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)_".",!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSRQST1 2773 printed Feb 19, 2025@00:14:14 Page 2
- SRSRQST1 ;B'HAM ISC/MAM,ADM - MAKE REQUEST (optional fields); [ 04/26/97 3:23 PM ]
- +1 ;;3.0;Surgery;**12,34,37,47,58,67,107,177,184**;24 Jun 93;Build 35
- +2 ;
- +3 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
- +4 ;
- +5 if SRWL
- DO REF
- WRITE @IOF
- if $DATA(SRCC)
- WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
- WRITE !,?20,"OPERATION REQUEST: PROCEDURE INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE
- +6 SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
- KILL SROPS,MM,MMM
- if $LENGTH(SROPER)<55
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>54
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +7 WRITE !,"Principal Procedure: ",?26,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?26,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?26,SROPS(3)
- +8 IF $DATA(SREQ(27))
- WRITE !,"Principal Procedure Code (CPT): "_$PIECE(SREQ(27),"^",2)
- +9 SET SRSPEC=$PIECE(^SRF(SRTN,0),"^",4)
- SET SRAVG=""
- +10 KILL DR
- SET DR=""
- IF '$DATA(SREQ(27))
- SET DR="27T;"
- +11 SET DR=DR_".42T;S SRSCPT=$P(^SRF(SRTN,""OP""),""^"",2) D ^SRSAVG;37T//^S X=SRAVG;60T"
- SET DR(2,130.16)=".01T;3T;1.5T"
- SET DA=SRTN
- SET DIE=130
- DO ^DIE
- KILL DR,DA
- if $DATA(DTOUT)
- GOTO REQ
- if $DATA(Y)
- GOTO SS
- BLOOD WRITE @IOF
- if $DATA(SRCC)
- WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
- WRITE !,?20,"OPERATION REQUEST: BLOOD INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
- +1 DO ^SROBLOD
- if $DATA(SRT)
- GOTO REQ
- if $DATA(SRDUOUT)
- GOTO SS
- OTH SET SRICDV=$$ICDSTR^SROICD(SRTN)
- WRITE @IOF
- if $DATA(SRCC)
- WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
- WRITE !,?20,"OPERATION REQUEST: OTHER INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
- +1 ;JAS - 03/26/14 - PATCH 177 - Changes for ICD-10
- +2 KILL DR
- IF SRICDV["9"
- SET DR="[SREQUEST]"
- +3 IF '$TEST
- SET DR="[SREQUEST-ICD10]"
- +4 SET DIE=130
- SET DA=SRTN
- DO ^DIE
- KILL DR
- if $DATA(DTOUT)
- SET SRDUOUT=1
- IF $DATA(SRODR)
- DO ^SROCON1
- +5 ;End OF 177
- +6 IF $DATA(SRDUOUT)
- GOTO REQ
- SS SET SRICDV=$$ICDSTR^SROICD(SRTN)
- DO RT
- KILL DA,DR,DIC,DIE
- +1 SET DR=$SELECT($$SPIN^SRTOVRF():"[SRSRES-ENTRY1]",1:"[SRSRES-ENTRY]")
- SET DIE=130
- SET DA=SRTN
- DO EN2^SROVAR
- KILL Q3("VIEW")
- +2 SET SPD=$$CHKS^SRSCOR(SRTN)
- DO ^SRCUSS
- +3 IF SPD'=$$CHKS^SRSCOR(SRTN)
- SET ^TMP("CSLSUR1",$JOB)=""
- +4 KILL DR
- if $DATA(SRODR)
- DO ^SROCON1
- DO RISK^SROAUTL3
- DO REQ^SROPCE1
- if '$DATA(SRCC)
- DO REQ
- +5 SET SROERR=SRTN
- KILL SRTX
- DO ^SROERR0
- +6 QUIT
- LOOP ; break procedure if greater than 54 charcaters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROPS(M))+$LENGTH(MM)'<55
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- RT ; start RT logging
- +1 IF $DATA(XRTL)
- SET XRTN="SRSRQST1"
- DO T0^%ZOSV
- +2 QUIT
- REF SET REFER=""
- SET SREFER=$ORDER(^SRO(133.8,"B",SRSER,0))
- IF $ORDER(^SRO(133.8,SREFER,1,$PIECE(SRW(SRW),"^",2),1,0))
- SET REFER=^SRO(133.8,SREFER,1,$PIECE(SRW(SRW),"^",2),1,1,0)
- +1 IF REFER'=""
- SET ^SRF(SRTN,18,0)="^130.03A^1^1"
- SET ^SRF(SRTN,18,1,0)=REFER
- SET ^SRF(SRTN,18,"B",$PIECE(REFER,"^"),1)=""
- DIK KILL DA,DIK
- SET DA(1)=SREFER
- SET DA=$PIECE(SRW(SRW),"^",2)
- SET DIK="^SRO(133.8,"_DA(1)_",1,"
- DO ^DIK
- +1 QUIT
- REQ ; print request message
- +1 WRITE !!,"A request has been made for "_SRNM_" on "_$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)_".",!
- +2 QUIT