IB20P387 ;DAY/RRA - DSS CLINIC STOP CODES IB*2.0*378 PRE-INIT ; 3/13/07 12:55pm
;;2.0;INTEGRATED BILLING;**387**;21-MAR-94;Build 3
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
EN ;
N U
S U="^"
D START,UPDATE,FINISH
Q
;
START D BMES^XPDUTL("DSS Clinic Stop Codes, Post-Install Starting")
Q
;
FINISH D BMES^XPDUTL("DSS Clinic Stop Codes, Post-Install Complete")
Q
;
;
UPDATE ;update an old code
N IB1,IBT,IBX,IBCODE,IBY
D BMES^XPDUTL(" Updating Stop Code entries 695 and 696 in file 352.5")
F IBX=1:1 S IBT=$P($T(OCODE+IBX),";",3) Q:'$L(IBT) D
. S IBCODE=+$P(IBT,U)
. S IBY=3071001
. S IB1=$O(^IBE(352.5,"AEFFDT",IBCODE,-IBY,0))
. I 'IB1 D BMES^XPDUTL("No Stop Code Entry found for "_IBCODE_" with an efective date of 10/01/07") Q
. S DIE="^IBE(352.5,",DA=IB1,DR=".05///1" D ^DIE K DA,DR,DIE
. D BMES^XPDUTL(" "_IBCODE_" updated in file 352.5")
Q
;
OCODE ;;code^billable type^description^override flag
;;695
;;696
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P387 1012 printed Dec 13, 2024@02:02:31 Page 2
IB20P387 ;DAY/RRA - DSS CLINIC STOP CODES IB*2.0*378 PRE-INIT ; 3/13/07 12:55pm
+1 ;;2.0;INTEGRATED BILLING;**387**;21-MAR-94;Build 3
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
EN ;
+1 NEW U
+2 SET U="^"
+3 DO START
DO UPDATE
DO FINISH
+4 QUIT
+5 ;
START DO BMES^XPDUTL("DSS Clinic Stop Codes, Post-Install Starting")
+1 QUIT
+2 ;
FINISH DO BMES^XPDUTL("DSS Clinic Stop Codes, Post-Install Complete")
+1 QUIT
+2 ;
+3 ;
UPDATE ;update an old code
+1 NEW IB1,IBT,IBX,IBCODE,IBY
+2 DO BMES^XPDUTL(" Updating Stop Code entries 695 and 696 in file 352.5")
+3 FOR IBX=1:1
SET IBT=$PIECE($TEXT(OCODE+IBX),";",3)
if '$LENGTH(IBT)
QUIT
Begin DoDot:1
+4 SET IBCODE=+$PIECE(IBT,U)
+5 SET IBY=3071001
+6 SET IB1=$ORDER(^IBE(352.5,"AEFFDT",IBCODE,-IBY,0))
+7 IF 'IB1
DO BMES^XPDUTL("No Stop Code Entry found for "_IBCODE_" with an efective date of 10/01/07")
QUIT
+8 SET DIE="^IBE(352.5,"
SET DA=IB1
SET DR=".05///1"
DO ^DIE
KILL DA,DR,DIE
+9 DO BMES^XPDUTL(" "_IBCODE_" updated in file 352.5")
End DoDot:1
+10 QUIT
+11 ;
OCODE ;;code^billable type^description^override flag
+1 ;;695
+2 ;;696
+3 ;
+4 QUIT
