IB20P402 ;ALB/CXW - SPECIALTY CODE IN FILE #399;09-SEP-08
;;2.0;INTEGRATED BILLING;**402**;21-MAR-94;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
POST ;
START N U S U="^"
D BMES^XPDUTL("Add the specialty code to file (#399), Post-Install Starting")
ADD ;
;add the specialty to Field ID .08/subfile 399.0222
;the bill status is 1 - entered/not reviewed
N DA,DA2,BILL,NUM,PRV,REC,SPEC,IBDT
S DA=0,NUM=0
F S DA=$O(^DGCR(399,DA)) Q:'DA I $P($G(^DGCR(399,DA,0)),U,13)=1 D
. S DA2=0,BILL=$P($G(^DGCR(399,DA,0)),U)
. F S DA2=$O(^DGCR(399,DA,"PRV",DA2)) Q:'DA2 D
.. L +^DGCR(399,DA):1 I '$T D MES^XPDUTL("*7 ANOTHER USER IS EDITING BILL# "_BILL) Q
.. S REC=$G(^DGCR(399,DA,"PRV",DA2,0))
.. S PRV=$P(REC,U,2),IBDT=$P($G(^DGCR(399,DA,"U")),U)
.. S SPEC=$$SPEC^IBCEU(PRV,IBDT)
.. I $P(REC,U,8)="",SPEC'="" D
... S $P(^DGCR(399,DA,"PRV",DA2,0),U,8)=SPEC
... I PRV'["IBA(355.93" S PRV=$P($G(^VA(200,+PRV,0)),U)
... I PRV["IBA(355.93" S PRV=$P($G(^IBA(355.93,+PRV,0)),U)
... D MES^XPDUTL("Specialty Code "_SPEC_" for provider "_PRV_" added to bill# "_BILL)
... S NUM=NUM+1
.. L -^DGCR(399,DA)
D BMES^XPDUTL("Total "_NUM_$S(NUM=1:"bill has",1:" bills have")_" been updated")
;
FINISH ;
D BMES^XPDUTL("Add the specialty code to file (#399), Post-Install Complete")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P402 1345 printed Dec 13, 2024@02:02:38 Page 2
IB20P402 ;ALB/CXW - SPECIALTY CODE IN FILE #399;09-SEP-08
+1 ;;2.0;INTEGRATED BILLING;**402**;21-MAR-94;Build 17
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
POST ;
START NEW U
SET U="^"
+1 DO BMES^XPDUTL("Add the specialty code to file (#399), Post-Install Starting")
ADD ;
+1 ;add the specialty to Field ID .08/subfile 399.0222
+2 ;the bill status is 1 - entered/not reviewed
+3 NEW DA,DA2,BILL,NUM,PRV,REC,SPEC,IBDT
+4 SET DA=0
SET NUM=0
+5 FOR
SET DA=$ORDER(^DGCR(399,DA))
if 'DA
QUIT
IF $PIECE($GET(^DGCR(399,DA,0)),U,13)=1
Begin DoDot:1
+6 SET DA2=0
SET BILL=$PIECE($GET(^DGCR(399,DA,0)),U)
+7 FOR
SET DA2=$ORDER(^DGCR(399,DA,"PRV",DA2))
if 'DA2
QUIT
Begin DoDot:2
+8 LOCK +^DGCR(399,DA):1
IF '$TEST
DO MES^XPDUTL("*7 ANOTHER USER IS EDITING BILL# "_BILL)
QUIT
+9 SET REC=$GET(^DGCR(399,DA,"PRV",DA2,0))
+10 SET PRV=$PIECE(REC,U,2)
SET IBDT=$PIECE($GET(^DGCR(399,DA,"U")),U)
+11 SET SPEC=$$SPEC^IBCEU(PRV,IBDT)
+12 IF $PIECE(REC,U,8)=""
IF SPEC'=""
Begin DoDot:3
+13 SET $PIECE(^DGCR(399,DA,"PRV",DA2,0),U,8)=SPEC
+14 IF PRV'["IBA(355.93"
SET PRV=$PIECE($GET(^VA(200,+PRV,0)),U)
+15 IF PRV["IBA(355.93"
SET PRV=$PIECE($GET(^IBA(355.93,+PRV,0)),U)
+16 DO MES^XPDUTL("Specialty Code "_SPEC_" for provider "_PRV_" added to bill# "_BILL)
+17 SET NUM=NUM+1
End DoDot:3
+18 LOCK -^DGCR(399,DA)
End DoDot:2
End DoDot:1
+19 DO BMES^XPDUTL("Total "_NUM_$SELECT(NUM=1:"bill has",1:" bills have")_" been updated")
+20 ;
FINISH ;
+1 DO BMES^XPDUTL("Add the specialty code to file (#399), Post-Install Complete")
+2 QUIT
+3 ;
