- SROCD2 ;BIR/ADM - DISPLAY MAIN SCREEN FOR CASE CODING ;07/27/05
- ;;3.0;Surgery;**142,177**;24 Jun 93;Build 89
- ; 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 SRSYS=$$ICDSTR^SROICD(SRTN)
- S SRDIAG="NOT ENTERED",SRDX=$P(SR(0),"^",3) I SRDX S SRDIAG=$$ICD^SROICD(SRTN,SRDX),SRDIAG=$P(SRDIAG,"^",2)_" "_$P(SRDIAG,"^",4)
- W !,"1. Principal Postop Diagnosis Code "_SRSYS_": ",SRDIAG
- W !,"2. Other Postop Diagnosis Code "_SRSYS_": " I '$O(^SRO(136,SRTN,4,0)) W "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=$$ICD^SROICD(SRTN,SRDX),SRDIAG=$P(SRDIAG,"^",2)_" "_$P(SRDIAG,"^",4)
- .W:SRFLG ! W 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 "_$$ICDSTR^SROICD(SRTN)_": " 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=$$ICD^SROICD(SRTN,SRDX),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=".03Principal Postop Diagnosis Code "_$$ICDSTR^SROICD(SRTN) 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCD2 4601 printed Feb 19, 2025@00:09:06 Page 2
- SROCD2 ;BIR/ADM - DISPLAY MAIN SCREEN FOR CASE CODING ;07/27/05
- +1 ;;3.0;Surgery;**142,177**;24 Jun 93;Build 89
- +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 SRSYS=$$ICDSTR^SROICD(SRTN)
- +4 SET SRDIAG="NOT ENTERED"
- SET SRDX=$PIECE(SR(0),"^",3)
- IF SRDX
- SET SRDIAG=$$ICD^SROICD(SRTN,SRDX)
- SET SRDIAG=$PIECE(SRDIAG,"^",2)_" "_$PIECE(SRDIAG,"^",4)
- +5 WRITE !,"1. Principal Postop Diagnosis Code "_SRSYS_": ",SRDIAG
- +6 WRITE !,"2. Other Postop Diagnosis Code "_SRSYS_": "
- IF '$ORDER(^SRO(136,SRTN,4,0))
- WRITE "NOT ENTERED"
- +7 SET (SRFLG,SRD)=0
- FOR
- SET SRD=$ORDER(^SRO(136,SRTN,4,SRD))
- if 'SRD
- QUIT
- Begin DoDot:1
- +8 SET SRDIAG=""
- SET SRDX=$PIECE($GET(^SRO(136,SRTN,4,SRD,0)),"^")
- IF SRDX
- SET SRDIAG=$$ICD^SROICD(SRTN,SRDX)
- SET SRDIAG=$PIECE(SRDIAG,"^",2)_" "_$PIECE(SRDIAG,"^",4)
- +9 if SRFLG
- WRITE !
- WRITE SRDIAG
- SET SRFLG=1
- End DoDot:1
- +10 SET CPT=$PIECE(SR(0),"^",2)
- SET SRCPT="NOT ENTERED"
- SET (SRSHRT,SRX)=""
- SET SRFLG=0
- +11 IF CPT
- SET Y=$$CPT^ICPTCOD(CPT,SRDATE)
- SET SRCPT=$PIECE(Y,"^",2)
- SET SRSHRT=$PIECE(Y,"^",3)
- +12 SET SRMSG="NO Assoc. DX ENTERED"
- +13 IF CPT
- IF $ORDER(^SRO(136,SRTN,1,0))
- Begin DoDot:1
- +14 SET (SRCOMMA,SRI)=0
- SET SRCMOD=""
- SET SRX="-"
- FOR
- SET SRI=$ORDER(^SRO(136,SRTN,1,SRI))
- if 'SRI
- QUIT
- Begin DoDot:2
- +15 SET SRM=$PIECE(^SRO(136,SRTN,1,SRI,0),"^")
- SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
- KILL SRM
- +16 SET SRX=SRX_$SELECT(SRCOMMA:",",1:"")_SRCMOD
- SET SRCOMMA=1
- End DoDot:2
- End DoDot:1
- +17 WRITE !,"3. Principal CPT Code: ",SRCPT_SRX_" "_SRSHRT
- +18 DO PADXD^SROCDX1
- +19 WRITE !,"4. Other CPT Code: "
- IF '$ORDER(^SRO(136,SRTN,3,0))
- WRITE ?23,"NOT ENTERED"
- +20 SET SRX=0
- SET SRFIRST=1
- FOR
- SET SRX=$ORDER(^SRO(136,SRTN,3,SRX))
- if 'SRX
- QUIT
- Begin DoDot:1
- +21 SET (SRSHRT,SRY)=""
- SET CPT=$PIECE($GET(^SRO(136,SRTN,3,SRX,0)),"^")
- +22 IF CPT
- SET Y=$$CPT^ICPTCOD(CPT,SRDATE)
- SET SRCPT=$PIECE(Y,"^",2)
- SET SRSHRT=$PIECE(Y,"^",3)
- +23 IF CPT
- IF $ORDER(^SRO(136,SRTN,3,SRX,1,0))
- Begin DoDot:2
- +24 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
- +25 SET SRM=$PIECE(^SRO(136,SRTN,3,SRX,1,SRI,0),"^")
- SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
- KILL SRM
- +26 SET SRY=SRY_$SELECT(SRCOMMA:",",1:"")_SRCMOD
- SET SRCOMMA=1
- End DoDot:3
- End DoDot:2
- +27 if 'SRFIRST
- WRITE !,?3,"Other CPT Code: "
- WRITE SRCPT_SRY_" "_SRSHRT
- SET SRFIRST=0
- +28 WRITE !,?5,"Assoc. DX "_$$ICDSTR^SROICD(SRTN)_": "
- IF '$ORDER(^SRO(136,SRTN,3,SRX,2,0))
- WRITE " NOT ENTERED"
- +29 IF CPT
- SET (SRCNT,SRD,SRFLG)=0
- FOR
- SET SRD=$ORDER(^SRO(136,SRTN,3,SRX,2,SRD))
- if 'SRD
- QUIT
- Begin DoDot:2
- +30 SET SRDIAG=""
- SET SRDX=$PIECE($GET(^SRO(136,SRTN,3,SRX,2,SRD,0)),"^")
- SET SRCNT=SRCNT+1
- +31 IF SRDX
- SET SRDIAG=$$ICD^SROICD(SRTN,SRDX)
- SET SRDIAG=$PIECE(SRDIAG,"^",2)_"-"_$PIECE(SRDIAG,"^",4)
- +32 IF SRCNT#2
- if $GET(SRFLG)
- WRITE !
- WRITE ?16,$EXTRACT(SRDIAG,1,28)
- SET SRFLG=1
- +33 IF '(SRCNT#2)
- WRITE ?48,$EXTRACT(SRDIAG,1,28)
- End DoDot:2
- End DoDot:1
- +34 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +35 IF $PIECE(^SRO(136,SRTN,0),"^",3)=""!($PIECE(^SRO(136,SRTN,0),"^",2)="")
- DO REQ
- if SRSOUT
- QUIT
- GOTO DSPLY
- +36 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=".03Principal Postop Diagnosis Code "_$$ICDSTR^SROICD(SRTN)
- 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