- 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 Feb 19, 2025@00:06:59 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
