ICPT616 ;DLS/DEK- ICPT Patch Driver; 10/27/03 3:03pm
;;6.0;CPT/HCPCS;**16**;May 19, 1997
;
; Addresses NOIS: BAY-1003-31889
;
; External References
; DBIA 1995 CODEN^ICPTCOD
; DBIA 2053 FILE^DIE
; DBIA 10141 BMES^XPDUTL
;
POST ;- Post-Init
N I,ICPTX,FDA,FLAG,CODE,DESC
S CODE="G0121",ICPTX=$$CODEN^ICPTCOD(CODE),FLAG=1
I ICPTX<0 D BMES^XPDUTL("INVALID HCPCS Code: "_CODE) Q
S DESC="Colon ca scrn not hi rsk ind",FDA(81,ICPTX_",",2)=DESC
F I=1:1:5 Q:'FLAG D
. K ^TMP("DIERR",$J)
. D FILE^DIE("K","FDA")
. S FLAG=$D(^TMP("DIERR",$J))
I FLAG S $P(^ICPT(ICPTX,0),"U",2)=DESC
K ^TMP("DIERR",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPT616 650 printed Nov 22, 2024@16:55:41 Page 2
ICPT616 ;DLS/DEK- ICPT Patch Driver; 10/27/03 3:03pm
+1 ;;6.0;CPT/HCPCS;**16**;May 19, 1997
+2 ;
+3 ; Addresses NOIS: BAY-1003-31889
+4 ;
+5 ; External References
+6 ; DBIA 1995 CODEN^ICPTCOD
+7 ; DBIA 2053 FILE^DIE
+8 ; DBIA 10141 BMES^XPDUTL
+9 ;
POST ;- Post-Init
+1 NEW I,ICPTX,FDA,FLAG,CODE,DESC
+2 SET CODE="G0121"
SET ICPTX=$$CODEN^ICPTCOD(CODE)
SET FLAG=1
+3 IF ICPTX<0
DO BMES^XPDUTL("INVALID HCPCS Code: "_CODE)
QUIT
+4 SET DESC="Colon ca scrn not hi rsk ind"
SET FDA(81,ICPTX_",",2)=DESC
+5 FOR I=1:1:5
if 'FLAG
QUIT
Begin DoDot:1
+6 KILL ^TMP("DIERR",$JOB)
+7 DO FILE^DIE("K","FDA")
+8 SET FLAG=$DATA(^TMP("DIERR",$JOB))
End DoDot:1
+9 IF FLAG
SET $PIECE(^ICPT(ICPTX,0),"U",2)=DESC
+10 KILL ^TMP("DIERR",$JOB)
+11 QUIT
+12 ;
