source: FOIAVistA/tag/r/SURGERY-SR/SROCD2.m@ 949

Last change on this file since 949 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1SROCD2 ;BIR/ADM - DISPLAY MAIN SCREEN FOR CASE CODING ;07/27/05
2 ;;3.0; Surgery ;**142**;24 Jun 93
3 ; display information from file 136
4EN N SCEC,SRCHFNO,SRFIRST,SRFLG,SRCMOD,SRSHRT,SRNON
5DSPLY S (SREDIT,SRSOUT,SRNON,SRCHFNO)=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
6 S SRDATE=$P($G(^SRF(SRTN,0)),"^",9),SR(0)=$G(^SRO(136,SRTN,0))
7 D HDR^SROCD W !,$S('SRNON:"Surgery Procedure",1:"Non-OR Procedure")_" PCE/Billing Information:",!
8 S SRDIAG="NOT ENTERED",SRDX=$P(SR(0),"^",3) I SRDX S SRDIAG=$$ICDDX^ICDCODE(SRDX,SRDATE),SRDIAG=$P(SRDIAG,"^",2)_" "_$P(SRDIAG,"^",4)
9 W !,"1. Principal Postop Diagnosis Code:",?36,SRDIAG
10 W !,"2. Other Postop Diagnosis Code:" I '$O(^SRO(136,SRTN,4,0)) W ?36,"NOT ENTERED"
11 S (SRFLG,SRD)=0 F S SRD=$O(^SRO(136,SRTN,4,SRD)) Q:'SRD D
12 .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)
13 .W:SRFLG ! W ?36,SRDIAG S SRFLG=1
14 S CPT=$P(SR(0),"^",2),SRCPT="NOT ENTERED",(SRSHRT,SRX)="",SRFLG=0
15 I CPT S Y=$$CPT^ICPTCOD(CPT,SRDATE),SRCPT=$P(Y,"^",2),SRSHRT=$P(Y,"^",3)
16 S SRMSG="NO Assoc. DX ENTERED"
17 I CPT,$O(^SRO(136,SRTN,1,0)) D
18 .S (SRCOMMA,SRI)=0,SRCMOD="",SRX="-" F S SRI=$O(^SRO(136,SRTN,1,SRI)) Q:'SRI D
19 ..S SRM=$P(^SRO(136,SRTN,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2) K SRM
20 ..S SRX=SRX_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
21 W !,"3. Principal CPT Code: ",SRCPT_SRX_" "_SRSHRT
22 D PADXD^SROCDX1
23 W !,"4. Other CPT Code: " I '$O(^SRO(136,SRTN,3,0)) W ?23,"NOT ENTERED"
24 S SRX=0,SRFIRST=1 F S SRX=$O(^SRO(136,SRTN,3,SRX)) Q:'SRX D
25 .S (SRSHRT,SRY)="",CPT=$P($G(^SRO(136,SRTN,3,SRX,0)),"^")
26 .I CPT S Y=$$CPT^ICPTCOD(CPT,SRDATE),SRCPT=$P(Y,"^",2),SRSHRT=$P(Y,"^",3)
27 .I CPT,$O(^SRO(136,SRTN,3,SRX,1,0)) D
28 ..S (SRCOMMA,SRFLG,SRI)=0,SRCMOD="",SRY="-" F S SRI=$O(^SRO(136,SRTN,3,SRX,1,SRI)) Q:'SRI D
29 ...S SRM=$P(^SRO(136,SRTN,3,SRX,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2) K SRM
30 ...S SRY=SRY_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
31 .W:'SRFIRST !,?3,"Other CPT Code: " W SRCPT_SRY_" "_SRSHRT S SRFIRST=0
32 .W !,?5,"Assoc. DX: " I '$O(^SRO(136,SRTN,3,SRX,2,0)) W " NOT ENTERED"
33 .I CPT S (SRCNT,SRD,SRFLG)=0 F S SRD=$O(^SRO(136,SRTN,3,SRX,2,SRD)) Q:'SRD D
34 ..S SRDIAG="",SRDX=$P($G(^SRO(136,SRTN,3,SRX,2,SRD,0)),"^"),SRCNT=SRCNT+1
35 ..I SRDX S SRDIAG=$$ICDDX^ICDCODE(SRDX,SRDATE),SRDIAG=$P(SRDIAG,"^",2)_"-"_$P(SRDIAG,"^",4)
36 ..I SRCNT#2 W:$G(SRFLG) ! W ?16,$E(SRDIAG,1,28) S SRFLG=1
37 ..I '(SRCNT#2) W ?48,$E(SRDIAG,1,28)
38 W ! F LINE=1:1:80 W "-"
39 I $P(^SRO(136,SRTN,0),"^",3)=""!($P(^SRO(136,SRTN,0),"^",2)="") D REQ Q:SRSOUT G DSPLY
40 S SRAO(1)=.03,SRAO(2)="",SRAO(3)=".02",SRAO(4)=""
41ASK 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"
42 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
43 I X="" D ^SROCD4 Q
44 S:$E(X)="a" X="A" I '$D(SRAO(X)),(X'?.N1":".N),($E(X)'="A") D HELP Q:SRSOUT G ASK
45 I $E(X)="A" S X="1:4"
46 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
47 I X?.N1":".N D RANGE Q
48 S EMILY=X D ONE Q
49 Q
50HELP 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"
51 W !,"range of numbers separated by a ':' to update more than one item.",!
52 Q
53RANGE ; range of numbers
54 N CURLEY,EMILY,SHEMP
55 S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE
56 Q
57ONE ; edit one item
58 D HDR^SROCD
59 I EMILY=4 D POTH^SROCD0 Q
60 I EMILY=2 D DOTH^SROCD0 Q
61 I EMILY=1 D PRDX^SROCD0 Q
62 I EMILY=3 D PCPT^SROCDX
63 Q
64REQ W !,"The following information is required before continuing.",!
65PDX I $P(^SRO(136,SRTN,0),"^",3)="" D Q:SRSOUT
66 .K DA,DIE,DR S DA=SRTN,DIE=136,DR=".03T" D ^DIE I $D(Y) S SRSOUT=1 Q
67 .S Y=$P(^SRO(136,SRTN,0),"^",3) I Y S SCEC=$$SCEC^SROCD0() I SCEC D SCEI^SROCD3 K SRCL
68 I $P(^SRO(136,SRTN,0),"^",3)="" W !,"This is a required response. Enter '^' to exit" G PDX
69 I $D(SCEC) K SCEC Q
70PCPT 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
71 I $P(^SRO(136,SRTN,0),"^",2)="" W !,"This is a required response. Enter '^' to exit" G PCPT
72 D PRIN^SROMOD0 K DA,DIE,DR
73 Q
Note: See TracBrowser for help on using the repository browser.