- 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 Mar 13, 2025@20:50:09 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 ;
