- 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
