- IBERSI ;ALB/ARH - LIST/DELETE INACTIVE CODES FROM COS; 5/27/92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;determine option from user
- EN S DIR("?")="List and/or delete CPT codes on Check-Off Sheets that are AMA inactive or that are Nationally, Locally, and Billing inactive."
- S DIR(0)="SO^1:LIST INACTIVE CODES ON CHECK-OFF SHEETS;2:DELETE INACTIVE CODES FROM CHECK-OFF SHEET;"
- D ^DIR K DIR G:$D(DIRUT)!'Y EXIT S IBOPT=Y
- D ^IBOCOSI:IBOPT=1,EN1:IBOPT=2 S IBOPT=0 G EN
- ;
- EXIT K X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBOPT
- Q
- ;
- EN1 ;delete CPTs from COS
- ;***
- ;S XRTL=$ZU(0),XRTN="IBERSI-1" D T0^%ZOSV ;start rt clock
- ;
- S DIR("?")="Delete CPT codes on Check-Off Sheets that are AMA inactive"
- S DIR(0)="Y",DIR("A")="DELETE AMA INACTIVE CODES",DIR("B")="No"
- D ^DIR K DIR G:$D(DIRUT) END1 I Y=1 S IBAMA=1
- S DIR("?")="Delete CPT codes on Check-Off Sheets that are Nationally, Locally, and Billing inactive."
- S DIR(0)="Y",DIR("A")="DELETE OTHER INACTIVE CODES",DIR("B")="No"
- D ^DIR K DIR G:$D(DIRUT) END1 I Y=1 S IBNLB=1
- I $D(IBAMA)!($D(IBNLB)) W !,"Deleting" D DEL
- END1 K X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBAMA,IBNLB
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBERSI" D T1^%ZOSV ;stop rt clock
- Q
- ;
- DEL ;delete inactive codes from check-off sheets
- S IBCPT="" F S IBCPT=$O(^IBE(350.71,"P",IBCPT)) Q:IBCPT="" S IBX="" F S IBX=$O(^IBE(350.71,"P",IBCPT,IBX)) Q:IBX="" D
- . S IBLN=$G(^IBE(350.71,IBX,0)),IBSTAT=+$$CPTSTAT^IBEFUNC2(+$P(IBLN,"^",6)) Q:IBSTAT>1
- . I ($D(IBAMA)&('IBSTAT))!($D(IBNLB)&(IBSTAT)) S DIK="^IBE(350.71,",DA=IBX D ^DIK K DIK,DA
- K IBSTAT,IBCPT,IBX,IBLN
- Q
- IBERSI ;ALB/ARH - LIST/DELETE INACTIVE CODES FROM COS; 5/27/92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;determine option from user
- EN SET DIR("?")="List and/or delete CPT codes on Check-Off Sheets that are AMA inactive or that are Nationally, Locally, and Billing inactive."
- +1 SET DIR(0)="SO^1:LIST INACTIVE CODES ON CHECK-OFF SHEETS;2:DELETE INACTIVE CODES FROM CHECK-OFF SHEET;"
- +2 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!'Y
- GOTO EXIT
- SET IBOPT=Y
- +3 IF IBOPT=1
- DO ^IBOCOSI
- IF IBOPT=2
- DO EN1
- SET IBOPT=0
- GOTO EN
- +4 ;
- EXIT KILL X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBOPT
- +1 QUIT
- +2 ;
- EN1 ;delete CPTs from COS
- +1 ;***
- +2 ;S XRTL=$ZU(0),XRTN="IBERSI-1" D T0^%ZOSV ;start rt clock
- +3 ;
- +4 SET DIR("?")="Delete CPT codes on Check-Off Sheets that are AMA inactive"
- +5 SET DIR(0)="Y"
- SET DIR("A")="DELETE AMA INACTIVE CODES"
- SET DIR("B")="No"
- +6 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO END1
- IF Y=1
- SET IBAMA=1
- +7 SET DIR("?")="Delete CPT codes on Check-Off Sheets that are Nationally, Locally, and Billing inactive."
- +8 SET DIR(0)="Y"
- SET DIR("A")="DELETE OTHER INACTIVE CODES"
- SET DIR("B")="No"
- +9 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO END1
- IF Y=1
- SET IBNLB=1
- +10 IF $DATA(IBAMA)!($DATA(IBNLB))
- WRITE !,"Deleting"
- DO DEL
- END1 KILL X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBAMA,IBNLB
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBERSI" D T1^%ZOSV ;stop rt clock
- +3 QUIT
- +4 ;
- DEL ;delete inactive codes from check-off sheets
- +1 SET IBCPT=""
- FOR
- SET IBCPT=$ORDER(^IBE(350.71,"P",IBCPT))
- IF IBCPT=""
- QUIT
- SET IBX=""
- FOR
- SET IBX=$ORDER(^IBE(350.71,"P",IBCPT,IBX))
- IF IBX=""
- QUIT
- Begin DoDot:1
- +2 SET IBLN=$GET(^IBE(350.71,IBX,0))
- SET IBSTAT=+$$CPTSTAT^IBEFUNC2(+$PIECE(IBLN,"^",6))
- IF IBSTAT>1
- QUIT
- +3 IF ($DATA(IBAMA)&('IBSTAT))!($DATA(IBNLB)&(IBSTAT))
- SET DIK="^IBE(350.71,"
- SET DA=IBX
- DO ^DIK
- KILL DIK,DA
- End DoDot:1
- +4 KILL IBSTAT,IBCPT,IBX,IBLN
- +5 QUIT
