| 1 | SDAMBAE3 ;ALB/BOK/MJK - ADD/EDIT CON'T ;7/8/91 12:18 ;
|
|---|
| 2 | ;;5.3;Scheduling;**18,29,40,111,132**;Aug 13, 1993;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | DUP ; -- inp transform to check for duplicate CPTs in ^DD(409.51,21:25,0)
|
|---|
| 5 | ; variable '%' is passed and defined as the piece beinging edited
|
|---|
| 6 | ;
|
|---|
| 7 | F C=0:0 S C=$O(^SDV("AP",DA(1),C)) Q:'C I $D(^SDV(DA(1),"CS",C,"PR")) S Y=^("PR") F I=1:1:5 I $S(C'=DA:1,1:I'=%),$P(Y,U,I)=X D DUPMES G DUPQ
|
|---|
| 8 | DUPQ K C Q
|
|---|
| 9 | ;
|
|---|
| 10 | DUPMES ;
|
|---|
| 11 | W !?2,*7,"WARNING: '",$P(^ICPT(X,0),U,2),"' has already been entered for this",!?11,"patient on this VISIT DATE(Entry #",C,").",!!?11,"Procedure will be added again."
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | SCREEN ; -- screen logic for 409.51 proc fields
|
|---|
| 15 | ; finds status for effective date DA(1)
|
|---|
| 16 | I $P($$CPT^ICPTCOD(Y,$P(DA(1),".")),U,7)
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | ID ; -- DIC("W") logic for amb proc look-ups
|
|---|
| 20 | N SDICPT,SDICPT1,SDIX
|
|---|
| 21 | S SDICPT1=$$CPT^ICPTCOD(Y,D)
|
|---|
| 22 | Q:SDICPT1<0
|
|---|
| 23 | W ?4,$P(SDICPT1,U,3)
|
|---|
| 24 | I '$P(SDICPT1,U,7) W !?10,"** INACTIVE **"
|
|---|
| 25 | ;
|
|---|
| 26 | ; print code description
|
|---|
| 27 | S SDICPT=$$CPTD^ICPTCOD(Y,"SDICPT") F SDIX=1:1:SDICPT W !?10,SDICPT(SDIX)
|
|---|
| 28 | ; set $TEST
|
|---|
| 29 | W !?9 I $D(^ICPT(Y,0))
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
