Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROCD2

SROCD2.m

Go to the documentation of this file.
  1. SROCD2 ;BIR/ADM - DISPLAY MAIN SCREEN FOR CASE CODING ;07/27/05
  1. ;;3.0;Surgery;**142,177**;24 Jun 93;Build 89
  1. ; display information from file 136
  1. EN N SCEC,SRCHFNO,SRFIRST,SRFLG,SRCMOD,SRSHRT,SRNON
  1. DSPLY S (SREDIT,SRSOUT,SRNON,SRCHFNO)=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
  1. S SRDATE=$P($G(^SRF(SRTN,0)),"^",9),SR(0)=$G(^SRO(136,SRTN,0))
  1. D HDR^SROCD W !,$S('SRNON:"Surgery Procedure",1:"Non-OR Procedure")_" PCE/Billing Information:",!
  1. S SRSYS=$$ICDSTR^SROICD(SRTN)
  1. S SRDIAG="NOT ENTERED",SRDX=$P(SR(0),"^",3) I SRDX S SRDIAG=$$ICD^SROICD(SRTN,SRDX),SRDIAG=$P(SRDIAG,"^",2)_" "_$P(SRDIAG,"^",4)
  1. W !,"1. Principal Postop Diagnosis Code "_SRSYS_": ",SRDIAG
  1. W !,"2. Other Postop Diagnosis Code "_SRSYS_": " I '$O(^SRO(136,SRTN,4,0)) W "NOT ENTERED"
  1. S (SRFLG,SRD)=0 F S SRD=$O(^SRO(136,SRTN,4,SRD)) Q:'SRD D
  1. .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)
  1. .W:SRFLG ! W SRDIAG S SRFLG=1
  1. S CPT=$P(SR(0),"^",2),SRCPT="NOT ENTERED",(SRSHRT,SRX)="",SRFLG=0
  1. I CPT S Y=$$CPT^ICPTCOD(CPT,SRDATE),SRCPT=$P(Y,"^",2),SRSHRT=$P(Y,"^",3)
  1. S SRMSG="NO Assoc. DX ENTERED"
  1. I CPT,$O(^SRO(136,SRTN,1,0)) D
  1. .S (SRCOMMA,SRI)=0,SRCMOD="",SRX="-" F S SRI=$O(^SRO(136,SRTN,1,SRI)) Q:'SRI D
  1. ..S SRM=$P(^SRO(136,SRTN,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2) K SRM
  1. ..S SRX=SRX_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
  1. W !,"3. Principal CPT Code: ",SRCPT_SRX_" "_SRSHRT
  1. D PADXD^SROCDX1
  1. W !,"4. Other CPT Code: " I '$O(^SRO(136,SRTN,3,0)) W ?23,"NOT ENTERED"
  1. S SRX=0,SRFIRST=1 F S SRX=$O(^SRO(136,SRTN,3,SRX)) Q:'SRX D
  1. .S (SRSHRT,SRY)="",CPT=$P($G(^SRO(136,SRTN,3,SRX,0)),"^")
  1. .I CPT S Y=$$CPT^ICPTCOD(CPT,SRDATE),SRCPT=$P(Y,"^",2),SRSHRT=$P(Y,"^",3)
  1. .I CPT,$O(^SRO(136,SRTN,3,SRX,1,0)) D
  1. ..S (SRCOMMA,SRFLG,SRI)=0,SRCMOD="",SRY="-" F S SRI=$O(^SRO(136,SRTN,3,SRX,1,SRI)) Q:'SRI D
  1. ...S SRM=$P(^SRO(136,SRTN,3,SRX,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2) K SRM
  1. ...S SRY=SRY_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
  1. .W:'SRFIRST !,?3,"Other CPT Code: " W SRCPT_SRY_" "_SRSHRT S SRFIRST=0
  1. .W !,?5,"Assoc. DX "_$$ICDSTR^SROICD(SRTN)_": " I '$O(^SRO(136,SRTN,3,SRX,2,0)) W " NOT ENTERED"
  1. .I CPT S (SRCNT,SRD,SRFLG)=0 F S SRD=$O(^SRO(136,SRTN,3,SRX,2,SRD)) Q:'SRD D
  1. ..S SRDIAG="",SRDX=$P($G(^SRO(136,SRTN,3,SRX,2,SRD,0)),"^"),SRCNT=SRCNT+1
  1. ..I SRDX S SRDIAG=$$ICD^SROICD(SRTN,SRDX),SRDIAG=$P(SRDIAG,"^",2)_"-"_$P(SRDIAG,"^",4)
  1. ..I SRCNT#2 W:$G(SRFLG) ! W ?16,$E(SRDIAG,1,28) S SRFLG=1
  1. ..I '(SRCNT#2) W ?48,$E(SRDIAG,1,28)
  1. W ! F LINE=1:1:80 W "-"
  1. I $P(^SRO(136,SRTN,0),"^",3)=""!($P(^SRO(136,SRTN,0),"^",2)="") D REQ Q:SRSOUT G DSPLY
  1. S SRAO(1)=.03,SRAO(2)="",SRAO(3)=".02",SRAO(4)=""
  1. 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"
  1. 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
  1. I X="" D ^SROCD4 Q
  1. S:$E(X)="a" X="A" I '$D(SRAO(X)),(X'?.N1":".N),($E(X)'="A") D HELP Q:SRSOUT G ASK
  1. I $E(X)="A" S X="1:4"
  1. 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
  1. I X?.N1":".N D RANGE Q
  1. S EMILY=X D ONE Q
  1. Q
  1. 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"
  1. W !,"range of numbers separated by a ':' to update more than one item.",!
  1. Q
  1. RANGE ; range of numbers
  1. N CURLEY,EMILY,SHEMP
  1. S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE
  1. Q
  1. ONE ; edit one item
  1. D HDR^SROCD
  1. I EMILY=4 D POTH^SROCD0 Q
  1. I EMILY=2 D DOTH^SROCD0 Q
  1. I EMILY=1 D PRDX^SROCD0 Q
  1. I EMILY=3 D PCPT^SROCDX
  1. Q
  1. REQ W !,"The following information is required before continuing.",!
  1. PDX I $P(^SRO(136,SRTN,0),"^",3)="" D Q:SRSOUT
  1. .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
  1. .S Y=$P(^SRO(136,SRTN,0),"^",3) I Y S SCEC=$$SCEC^SROCD0() I SCEC D SCEI^SROCD3 K SRCL
  1. I $P(^SRO(136,SRTN,0),"^",3)="" W !,"This is a required response. Enter '^' to exit" G PDX
  1. I $D(SCEC) K SCEC Q
  1. 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
  1. I $P(^SRO(136,SRTN,0),"^",2)="" W !,"This is a required response. Enter '^' to exit" G PCPT
  1. D PRIN^SROMOD0 K DA,DIE,DR
  1. Q