SROAEX ;BIR/MAM - EXCLUSION CRITERIA ;03/22/07
;;3.0;Surgery;**38,47,63,88,142,153,160,200**;24 Jun 93;Build 9
N SRCSTAT S SRACLR=0,SRSOUT=0 D NCODE^SROAUTL
START D:SRACLR RET G:SRSOUT END S SRACLR=0 K SRA,SRAO S SRAO(4)=""
S SR(0)=^SRF(SRTN,0),Y=$P($G(^SRF(SRTN,"RA")),"^",7) D CRITERIA S SRAO(1)=NYUK_"^102"
S SRAO(2)=$P(SR(0),"^",10)_"^.035",X=$P(SRAO(2),"^") I X'="" S $P(SRAO(2),"^")=$S(X="EL":"ELECTIVE",X="EM":"EMERGENT",X="U":"URGENT",X="A":"ADD ON TODAY (NONEMERGENT)",X="S":"STANDBY",1:"")
S SHEMP=$P(SR(0),"^",4) S:SHEMP SHEMP=$P(^SRO(137.45,SHEMP,0),"^"),SRAO(3)=SHEMP_"^.04"
S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
D TECH^SROPRIN S:SRTECH="NOT ENTERED" SRTECH="" S SRAO(5)=SRTECH
D TSTAT^SRO1L1,HDR^SROAUTL
S SRAO(6)=$P(^SRF(SRTN,"OP"),"^",3)_"^2006"
W !,"1. Exclusion Criteria: ",?35,$P(SRAO(1),"^"),!,"2. Surgical Priority:",?35,$P(SRAO(2),"^"),!,"3. Surgical Specialty:",?35,$P(SRAO(3),"^")
N SRPROC,SRL S SRL=45 D CPTS^SROAUTL0 W !,"4. CPT Codes (view only):"
F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?35,SRPROC(I) W:I'=1 !,?35,SRPROC(I)
W !,"5. Principal Anesthesia Technique: "_$P(SRAO(5),"^"),!,"6. Robotic Assistance (Y/N): ",?35,$$GET1^DIQ(130,SRTN_",",2006,"E"),!! F LINE=1:1:80 W "-"
ASK W !!,"Select Excluded Case Information to Edit: " R X:DTIME I '$T!("^"[X) G END
S:X="a" X="A" I '$D(SRAO(X)),(X'?.N1":".N),(X'="A") D HELP G:SRSOUT END G START
I X="A" S X="1:6"
I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>6)!(Y>Z) D HELP G:SRSOUT END G START
D TSTAT^SRO1L1,HDR^SROAUTL
I X?.N1":".N D RANGE,AQ G START
I $D(SRAO(X)) S EMILY=X W !! D ONE,AQ G START
END D AQ W @IOF D ^SRSKILL
Q
HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper"
W !,"responses are listed below.",!!,"1. Enter 'A' to update all information."
W !!,"2. Enter a number (1-5) to update the information in that field. (For"
W !," example, enter '2' to update Surgical Priority)"
W !!,"3. Enter a range of numbers (1-5) separated by a ':' to enter a range of"
W !," information. (For example, enter '1:2' to update the Exclusion Criteria "
W !," and Surgical Priority)" D RET
Q
AQ ; update transmission status
K DA,DIK S DIK="^SRF(",DIK(1)=".232^AQ",DA=SRTN D EN1^DIK K DA,DIK
Q
RANGE ; range of numbers
W !! S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE I EMILY=4 D HDR^SROAUTL
Q
ONE ; edit one item
I EMILY=1 D REASON Q
I EMILY=4 D DISP^SROAUTL0 Q
I EMILY=5 D UPANES Q
K DR,DIE S DA=SRTN,DR=$P(SRAO(EMILY),"^",2)_"T",DIE=130 D ^DIE K DR I $D(Y) S SRSOUT=1
Q
RET Q:SRSOUT W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
CRITERIA ; expand set of codes for exclusion criteria
S C=$P(^DD(130,102,0),"^",2) D Y^DIQ S NYUK=Y
S SHEMP=$P(^SRF(SRTN,0),"^",10),MOE=$S(SHEMP="E":"ELECTIVE",SHEMP="M":"EMERGENCY",SHEMP="U":"URGENT",1:"")
Q
UPANES K DR,DIE,DA S DA=SRTN,DR=.37,DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE K DR
Q
REASON W ! K DIR S DIR(0)="130,102",DIR("A")="Reason for not Creating an Assessment",DIR("B")=$P(SRAO(1),"^") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I X="@" D DELETE^SRONASS S SRSOUT=1 Q
I Y'="" K DR,DIE,DA S DA=SRTN,DIE=130,DR="102////"_Y D ^DIE K DA,DIE,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAEX 3312 printed Oct 16, 2024@18:41:09 Page 2
SROAEX ;BIR/MAM - EXCLUSION CRITERIA ;03/22/07
+1 ;;3.0;Surgery;**38,47,63,88,142,153,160,200**;24 Jun 93;Build 9
+2 NEW SRCSTAT
SET SRACLR=0
SET SRSOUT=0
DO NCODE^SROAUTL
START if SRACLR
DO RET
if SRSOUT
GOTO END
SET SRACLR=0
KILL SRA,SRAO
SET SRAO(4)=""
+1 SET SR(0)=^SRF(SRTN,0)
SET Y=$PIECE($GET(^SRF(SRTN,"RA")),"^",7)
DO CRITERIA
SET SRAO(1)=NYUK_"^102"
+2 SET SRAO(2)=$PIECE(SR(0),"^",10)_"^.035"
SET X=$PIECE(SRAO(2),"^")
IF X'=""
SET $PIECE(SRAO(2),"^")=$SELECT(X="EL":"ELECTIVE",X="EM":"EMERGENT",X="U":"URGENT",X="A":"ADD ON TODAY (NONEMERGENT)",X="S":"STANDBY",1:"")
+3 SET SHEMP=$PIECE(SR(0),"^",4)
if SHEMP
SET SHEMP=$PIECE(^SRO(137.45,SHEMP,0),"^")
SET SRAO(3)=SHEMP_"^.04"
+4 SET SRCSTAT=">> Coding "_$SELECT($PIECE($GET(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
+5 DO TECH^SROPRIN
if SRTECH="NOT ENTERED"
SET SRTECH=""
SET SRAO(5)=SRTECH
+6 DO TSTAT^SRO1L1
DO HDR^SROAUTL
+7 SET SRAO(6)=$PIECE(^SRF(SRTN,"OP"),"^",3)_"^2006"
+8 WRITE !,"1. Exclusion Criteria: ",?35,$PIECE(SRAO(1),"^"),!,"2. Surgical Priority:",?35,$PIECE(SRAO(2),"^"),!,"3. Surgical Specialty:",?35,$PIECE(SRAO(3),"^")
+9 NEW SRPROC,SRL
SET SRL=45
DO CPTS^SROAUTL0
WRITE !,"4. CPT Codes (view only):"
+10 FOR I=1:1
if '$DATA(SRPROC(I))
QUIT
if I=1
WRITE ?35,SRPROC(I)
if I'=1
WRITE !,?35,SRPROC(I)
+11 WRITE !,"5. Principal Anesthesia Technique: "_$PIECE(SRAO(5),"^"),!,"6. Robotic Assistance (Y/N): ",?35,$$GET1^DIQ(130,SRTN_",",2006,"E"),!!
FOR LINE=1:1:80
WRITE "-"
ASK WRITE !!,"Select Excluded Case Information to Edit: "
READ X:DTIME
IF '$TEST!("^"[X)
GOTO END
+1 if X="a"
SET X="A"
IF '$DATA(SRAO(X))
IF (X'?.N1":".N)
IF (X'="A")
DO HELP
if SRSOUT
GOTO END
GOTO START
+2 IF X="A"
SET X="1:6"
+3 IF X?.N1":".N
SET Y=$EXTRACT(X)
SET Z=$PIECE(X,":",2)
IF Y<1!(Z>6)!(Y>Z)
DO HELP
if SRSOUT
GOTO END
GOTO START
+4 DO TSTAT^SRO1L1
DO HDR^SROAUTL
+5 IF X?.N1":".N
DO RANGE
DO AQ
GOTO START
+6 IF $DATA(SRAO(X))
SET EMILY=X
WRITE !!
DO ONE
DO AQ
GOTO START
END DO AQ
WRITE @IOF
DO ^SRSKILL
+1 QUIT
HELP WRITE @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper"
+1 WRITE !,"responses are listed below.",!!,"1. Enter 'A' to update all information."
+2 WRITE !!,"2. Enter a number (1-5) to update the information in that field. (For"
+3 WRITE !," example, enter '2' to update Surgical Priority)"
+4 WRITE !!,"3. Enter a range of numbers (1-5) separated by a ':' to enter a range of"
+5 WRITE !," information. (For example, enter '1:2' to update the Exclusion Criteria "
+6 WRITE !," and Surgical Priority)"
DO RET
+7 QUIT
AQ ; update transmission status
+1 KILL DA,DIK
SET DIK="^SRF("
SET DIK(1)=".232^AQ"
SET DA=SRTN
DO EN1^DIK
KILL DA,DIK
+2 QUIT
RANGE ; range of numbers
+1 WRITE !!
SET SHEMP=$PIECE(X,":")
SET CURLEY=$PIECE(X,":",2)
FOR EMILY=SHEMP:1:CURLEY
if SRSOUT
QUIT
DO ONE
IF EMILY=4
DO HDR^SROAUTL
+2 QUIT
ONE ; edit one item
+1 IF EMILY=1
DO REASON
QUIT
+2 IF EMILY=4
DO DISP^SROAUTL0
QUIT
+3 IF EMILY=5
DO UPANES
QUIT
+4 KILL DR,DIE
SET DA=SRTN
SET DR=$PIECE(SRAO(EMILY),"^",2)_"T"
SET DIE=130
DO ^DIE
KILL DR
IF $DATA(Y)
SET SRSOUT=1
+5 QUIT
RET if SRSOUT
QUIT
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+1 QUIT
CRITERIA ; expand set of codes for exclusion criteria
+1 SET C=$PIECE(^DD(130,102,0),"^",2)
DO Y^DIQ
SET NYUK=Y
+2 SET SHEMP=$PIECE(^SRF(SRTN,0),"^",10)
SET MOE=$SELECT(SHEMP="E":"ELECTIVE",SHEMP="M":"EMERGENCY",SHEMP="U":"URGENT",1:"")
+3 QUIT
UPANES KILL DR,DIE,DA
SET DA=SRTN
SET DR=.37
SET DR(2,130.06)=".01T;.05T;42T"
SET DIE=130
DO ^DIE
KILL DR
+1 QUIT
REASON WRITE !
KILL DIR
SET DIR(0)="130,102"
SET DIR("A")="Reason for not Creating an Assessment"
SET DIR("B")=$PIECE(SRAO(1),"^")
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+1 IF X="@"
DO DELETE^SRONASS
SET SRSOUT=1
QUIT
+2 IF Y'=""
KILL DR,DIE,DA
SET DA=SRTN
SET DIE=130
SET DR="102////"_Y
DO ^DIE
KILL DA,DIE,DR
+3 QUIT
