IBY254PO ;ALB/TMK - IB*2*254 POST-INSTALL ;21-NOV-2003
;;2.0;INTEGRATED BILLING;**254**;21-MAR-94
;
EN N X,Y,DIC,DIE,DR,DA,DO,DD,DINUM,IBDT
I '$D(^IBE(351.71,"3031000",0)) D BMES^XPDUTL("NO DIAGNOSTIC MEASURE REPORTS FOUND FOR OCT 2003.") G END
I $P($G(^IBE(351.71,3031000,0)),U,2)=3 D BMES^XPDUTL("DIAGNOSTIC MEASURES DATA ALREADY SENT FOR OCT 2003.") G END
D BMES^XPDUTL("Setting status of UNBILLED REPORT for OCT 2003 to complete.")
S DA(1)="3031000",DA=37
I '$D(^IBE(351.71,DA(1),1,37,0)) D
. K DO,DD
. S DINUM=37,DIC="^IBE(351.71,"_DA(1)_",1,",X=37,DIC(0)="L" D FILE^DICN K DO,DD,DIC
S DIE="^IBE(351.71,"_DA(1)_",1,",DR=".02////3" D ^DIE
D BMES^XPDUTL("Step complete.")
D BMES^XPDUTL("Transmitting diagnostic measure reports for OCT 2003.")
S IBDT=3031000 I '$$CHK^IBJDE(IBDT) D COMP^IBJDE
D BMES^XPDUTL("Step complete.")
END D BMES^XPDUTL("Post-install complete.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY254PO 910 printed Nov 22, 2024@17:43:35 Page 2
IBY254PO ;ALB/TMK - IB*2*254 POST-INSTALL ;21-NOV-2003
+1 ;;2.0;INTEGRATED BILLING;**254**;21-MAR-94
+2 ;
EN NEW X,Y,DIC,DIE,DR,DA,DO,DD,DINUM,IBDT
+1 IF '$DATA(^IBE(351.71,"3031000",0))
DO BMES^XPDUTL("NO DIAGNOSTIC MEASURE REPORTS FOUND FOR OCT 2003.")
GOTO END
+2 IF $PIECE($GET(^IBE(351.71,3031000,0)),U,2)=3
DO BMES^XPDUTL("DIAGNOSTIC MEASURES DATA ALREADY SENT FOR OCT 2003.")
GOTO END
+3 DO BMES^XPDUTL("Setting status of UNBILLED REPORT for OCT 2003 to complete.")
+4 SET DA(1)="3031000"
SET DA=37
+5 IF '$DATA(^IBE(351.71,DA(1),1,37,0))
Begin DoDot:1
+6 KILL DO,DD
+7 SET DINUM=37
SET DIC="^IBE(351.71,"_DA(1)_",1,"
SET X=37
SET DIC(0)="L"
DO FILE^DICN
KILL DO,DD,DIC
End DoDot:1
+8 SET DIE="^IBE(351.71,"_DA(1)_",1,"
SET DR=".02////3"
DO ^DIE
+9 DO BMES^XPDUTL("Step complete.")
+10 DO BMES^XPDUTL("Transmitting diagnostic measure reports for OCT 2003.")
+11 SET IBDT=3031000
IF '$$CHK^IBJDE(IBDT)
DO COMP^IBJDE
+12 DO BMES^XPDUTL("Step complete.")
END DO BMES^XPDUTL("Post-install complete.")
+1 QUIT
+2 ;
