| 1 | SROCD1 ;BIR/ADM - CREATE CODING RECORD ;05/16/05
|
|---|
| 2 | ;;3.0; Surgery ;**142,152**;24 Jun 93
|
|---|
| 3 | N SR,SRD,SRDX,SRDICN,SRIEN,SRM,SRMOD,SRN,SRO,SROTH,SRP,SRPD,SRX,SRY,X,Y
|
|---|
| 4 | I $P($G(^SRO(136,SRTN,0)),"^")'=SRTN D NEW
|
|---|
| 5 | S SR(0)=$G(^SRF(SRTN,0))
|
|---|
| 6 | S $P(^SRO(136,SRTN,0),"^",2)=$P($G(^SRF(SRTN,"OP")),"^",2)
|
|---|
| 7 | S $P(^SRO(136,SRTN,0),"^",3)=$P($G(^SRF(SRTN,34)),"^",2)
|
|---|
| 8 | SC S $P(^SRO(136,SRTN,0),"^",4)=$P(SR(0),"^",16)
|
|---|
| 9 | AO S $P(^SRO(136,SRTN,0),"^",5)=$P(SR(0),"^",17)
|
|---|
| 10 | IR S $P(^SRO(136,SRTN,0),"^",6)=$P(SR(0),"^",18)
|
|---|
| 11 | EC S $P(^SRO(136,SRTN,0),"^",7)=$P(SR(0),"^",19)
|
|---|
| 12 | MST S $P(^SRO(136,SRTN,0),"^",8)=$P(SR(0),"^",22)
|
|---|
| 13 | HNC S $P(^SRO(136,SRTN,0),"^",9)=$P(SR(0),"^",23)
|
|---|
| 14 | CV S $P(^SRO(136,SRTN,0),"^",10)=$P(SR(0),"^",24)
|
|---|
| 15 | PRJ S $P(^SRO(136,SRTN,0),"^",11)=$P(SR(0),"^",25)
|
|---|
| 16 | PMOD S SRM=0 F S SRM=$O(^SRF(SRTN,"OPMOD",SRM)) Q:'SRM D
|
|---|
| 17 | .S SRMOD=$P(^SRF(SRTN,"OPMOD",SRM,0),"^")
|
|---|
| 18 | .S SRY(136.01,"+1,"_SRTN_",",.01)=SRMOD D UPDATE^DIE("","SRY") K SRY
|
|---|
| 19 | PDX S SRD=0 F S SRD=$O(^SRF(SRTN,"PADX",SRD)) Q:'SRD D
|
|---|
| 20 | .S SRX=$P(^SRF(SRTN,"PADX",SRD,0),"^")
|
|---|
| 21 | .I SRX=0 S SRDX=$P($G(^SRF(SRTN,34)),"^",2)
|
|---|
| 22 | .E S SRDX=$P($G(^SRF(SRTN,15,SRX,0)),"^",3)
|
|---|
| 23 | .I SRDX S SRY(136.02,"+1,"_SRTN_",",.01)=SRDX D UPDATE^DIE("","SRY") K SRY
|
|---|
| 24 | POTH S SRO=0 F S SRO=$O(^SRF(SRTN,13,SRO)) Q:'SRO D
|
|---|
| 25 | .S SROTH=$P($G(^SRF(SRTN,13,SRO,2)),"^") Q:'SROTH S SRDICN=1
|
|---|
| 26 | .K DD,DO,DIC S DIC="^SRO(136,SRTN,3,",DIC(0)="L",X=SROTH D FILE^DICN K DA,DD,DIC,DO,DR S SRIEN=+Y I SRIEN'>0 Q
|
|---|
| 27 | .S SRM=0 F S SRM=$O(^SRF(SRTN,13,SRO,"MOD",SRM)) Q:'SRM D
|
|---|
| 28 | ..S SRMOD=$P(^SRF(SRTN,13,SRO,"MOD",SRM,0),"^")
|
|---|
| 29 | ..S SRY(136.31,"+1,"_SRIEN_","_SRTN_",",.01)=SRMOD D UPDATE^DIE("","SRY") K SRY
|
|---|
| 30 | .S SRD=0 F S SRD=$O(^SRF(SRTN,13,SRO,"OADX",SRD)) Q:'SRD D
|
|---|
| 31 | ..S SRX=$P(^SRF(SRTN,13,SRO,"OADX",SRD,0),"^")
|
|---|
| 32 | ..I SRX=0 S SRDX=$P($G(^SRF(SRTN,34)),"^",2)
|
|---|
| 33 | ..E S SRDX=$P($G(^SRF(SRTN,15,SRX,0)),"^",3)
|
|---|
| 34 | ..I SRDX S SRY(136.32,"+1,"_SRIEN_","_SRTN_",",.01)=SRDX D UPDATE^DIE("","SRY") K SRY
|
|---|
| 35 | ; other diagnoses
|
|---|
| 36 | S SRP=0 F S SRP=$O(^SRF(SRTN,15,SRP)) Q:'SRP D
|
|---|
| 37 | .S SRPD=$P(^SRF(SRTN,15,SRP,0),"^",3) Q:'SRPD S SRIS=$G(^SRF(SRTN,15,SRP,2))
|
|---|
| 38 | .S SRY(136.04,"+1,"_SRTN_",",.01)=SRPD,SRY(136.04,"+1,"_SRTN_",",.02)=$P(SRIS,"^")
|
|---|
| 39 | .S SRY(136.04,"+1,"_SRTN_",",.03)=$P(SRIS,"^",2),SRY(136.04,"+1,"_SRTN_",",.04)=$P(SRIS,"^",3)
|
|---|
| 40 | .S SRY(136.04,"+1,"_SRTN_",",.05)=$P(SRIS,"^",4),SRY(136.04,"+1,"_SRTN_",",.06)=$P(SRIS,"^",5)
|
|---|
| 41 | .S SRY(136.04,"+1,"_SRTN_",",.07)=$P(SRIS,"^",6),SRY(136.04,"+1,"_SRTN_",",.08)=$P(SRIS,"^",7)
|
|---|
| 42 | .S SRY(136.04,"+1,"_SRTN_",",.09)=$P(SRIS,"^",8)
|
|---|
| 43 | .D UPDATE^DIE("","SRY") K SRIS,SRY
|
|---|
| 44 | Q
|
|---|
| 45 | NEW K DA,DIC,DD,DO,DINUM S (DINUM,X)=SRTN,DIC="^SRO(136,",DIC(0)="L" D FILE^DICN K DD,DO,DIC,DINUM
|
|---|
| 46 | Q
|
|---|
| 47 | CHNG() ; check for changes to data
|
|---|
| 48 | N SRI,SRJ,SRK,SRS,SRCHNG S SRCHNG=0
|
|---|
| 49 | M ^TMP("SRED2",$J,SRTN)=^SRO(136,SRTN)
|
|---|
| 50 | I $G(^TMP("SRED1",$J,SRTN,0))'=$G(^TMP("SRED2",$J,SRTN,0)) Q 1
|
|---|
| 51 | D COMP
|
|---|
| 52 | Q SRCHNG
|
|---|
| 53 | COMP S SRI=0 F S SRI=$O(^TMP("SRED1",$J,SRTN,1,SRI)) Q:'SRI!SRCHNG I $G(^TMP("SRED1",$J,SRTN,1,SRI,0))'=$G(^TMP("SRED2",$J,SRTN,1,SRI,0)) S SRCHNG=1 Q
|
|---|
| 54 | S SRI=0 F S SRI=$O(^TMP("SRED1",$J,SRTN,2,SRI)) Q:'SRI!SRCHNG I $G(^TMP("SRED1",$J,SRTN,2,SRI,0))'=$G(^TMP("SRED2",$J,SRTN,2,SRI,0)) S SRCHNG=1 Q
|
|---|
| 55 | S SRI=0 F S SRI=$O(^TMP("SRED1",$J,SRTN,3,SRI)) Q:'SRI!SRCHNG D Q:SRCHNG
|
|---|
| 56 | .I $G(^TMP("SRED1",$J,SRTN,3,SRI,0))'=$G(^TMP("SRED2",$J,SRTN,3,SRI,0)) S SRCHNG=1 Q
|
|---|
| 57 | .F SRS=1,2 S SRK=0 F S SRK=$O(^TMP("SRED1",$J,SRTN,3,SRI,SRS,SRK)) Q:'SRK!SRCHNG I $G(^TMP("SRED1",$J,SRTN,3,SRI,SRS,SRK,0))'=$G(^TMP("SRED2",$J,SRTN,3,SRI,SRS,SRK,0)) S SRCHNG=1 Q
|
|---|
| 58 | S SRI=0 F S SRI=$O(^TMP("SRED1",$J,SRTN,4,SRI)) Q:'SRI!SRCHNG I $G(^TMP("SRED1",$J,SRTN,4,SRI,0))'=$G(^TMP("SRED2",$J,SRTN,4,SRI,0)) S SRCHNG=1 Q
|
|---|
| 59 | S SRI=0 F S SRI=$O(^TMP("SRED2",$J,SRTN,1,SRI)) Q:'SRI!SRCHNG I $G(^TMP("SRED2",$J,SRTN,1,SRI,0))'=$G(^TMP("SRED1",$J,SRTN,1,SRI,0)) S SRCHNG=1 Q
|
|---|
| 60 | S SRI=0 F S SRI=$O(^TMP("SRED2",$J,SRTN,2,SRI)) Q:'SRI!SRCHNG I $G(^TMP("SRED2",$J,SRTN,2,SRI,0))'=$G(^TMP("SRED1",$J,SRTN,2,SRI,0)) S SRCHNG=1 Q
|
|---|
| 61 | S SRI=0 F S SRI=$O(^TMP("SRED2",$J,SRTN,3,SRI)) Q:'SRI!SRCHNG D Q:SRCHNG
|
|---|
| 62 | .I $G(^TMP("SRED2",$J,SRTN,3,SRI,0))'=$G(^TMP("SRED1",$J,SRTN,3,SRI,0)) S SRCHNG=1 Q
|
|---|
| 63 | .F SRS=1,2 S SRK=0 F S SRK=$O(^TMP("SRED2",$J,SRTN,3,SRI,SRS,SRK)) Q:'SRK!SRCHNG I $G(^TMP("SRED2",$J,SRTN,3,SRI,SRS,SRK,0))'=$G(^TMP("SRED1",$J,SRTN,3,SRI,SRS,SRK,0)) S SRCHNG=1 Q
|
|---|
| 64 | S SRI=0 F S SRI=$O(^TMP("SRED2",$J,SRTN,4,SRI)) Q:'SRI!SRCHNG I $G(^TMP("SRED2",$J,SRTN,4,SRI,0))'=$G(^TMP("SRED1",$J,SRTN,4,SRI,0)) S SRCHNG=1 Q
|
|---|
| 65 | K ^TMP("SRED1",$J),^TMP("SRED2",$J)
|
|---|
| 66 | Q
|
|---|
