SROCD2 ;BIR/ADM - DISPLAY MAIN SCREEN FOR CASE CODING ;07/27/05
;;3.0; Surgery ;**142**;24 Jun 93
; display information from file 136
EN N SCEC,SRCHFNO,SRFIRST,SRFLG,SRCMOD,SRSHRT,SRNON
DSPLY S (SREDIT,SRSOUT,SRNON,SRCHFNO)=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
S SRDATE=$P($G(^SRF(SRTN,0)),"^",9),SR(0)=$G(^SRO(136,SRTN,0))
D HDR^SROCD W !,$S('SRNON:"Surgery Procedure",1:"Non-OR Procedure")_" PCE/Billing Information:",!
S SRDIAG="NOT ENTERED",SRDX=$P(SR(0),"^",3) I SRDX S SRDIAG=$$ICDDX^ICDCODE(SRDX,SRDATE),SRDIAG=$P(SRDIAG,"^",2)_" "_$P(SRDIAG,"^",4)
W !,"1. Principal Postop Diagnosis Code:",?36,SRDIAG
W !,"2. Other Postop Diagnosis Code:" I '$O(^SRO(136,SRTN,4,0)) W ?36,"NOT ENTERED"
S (SRFLG,SRD)=0 F S SRD=$O(^SRO(136,SRTN,4,SRD)) Q:'SRD D
.S SRDIAG="",SRDX=$P($G(^SRO(136,SRTN,4,SRD,0)),"^") I SRDX S SRDIAG=$$ICDDX^ICDCODE(SRDX,SRDATE),SRDIAG=$P(SRDIAG,"^",2)_" "_$P(SRDIAG,"^",4)
.W:SRFLG ! W ?36,SRDIAG S SRFLG=1
S CPT=$P(SR(0),"^",2),SRCPT="NOT ENTERED",(SRSHRT,SRX)="",SRFLG=0
I CPT S Y=$$CPT^ICPTCOD(CPT,SRDATE),SRCPT=$P(Y,"^",2),SRSHRT=$P(Y,"^",3)
S SRMSG="NO Assoc. DX ENTERED"
I CPT,$O(^SRO(136,SRTN,1,0)) D
.S (SRCOMMA,SRI)=0,SRCMOD="",SRX="-" F S SRI=$O(^SRO(136,SRTN,1,SRI)) Q:'SRI D
..S SRM=$P(^SRO(136,SRTN,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2) K SRM
..S SRX=SRX_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
W !,"3. Principal CPT Code: ",SRCPT_SRX_" "_SRSHRT
D PADXD^SROCDX1
W !,"4. Other CPT Code: " I '$O(^SRO(136,SRTN,3,0)) W ?23,"NOT ENTERED"
S SRX=0,SRFIRST=1 F S SRX=$O(^SRO(136,SRTN,3,SRX)) Q:'SRX D
.S (SRSHRT,SRY)="",CPT=$P($G(^SRO(136,SRTN,3,SRX,0)),"^")
.I CPT S Y=$$CPT^ICPTCOD(CPT,SRDATE),SRCPT=$P(Y,"^",2),SRSHRT=$P(Y,"^",3)
.I CPT,$O(^SRO(136,SRTN,3,SRX,1,0)) D
..S (SRCOMMA,SRFLG,SRI)=0,SRCMOD="",SRY="-" F S SRI=$O(^SRO(136,SRTN,3,SRX,1,SRI)) Q:'SRI D
...S SRM=$P(^SRO(136,SRTN,3,SRX,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2) K SRM
...S SRY=SRY_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
.W:'SRFIRST !,?3,"Other CPT Code: " W SRCPT_SRY_" "_SRSHRT S SRFIRST=0
.W !,?5,"Assoc. DX: " I '$O(^SRO(136,SRTN,3,SRX,2,0)) W " NOT ENTERED"
.I CPT S (SRCNT,SRD,SRFLG)=0 F S SRD=$O(^SRO(136,SRTN,3,SRX,2,SRD)) Q:'SRD D
..S SRDIAG="",SRDX=$P($G(^SRO(136,SRTN,3,SRX,2,SRD,0)),"^"),SRCNT=SRCNT+1
..I SRDX S SRDIAG=$$ICDDX^ICDCODE(SRDX,SRDATE),SRDIAG=$P(SRDIAG,"^",2)_"-"_$P(SRDIAG,"^",4)
..I SRCNT#2 W:$G(SRFLG) ! W ?16,$E(SRDIAG,1,28) S SRFLG=1
..I '(SRCNT#2) W ?48,$E(SRDIAG,1,28)
W ! F LINE=1:1:80 W "-"
I $P(^SRO(136,SRTN,0),"^",3)=""!($P(^SRO(136,SRTN,0),"^",2)="") D REQ Q:SRSOUT G DSPLY
S SRAO(1)=.03,SRAO(2)="",SRAO(3)=".02",SRAO(4)=""
ASK K DIR S DIR("A")="Enter number of item to edit (1-4): ",DIR(0)="FOA",DIR("?",1)="Enter the number corresponding to the information you want to update. You may"
S DIR("?",2)="enter 'ALL' to update all the information displayed on this screen, or a",DIR("?")="range of numbers separated by a ':' to update more than one item." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I X="" D ^SROCD4 Q
S:$E(X)="a" X="A" I '$D(SRAO(X)),(X'?.N1":".N),($E(X)'="A") D HELP Q:SRSOUT G ASK
I $E(X)="A" S X="1:4"
I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>4)!(Y>Z) D HELP Q:SRSOUT G ASK
I X?.N1":".N D RANGE Q
S EMILY=X D ONE Q
Q
HELP W !!,"Enter the number corresponding to the information you want to update. You may",!,"enter 'ALL' to update all the information displayed on this screen, or a"
W !,"range of numbers separated by a ':' to update more than one item.",!
Q
RANGE ; range of numbers
N CURLEY,EMILY,SHEMP
S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE
Q
ONE ; edit one item
D HDR^SROCD
I EMILY=4 D POTH^SROCD0 Q
I EMILY=2 D DOTH^SROCD0 Q
I EMILY=1 D PRDX^SROCD0 Q
I EMILY=3 D PCPT^SROCDX
Q
REQ W !,"The following information is required before continuing.",!
PDX I $P(^SRO(136,SRTN,0),"^",3)="" D Q:SRSOUT
.K DA,DIE,DR S DA=SRTN,DIE=136,DR=".03T" D ^DIE I $D(Y) S SRSOUT=1 Q
.S Y=$P(^SRO(136,SRTN,0),"^",3) I Y S SCEC=$$SCEC^SROCD0() I SCEC D SCEI^SROCD3 K SRCL
I $P(^SRO(136,SRTN,0),"^",3)="" W !,"This is a required response. Enter '^' to exit" G PDX
I $D(SCEC) K SCEC Q
PCPT I $P(^SRO(136,SRTN,0),"^",2)="" K DA,DIE,DR S DA=SRTN,DIE=136,DR=".02T" D ^DIE I $D(Y) S SRSOUT=1 Q
I $P(^SRO(136,SRTN,0),"^",2)="" W !,"This is a required response. Enter '^' to exit" G PCPT
D PRIN^SROMOD0 K DA,DIE,DR
Q
SROCD2 ;BIR/ADM - DISPLAY MAIN SCREEN FOR CASE CODING ;07/27/05
+1 ;;3.0; Surgery ;**142**;24 Jun 93
+2 ; display information from file 136
EN NEW SCEC,SRCHFNO,SRFIRST,SRFLG,SRCMOD,SRSHRT,SRNON
DSPLY SET (SREDIT,SRSOUT,SRNON,SRCHFNO)=0
IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
SET SRNON=1
+1 SET SRDATE=$PIECE($GET(^SRF(SRTN,0)),"^",9)
SET SR(0)=$GET(^SRO(136,SRTN,0))
+2 DO HDR^SROCD
WRITE !,$SELECT('SRNON:"Surgery Procedure",1:"Non-OR Procedure")_" PCE/Billing Information:",!
+3 SET SRDIAG="NOT ENTERED"
SET SRDX=$PIECE(SR(0),"^",3)
IF SRDX
SET SRDIAG=$$ICDDX^ICDCODE(SRDX,SRDATE)
SET SRDIAG=$PIECE(SRDIAG,"^",2)_" "_$PIECE(SRDIAG,"^",4)
+4 WRITE !,"1. Principal Postop Diagnosis Code:",?36,SRDIAG
+5 WRITE !,"2. Other Postop Diagnosis Code:"
IF '$ORDER(^SRO(136,SRTN,4,0))
WRITE ?36,"NOT ENTERED"
+6 SET (SRFLG,SRD)=0
FOR
SET SRD=$ORDER(^SRO(136,SRTN,4,SRD))
IF 'SRD
QUIT
Begin DoDot:1
+7 SET SRDIAG=""
SET SRDX=$PIECE($GET(^SRO(136,SRTN,4,SRD,0)),"^")
IF SRDX
SET SRDIAG=$$ICDDX^ICDCODE(SRDX,SRDATE)
SET SRDIAG=$PIECE(SRDIAG,"^",2)_" "_$PIECE(SRDIAG,"^",4)
+8 IF SRFLG
WRITE !
WRITE ?36,SRDIAG
SET SRFLG=1
End DoDot:1
+9 SET CPT=$PIECE(SR(0),"^",2)
SET SRCPT="NOT ENTERED"
SET (SRSHRT,SRX)=""
SET SRFLG=0
+10 IF CPT
SET Y=$$CPT^ICPTCOD(CPT,SRDATE)
SET SRCPT=$PIECE(Y,"^",2)
SET SRSHRT=$PIECE(Y,"^",3)
+11 SET SRMSG="NO Assoc. DX ENTERED"
+12 IF CPT
IF $ORDER(^SRO(136,SRTN,1,0))
Begin DoDot:1
+13 SET (SRCOMMA,SRI)=0
SET SRCMOD=""
SET SRX="-"
FOR
SET SRI=$ORDER(^SRO(136,SRTN,1,SRI))
IF 'SRI
QUIT
Begin DoDot:2
+14 SET SRM=$PIECE(^SRO(136,SRTN,1,SRI,0),"^")
SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
KILL SRM
+15 SET SRX=SRX_$SELECT(SRCOMMA:",",1:"")_SRCMOD
SET SRCOMMA=1
End DoDot:2
End DoDot:1
+16 WRITE !,"3. Principal CPT Code: ",SRCPT_SRX_" "_SRSHRT
+17 DO PADXD^SROCDX1
+18 WRITE !,"4. Other CPT Code: "
IF '$ORDER(^SRO(136,SRTN,3,0))
WRITE ?23,"NOT ENTERED"
+19 SET SRX=0
SET SRFIRST=1
FOR
SET SRX=$ORDER(^SRO(136,SRTN,3,SRX))
IF 'SRX
QUIT
Begin DoDot:1
+20 SET (SRSHRT,SRY)=""
SET CPT=$PIECE($GET(^SRO(136,SRTN,3,SRX,0)),"^")
+21 IF CPT
SET Y=$$CPT^ICPTCOD(CPT,SRDATE)
SET SRCPT=$PIECE(Y,"^",2)
SET SRSHRT=$PIECE(Y,"^",3)
+22 IF CPT
IF $ORDER(^SRO(136,SRTN,3,SRX,1,0))
Begin DoDot:2
+23 SET (SRCOMMA,SRFLG,SRI)=0
SET SRCMOD=""
SET SRY="-"
FOR
SET SRI=$ORDER(^SRO(136,SRTN,3,SRX,1,SRI))
IF 'SRI
QUIT
Begin DoDot:3
+24 SET SRM=$PIECE(^SRO(136,SRTN,3,SRX,1,SRI,0),"^")
SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
KILL SRM
+25 SET SRY=SRY_$SELECT(SRCOMMA:",",1:"")_SRCMOD
SET SRCOMMA=1
End DoDot:3
End DoDot:2
+26 IF 'SRFIRST
WRITE !,?3,"Other CPT Code: "
WRITE SRCPT_SRY_" "_SRSHRT
SET SRFIRST=0
+27 WRITE !,?5,"Assoc. DX: "
IF '$ORDER(^SRO(136,SRTN,3,SRX,2,0))
WRITE " NOT ENTERED"
+28 IF CPT
SET (SRCNT,SRD,SRFLG)=0
FOR
SET SRD=$ORDER(^SRO(136,SRTN,3,SRX,2,SRD))
IF 'SRD
QUIT
Begin DoDot:2
+29 SET SRDIAG=""
SET SRDX=$PIECE($GET(^SRO(136,SRTN,3,SRX,2,SRD,0)),"^")
SET SRCNT=SRCNT+1
+30 IF SRDX
SET SRDIAG=$$ICDDX^ICDCODE(SRDX,SRDATE)
SET SRDIAG=$PIECE(SRDIAG,"^",2)_"-"_$PIECE(SRDIAG,"^",4)
+31 IF SRCNT#2
IF $GET(SRFLG)
WRITE !
WRITE ?16,$EXTRACT(SRDIAG,1,28)
SET SRFLG=1
+32 IF '(SRCNT#2)
WRITE ?48,$EXTRACT(SRDIAG,1,28)
End DoDot:2
End DoDot:1
+33 WRITE !
FOR LINE=1:1:80
WRITE "-"
+34 IF $PIECE(^SRO(136,SRTN,0),"^",3)=""!($PIECE(^SRO(136,SRTN,0),"^",2)="")
DO REQ
IF SRSOUT
QUIT
GOTO DSPLY
+35 SET SRAO(1)=.03
SET SRAO(2)=""
SET SRAO(3)=".02"
SET SRAO(4)=""
ASK KILL DIR
SET DIR("A")="Enter number of item to edit (1-4): "
SET DIR(0)="FOA"
SET DIR("?",1)="Enter the number corresponding to the information you want to update. You may"
+1 SET DIR("?",2)="enter 'ALL' to update all the information displayed on this screen, or a"
SET DIR("?")="range of numbers separated by a ':' to update more than one item."
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+2 IF X=""
DO ^SROCD4
QUIT
+3 IF $EXTRACT(X)="a"
SET X="A"
IF '$DATA(SRAO(X))
IF (X'?.N1":".N)
IF ($EXTRACT(X)'="A")
DO HELP
IF SRSOUT
QUIT
GOTO ASK
+4 IF $EXTRACT(X)="A"
SET X="1:4"
+5 IF X?.N1":".N
SET Y=$EXTRACT(X)
SET Z=$PIECE(X,":",2)
IF Y<1!(Z>4)!(Y>Z)
DO HELP
IF SRSOUT
QUIT
GOTO ASK
+6 IF X?.N1":".N
DO RANGE
QUIT
+7 SET EMILY=X
DO ONE
QUIT
+8 QUIT
HELP WRITE !!,"Enter the number corresponding to the information you want to update. You may",!,"enter 'ALL' to update all the information displayed on this screen, or a"
+1 WRITE !,"range of numbers separated by a ':' to update more than one item.",!
+2 QUIT
RANGE ; range of numbers
+1 NEW CURLEY,EMILY,SHEMP
+2 SET SHEMP=$PIECE(X,":")
SET CURLEY=$PIECE(X,":",2)
FOR EMILY=SHEMP:1:CURLEY
IF SRSOUT
QUIT
DO ONE
+3 QUIT
ONE ; edit one item
+1 DO HDR^SROCD
+2 IF EMILY=4
DO POTH^SROCD0
QUIT
+3 IF EMILY=2
DO DOTH^SROCD0
QUIT
+4 IF EMILY=1
DO PRDX^SROCD0
QUIT
+5 IF EMILY=3
DO PCPT^SROCDX
+6 QUIT
REQ WRITE !,"The following information is required before continuing.",!
PDX IF $PIECE(^SRO(136,SRTN,0),"^",3)=""
Begin DoDot:1
+1 KILL DA,DIE,DR
SET DA=SRTN
SET DIE=136
SET DR=".03T"
DO ^DIE
IF $DATA(Y)
SET SRSOUT=1
QUIT
+2 SET Y=$PIECE(^SRO(136,SRTN,0),"^",3)
IF Y
SET SCEC=$$SCEC^SROCD0()
IF SCEC
DO SCEI^SROCD3
KILL SRCL
End DoDot:1
IF SRSOUT
QUIT
+3 IF $PIECE(^SRO(136,SRTN,0),"^",3)=""
WRITE !,"This is a required response. Enter '^' to exit"
GOTO PDX
+4 IF $DATA(SCEC)
KILL SCEC
QUIT
PCPT IF $PIECE(^SRO(136,SRTN,0),"^",2)=""
KILL DA,DIE,DR
SET DA=SRTN
SET DIE=136
SET DR=".02T"
DO ^DIE
IF $DATA(Y)
SET SRSOUT=1
QUIT
+1 IF $PIECE(^SRO(136,SRTN,0),"^",2)=""
WRITE !,"This is a required response. Enter '^' to exit"
GOTO PCPT
+2 DO PRIN^SROMOD0
KILL DA,DIE,DR
+3 QUIT
