- SRO1L1 ;BIR/ADM - UPDATE 1-LINER CASE, CONTINUED ;02/14/07
- ;;3.0;Surgery;**86,88,100,129,142,153,160,182,200**;24 Jun 93;Build 9
- S SRSOUT=0,SRSUPCPT=2 D NCODE^SROAUTL
- N SRLCK,SRCSTAT S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK Q
- D SRA^SROES
- EDIT S SRA=$G(^SRF(SRTN,"RA")) I $P(SRA,"^",2)="N",$P(SRA,"^",6)="N",$P(SRA,"^",7)'="" D ^SROAEX,END Q
- S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
- S SRR=0 D TSTAT,HDR^SROAUTL D TECH^SROPRIN
- S X=$P(^SRF(SRTN,"OP"),"^",2) I X S Y=$P($$CPT^ICPTCOD(X),"^",2) D SSPRIN^SROCPT S SRCPT=Y
- S SRQ=0,SRDR=".011;.04;.035;.166;1.09;1.13;2006"
- S SRAO(1)="Hospital Admission Status^.011",SRAO(2)="Major or Minor^.03",SRAO(2)="Surgical Specialty^.04",SRAO(3)="Surgical Priority^.035",SRAO(4)="Attending/Res Sup Code^.166"
- S SRAO(5)="ASA Class^1.13",SRAO(6)="Wound Classification^1.09",SRAO(7)="Anesthesia Technique^.37",SRAO(8)="CPT Codes (view only)^",SRAO(9)="Other Procedures^.42"
- S SRAO(10)="Robotic Assistance (Y/N)^2006"
- K DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="E",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR
- S SRY(130,SRTN,.37,"E")=SRTECH,SRY(130,SRTN,.42,"E")=$S($O(^SRF(SRTN,13,0)):"***INFORMATION ENTERED***",1:"***NONE ENTERED***"),SRY(130,SRTN,27,"E")=SRCPT
- F I=1:1:10 W !,$J(I,2)_". "_$P(SRAO(I),"^")_":" D
- .I I=8 D PROC Q
- .S SREXT(1)=SRY(130,SRTN,$P(SRAO(I),"^",2),"E") I $L(SREXT(1))>48 D
- ..N I,J,X,Y S X=SREXT(1) F I=0:1:47 S J=48-I,Y=$E(X,J) I Y=" " S SREXT(1)=$E(X,1,J-1),SREXT(2)=$E(X,J+1,$L(X)) Q
- .W ?32,SREXT(1) W:$D(SREXT(2)) !,?32,SREXT(2) K SREXT
- W !! F I=1:1:80 W "-"
- S SRX=10 D SEL
- K DA,DIK S DIK="^SRF(",DIK(1)=".232^AQ",DA=SRTN D EN1^DIK K DA,DIK
- G:SRR=1 EDIT
- END D EXIT^SROES D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
- Q
- PROC N I,SRPROC,SRL S SRL=48 D CPTS^SROAUTL0
- F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?32,SRPROC(I) W:I'=1 !,?32,SRPROC(I)
- Q
- SEL W !!,"Select number of item to edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
- Q:X="" S:X="a" X="A" I '$D(SRAO(X)),(X'?.N1":".N),(X'="A") D HELP S SRR=1 Q
- I X?1.2N1":"1.2N S Y=$P(X,":"),Z=$P(X,":",2) I Y<1!(Z>SRX)!(Y>Z) D HELP S SRR=1 Q
- I X="A" S X="1:"_SRX
- I X?1.2N1":"1.2N D RANGE S SRR=1 Q
- I $D(SRAO(X)) S EMILY=X W !! D ONE S SRR=1
- 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 items."
- W !!,"2. Enter a number (1-"_SRX_") to update an individual item. (For example,"
- W !," enter '1' to update "_$P(SRAO(1),"^")_")"
- W !!,"3. Enter a range of numbers (1-"_SRX_") separated by a ':' to enter a range"
- W !," of items. (For example, enter '1:4' to update items 1, 2, 3 and 4.)",!
- PRESS W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
- Q
- RANGE ; range of numbers
- S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE
- Q
- ONE ; edit one item
- I EMILY=7 D UPANES Q
- I EMILY=8 D DISP^SROAUTL0 Q
- I EMILY=9 D ^SROTHER 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
- UPANES K DR,DIE,DA S DA=SRTN,DR=.37,DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE K DR
- Q
- TSTAT ; transmission status
- N SR905 S SR905=$P($G(^SRF(SRTN,.4)),"^",2)
- S SRHDR(.5)="Transmission Status: "_$S(SR905="T":"TRANSMITTED",SR905="R":"QUEUED TO TRANSMIT",1:"NOT QUEUED")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRO1L1 3359 printed Feb 19, 2025@00:06:19 Page 2
- SRO1L1 ;BIR/ADM - UPDATE 1-LINER CASE, CONTINUED ;02/14/07
- +1 ;;3.0;Surgery;**86,88,100,129,142,153,160,182,200**;24 Jun 93;Build 9
- +2 SET SRSOUT=0
- SET SRSUPCPT=2
- DO NCODE^SROAUTL
- +3 NEW SRLCK,SRCSTAT
- SET SRLCK=$$LOCK^SROUTL(SRTN)
- IF 'SRLCK
- QUIT
- +4 DO SRA^SROES
- EDIT SET SRA=$GET(^SRF(SRTN,"RA"))
- IF $PIECE(SRA,"^",2)="N"
- IF $PIECE(SRA,"^",6)="N"
- IF $PIECE(SRA,"^",7)'=""
- DO ^SROAEX
- DO END
- QUIT
- +1 SET SRCSTAT=">> Coding "_$SELECT($PIECE($GET(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
- +2 SET SRR=0
- DO TSTAT
- DO HDR^SROAUTL
- DO TECH^SROPRIN
- +3 SET X=$PIECE(^SRF(SRTN,"OP"),"^",2)
- IF X
- SET Y=$PIECE($$CPT^ICPTCOD(X),"^",2)
- DO SSPRIN^SROCPT
- SET SRCPT=Y
- +4 SET SRQ=0
- SET SRDR=".011;.04;.035;.166;1.09;1.13;2006"
- +5 SET SRAO(1)="Hospital Admission Status^.011"
- SET SRAO(2)="Major or Minor^.03"
- SET SRAO(2)="Surgical Specialty^.04"
- SET SRAO(3)="Surgical Priority^.035"
- SET SRAO(4)="Attending/Res Sup Code^.166"
- +6 SET SRAO(5)="ASA Class^1.13"
- SET SRAO(6)="Wound Classification^1.09"
- SET SRAO(7)="Anesthesia Technique^.37"
- SET SRAO(8)="CPT Codes (view only)^"
- SET SRAO(9)="Other Procedures^.42"
- +7 SET SRAO(10)="Robotic Assistance (Y/N)^2006"
- +8 KILL DA,DIC,DIQ,DR,SRY
- SET DIC="^SRF("
- SET DA=SRTN
- SET DIQ="SRY"
- SET DIQ(0)="E"
- SET DR=SRDR
- DO EN^DIQ1
- KILL DA,DIC,DIQ,DR
- +9 SET SRY(130,SRTN,.37,"E")=SRTECH
- SET SRY(130,SRTN,.42,"E")=$SELECT($ORDER(^SRF(SRTN,13,0)):"***INFORMATION ENTERED***",1:"***NONE ENTERED***")
- SET SRY(130,SRTN,27,"E")=SRCPT
- +10 FOR I=1:1:10
- WRITE !,$JUSTIFY(I,2)_". "_$PIECE(SRAO(I),"^")_":"
- Begin DoDot:1
- +11 IF I=8
- DO PROC
- QUIT
- +12 SET SREXT(1)=SRY(130,SRTN,$PIECE(SRAO(I),"^",2),"E")
- IF $LENGTH(SREXT(1))>48
- Begin DoDot:2
- +13 NEW I,J,X,Y
- SET X=SREXT(1)
- FOR I=0:1:47
- SET J=48-I
- SET Y=$EXTRACT(X,J)
- IF Y=" "
- SET SREXT(1)=$EXTRACT(X,1,J-1)
- SET SREXT(2)=$EXTRACT(X,J+1,$LENGTH(X))
- QUIT
- End DoDot:2
- +14 WRITE ?32,SREXT(1)
- if $DATA(SREXT(2))
- WRITE !,?32,SREXT(2)
- KILL SREXT
- End DoDot:1
- +15 WRITE !!
- FOR I=1:1:80
- WRITE "-"
- +16 SET SRX=10
- DO SEL
- +17 KILL DA,DIK
- SET DIK="^SRF("
- SET DIK(1)=".232^AQ"
- SET DA=SRTN
- DO EN1^DIK
- KILL DA,DIK
- +18 if SRR=1
- GOTO EDIT
- END DO EXIT^SROES
- if $GET(SRLCK)
- DO UNLOCK^SROUTL(SRTN)
- +1 QUIT
- PROC NEW I,SRPROC,SRL
- SET SRL=48
- DO CPTS^SROAUTL0
- +1 FOR I=1:1
- if '$DATA(SRPROC(I))
- QUIT
- if I=1
- WRITE ?32,SRPROC(I)
- if I'=1
- WRITE !,?32,SRPROC(I)
- +2 QUIT
- SEL WRITE !!,"Select number of item to edit: "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET SRSOUT=1
- QUIT
- +1 if X=""
- QUIT
- if X="a"
- SET X="A"
- IF '$DATA(SRAO(X))
- IF (X'?.N1":".N)
- IF (X'="A")
- DO HELP
- SET SRR=1
- QUIT
- +2 IF X?1.2N1":"1.2N
- SET Y=$PIECE(X,":")
- SET Z=$PIECE(X,":",2)
- IF Y<1!(Z>SRX)!(Y>Z)
- DO HELP
- SET SRR=1
- QUIT
- +3 IF X="A"
- SET X="1:"_SRX
- +4 IF X?1.2N1":"1.2N
- DO RANGE
- SET SRR=1
- QUIT
- +5 IF $DATA(SRAO(X))
- SET EMILY=X
- WRITE !!
- DO ONE
- SET SRR=1
- +6 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 items."
- +2 WRITE !!,"2. Enter a number (1-"_SRX_") to update an individual item. (For example,"
- +3 WRITE !," enter '1' to update "_$PIECE(SRAO(1),"^")_")"
- +4 WRITE !!,"3. Enter a range of numbers (1-"_SRX_") separated by a ':' to enter a range"
- +5 WRITE !," of items. (For example, enter '1:4' to update items 1, 2, 3 and 4.)",!
- PRESS WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- +1 QUIT
- RANGE ; range of numbers
- +1 SET SHEMP=$PIECE(X,":")
- SET CURLEY=$PIECE(X,":",2)
- FOR EMILY=SHEMP:1:CURLEY
- if SRSOUT
- QUIT
- DO ONE
- +2 QUIT
- ONE ; edit one item
- +1 IF EMILY=7
- DO UPANES
- QUIT
- +2 IF EMILY=8
- DO DISP^SROAUTL0
- QUIT
- +3 IF EMILY=9
- DO ^SROTHER
- 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
- 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
- TSTAT ; transmission status
- +1 NEW SR905
- SET SR905=$PIECE($GET(^SRF(SRTN,.4)),"^",2)
- +2 SET SRHDR(.5)="Transmission Status: "_$SELECT(SR905="T":"TRANSMITTED",SR905="R":"QUEUED TO TRANSMIT",1:"NOT QUEUED")
- +3 QUIT
