SROVER1 ;BIR/MAM - EDIT, VERIFICATION SCREEN ;[ 10/01/99 12:55 PM ]
;;3.0;Surgery;**18,67,88,127,119**;24 Jun 93
S SROVER=1,SRAO(1)=55,SRAO(2)=27,SRAO(3)=26,SRAO(4)="",SRAO(5)=34,SRAO(6)="",SRAO(7)=32,SRAO(8)=32.5,SRMSG="NO Assoc. DX ENTERED"
ASK W !!,"Select Information to Edit: " R X:DTIME I '$T!("^"[X) S SRSOUT=1 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:8"
I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>8)!(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
S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE
Q
ONE ; edit one item
W @IOF I EMILY=2 S X=$P(S("OP"),"^",2) I X D W !
.S SRY=$$CPT^ICPTCOD(X,$P($G(^SRF(SRTN,0)),"^",9)),Y=$P(SRY,"^",2),Z=$P(SRY,"^",3)
.W !," CPT Code: "_Y_" ",Z,!,?5,"Description:" D ^SROCPT W ! F I=1:1:80 W "-"
I EMILY=4 D POTH Q
I EMILY=6 D INTRA^SROCMPS S SRSOUT=0 Q
W ! K DR,DIE,DA S DIE=130,DA=SRTN,DR=SRAO(EMILY)_"T" D ^DIE K DR,DIE
I EMILY=5 D
.D:$$SCEC^SROVER3() ASK^SROPCE1 K SRCL
.D DOTH^SROVER3 I $D(Y) S SRSOUT=0
I EMILY=2,$P(S("OP"),"^",2)'="" D VASDX^SROADX
Q
POTH W !,"Other Procedures:",!
N SRSHT K SRSEL S CNT=1,OTH=0 F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH!(SRSOUT) D
.S OTHER=$P(^SRF(SRTN,13,OTH,0),"^"),X=$P($G(^SRF(SRTN,13,OTH,2)),"^"),CPT="NOT ENTERED",CPT1=""
.I X S CPT1=X,Y=$$CPT^ICPTCOD(X,$P($G(^SRF(SRTN,0)),"^",9)),SRCPT=$P(Y,"^",2),SRSHT=$P(Y,"^",3),CPT=SRCPT_" "_SRSHT
.W !,CNT_". "_OTHER,!,?5,"CPT Code: "_CPT S SRSEL(CNT)=OTH_"^"_OTHER_"^CPT Code: "_CPT_"^"_CPT1
.I CPT1,$O(^SRF(SRTN,13,OTH,"MOD",0)) D W " ("_SRX_")"
..S (SRCOMMA,SRI)=0,SRCMOD="",SRX="Modifiers: " F S SRI=$O(^SRF(SRTN,13,OTH,"MOD",SRI)) Q:'SRI D
...S SRM=$P(^SRF(SRTN,13,OTH,"MOD",SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2)
...S SRX=SRX_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
. D OTHADXD^SROADX1
.S CNT=CNT+1
W !,CNT_". Enter NEW Other Procedure",! K DIR S DIR("A")="Enter selection",DIR(0)="NO^1:"_CNT D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
Q:'Y S SRDA=Y W !! I SRDA<CNT D W @IOF G POTH
.N OTHCNT S OTHCNT=Y
.W @IOF,!,"Other Procedures:",!!,OTHCNT,"."
.W ?3,$P(SRSEL(SRDA),"^",2),!,?5,$P(SRSEL(SRDA),"^",3)
.S OTH=$P(SRSEL(SRDA),"^") K SRDES S CPT1=$P(SRSEL(SRDA),"^",4),X=$$CPTD^ICPTCOD(CPT1,"SRDES",,$P($G(^SRF(SRTN,0)),"^",9)) I $O(SRDES(0)) F I=1:1:X W !,?5,SRDES(I)
.K DA,DIE,DIR,DR W ! S DA=$P(SRSEL(SRDA),"^"),DA(1)=SRTN,DIE="^SRF(SRTN,13,",DR=".01;3" D ^DIE K DA,DIE,DR Q:$D(Y)
.D VOTHADX^SROADX
K DIR S DIR("A")="Enter new OTHER PROCEDURE",DIR(0)="130.16,.01" D ^DIR K DIR S SRNEW=Y I $D(DTOUT)!$D(DUOUT)!(Y="") D PH Q
K DD,DO S DIC="^SRF(SRTN,13,",X=SRNEW,DIC(0)="L",DIC("P")=$P(^DD(130,.42,0),"^",2) D FILE^DICN K DIC,DD,DO I +Y<0 D PH Q
K DA,DIE,DIR,DR S DA=+Y,DA(1)=SRTN,DIE="^SRF(SRTN,13,",DR="3" D ^DIE
D NOTHADX^SROADX K DA,DIE,DR Q:$D(Y)
PH W @IOF G POTH
Q
PRESS W ! K DIR S DIR("A")="Press RETURN to continue ",DIR(0)="FOA" D ^DIR K DIR
Q
SROVER1 ;BIR/MAM - EDIT, VERIFICATION SCREEN ;[ 10/01/99 12:55 PM ]
+1 ;;3.0;Surgery;**18,67,88,127,119**;24 Jun 93
+2 SET SROVER=1
SET SRAO(1)=55
SET SRAO(2)=27
SET SRAO(3)=26
SET SRAO(4)=""
SET SRAO(5)=34
SET SRAO(6)=""
SET SRAO(7)=32
SET SRAO(8)=32.5
SET SRMSG="NO Assoc. DX ENTERED"
ASK WRITE !!,"Select Information to Edit: "
READ X:DTIME
IF '$TEST!("^"[X)
SET SRSOUT=1
QUIT
+1 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
+2 IF $EXTRACT(X)="A"
SET X="1:8"
+3 IF X?.N1":".N
SET Y=$EXTRACT(X)
SET Z=$PIECE(X,":",2)
IF Y<1!(Z>8)!(Y>Z)
DO HELP
IF SRSOUT
QUIT
GOTO ASK
+4 IF X?.N1":".N
DO RANGE
QUIT
+5 SET EMILY=X
DO ONE
QUIT
+6 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 SET SHEMP=$PIECE(X,":")
SET CURLEY=$PIECE(X,":",2)
FOR EMILY=SHEMP:1:CURLEY
IF SRSOUT
QUIT
DO ONE
+2 QUIT
ONE ; edit one item
+1 WRITE @IOF
IF EMILY=2
SET X=$PIECE(S("OP"),"^",2)
IF X
Begin DoDot:1
+2 SET SRY=$$CPT^ICPTCOD(X,$PIECE($GET(^SRF(SRTN,0)),"^",9))
SET Y=$PIECE(SRY,"^",2)
SET Z=$PIECE(SRY,"^",3)
+3 WRITE !," CPT Code: "_Y_" ",Z,!,?5,"Description:"
DO ^SROCPT
WRITE !
FOR I=1:1:80
WRITE "-"
End DoDot:1
WRITE !
+4 IF EMILY=4
DO POTH
QUIT
+5 IF EMILY=6
DO INTRA^SROCMPS
SET SRSOUT=0
QUIT
+6 WRITE !
KILL DR,DIE,DA
SET DIE=130
SET DA=SRTN
SET DR=SRAO(EMILY)_"T"
DO ^DIE
KILL DR,DIE
+7 IF EMILY=5
Begin DoDot:1
+8 IF $$SCEC^SROVER3()
DO ASK^SROPCE1
KILL SRCL
+9 DO DOTH^SROVER3
IF $DATA(Y)
SET SRSOUT=0
End DoDot:1
+10 IF EMILY=2
IF $PIECE(S("OP"),"^",2)'=""
DO VASDX^SROADX
+11 QUIT
POTH WRITE !,"Other Procedures:",!
+1 NEW SRSHT
KILL SRSEL
SET CNT=1
SET OTH=0
FOR
SET OTH=$ORDER(^SRF(SRTN,13,OTH))
IF 'OTH!(SRSOUT)
QUIT
Begin DoDot:1
+2 SET OTHER=$PIECE(^SRF(SRTN,13,OTH,0),"^")
SET X=$PIECE($GET(^SRF(SRTN,13,OTH,2)),"^")
SET CPT="NOT ENTERED"
SET CPT1=""
+3 IF X
SET CPT1=X
SET Y=$$CPT^ICPTCOD(X,$PIECE($GET(^SRF(SRTN,0)),"^",9))
SET SRCPT=$PIECE(Y,"^",2)
SET SRSHT=$PIECE(Y,"^",3)
SET CPT=SRCPT_" "_SRSHT
+4 WRITE !,CNT_". "_OTHER,!,?5,"CPT Code: "_CPT
SET SRSEL(CNT)=OTH_"^"_OTHER_"^CPT Code: "_CPT_"^"_CPT1
+5 IF CPT1
IF $ORDER(^SRF(SRTN,13,OTH,"MOD",0))
Begin DoDot:2
+6 SET (SRCOMMA,SRI)=0
SET SRCMOD=""
SET SRX="Modifiers: "
FOR
SET SRI=$ORDER(^SRF(SRTN,13,OTH,"MOD",SRI))
IF 'SRI
QUIT
Begin DoDot:3
+7 SET SRM=$PIECE(^SRF(SRTN,13,OTH,"MOD",SRI,0),"^")
SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
+8 SET SRX=SRX_$SELECT(SRCOMMA:",",1:"")_SRCMOD
SET SRCOMMA=1
End DoDot:3
End DoDot:2
WRITE " ("_SRX_")"
+9 DO OTHADXD^SROADX1
+10 SET CNT=CNT+1
End DoDot:1
+11 WRITE !,CNT_". Enter NEW Other Procedure",!
KILL DIR
SET DIR("A")="Enter selection"
SET DIR(0)="NO^1:"_CNT
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+12 IF 'Y
QUIT
SET SRDA=Y
WRITE !!
IF SRDA<CNT
Begin DoDot:1
+13 NEW OTHCNT
SET OTHCNT=Y
+14 WRITE @IOF,!,"Other Procedures:",!!,OTHCNT,"."
+15 WRITE ?3,$PIECE(SRSEL(SRDA),"^",2),!,?5,$PIECE(SRSEL(SRDA),"^",3)
+16 SET OTH=$PIECE(SRSEL(SRDA),"^")
KILL SRDES
SET CPT1=$PIECE(SRSEL(SRDA),"^",4)
SET X=$$CPTD^ICPTCOD(CPT1,"SRDES",,$PIECE($GET(^SRF(SRTN,0)),"^",9))
IF $ORDER(SRDES(0))
FOR I=1:1:X
WRITE !,?5,SRDES(I)
+17 KILL DA,DIE,DIR,DR
WRITE !
SET DA=$PIECE(SRSEL(SRDA),"^")
SET DA(1)=SRTN
SET DIE="^SRF(SRTN,13,"
SET DR=".01;3"
DO ^DIE
KILL DA,DIE,DR
IF $DATA(Y)
QUIT
+18 DO VOTHADX^SROADX
End DoDot:1
WRITE @IOF
GOTO POTH
+19 KILL DIR
SET DIR("A")="Enter new OTHER PROCEDURE"
SET DIR(0)="130.16,.01"
DO ^DIR
KILL DIR
SET SRNEW=Y
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
DO PH
QUIT
+20 KILL DD,DO
SET DIC="^SRF(SRTN,13,"
SET X=SRNEW
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(130,.42,0),"^",2)
DO FILE^DICN
KILL DIC,DD,DO
IF +Y<0
DO PH
QUIT
+21 KILL DA,DIE,DIR,DR
SET DA=+Y
SET DA(1)=SRTN
SET DIE="^SRF(SRTN,13,"
SET DR="3"
DO ^DIE
+22 DO NOTHADX^SROADX
KILL DA,DIE,DR
IF $DATA(Y)
QUIT
PH WRITE @IOF
GOTO POTH
+1 QUIT
PRESS WRITE !
KILL DIR
SET DIR("A")="Press RETURN to continue "
SET DIR(0)="FOA"
DO ^DIR
KILL DIR
+1 QUIT
