AZAX3PBF ;IHS/PHXAO/AEF - FIX COVERED DAYS FIELD IN 3P BILL BATCHES
;;1.0;ANNE'S SPECIAL ROUTINES;;JULY 14, 2004
;;
;;DELETE THIS ROUTINE... THIS CODE HAS BEEN MOVED TO ^AZAXFCD
;
EN ;EP -- MAIN ENTRY POINT
;
N EXPDT,OUT,QUIT
;
D ^XBKVAR
D HOME^%ZIS
;
F D Q:QUIT
. D EXP(.EXPDT,.OUT,.QUIT)
. Q:QUIT
. Q:OUT
. ;
. D PROC(EXPDT)
;
Q
PROC(EXPDT) ;
;----- PROCESS ENTRIES
;
N BILL,CD,CNT,D1,NOW
;
Q:'EXPDT
;
S CNT=0
S NOW=$$NOW
;
W !!,"PROCESSING BATCH #",EXPDT," ",$$EXTDT($P($G(^ABMDTXST(DUZ(2),EXPDT,0)),U)),"..."
;
S D1=0
F S D1=$O(^ABMDTXST(DUZ(2),EXPDT,2,D1)) Q:'D1 D
. S CNT=$G(CNT)+1
. I '(CNT#10) W "."
. S BILL=$P($G(^ABMDTXST(DUZ(2),EXPDT,2,D1,0)),U)
. Q:'BILL
. S CD=$P($G(^ABMDBILL(DUZ(2),BILL,7)),U,3)
. D ARCH(NOW,EXPDT,BILL,CD)
. D ONE(BILL)
;
W !,CNT," BILLS PROCESSED"
Q
ONE(DA) ;
;----- EDIT ONE BILL
;
N DIE,DR,X,Y
;
S DIE="^ABMDBILL("_DUZ(2)_","
S DR=".73///^S X=""@"""
D ^DIE
Q
EXP(EXPDT,OUT,QUIT) ;
;----- SELECT EXPORT DATE FROM 3P TX STATUS FILE
;
N DA,DIC,DIQ,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
;
S OUT=0
S QUIT=0
;
W !
S DIC="^ABMDTXST("_DUZ(2)_","
S DIC(0)="AEQM"
D ^DIC
I $D(DTOUT)!($D(DUOUT))!(+Y'>0) S QUIT=1
Q:QUIT
;
W !
S DA=+Y
S DR="0:1"
S DIQ(0)="R"
D EN^DIQ
;
W !
S DIR("A",1)="WARNING! This option will delete the COVERED DAYS from all bills"
S DIR("A",2)="contained in this batch."
S DIR("A",3)=""
S DIR("A")="Do you REALLY want to delete the COVERED DAYS from this batch"
S DIR("B")="NO"
S DIR(0)="Y"
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(+Y'>0) S OUT=1
Q:OUT
;
S EXPDT=DA
Q
ARCH(NOW,EXPDT,BILL,CD) ;
;----- PUT AN ENTRY INTO THE ^AZAX3PBF GLOBAL FOR EACH 'COVERED DAYS'
; FIELD THAT IS CHANGED BY THIS ROUTINE. USED AS AN AUDIT TRAIL.
; THIS GLOBAL CAN BE DELETED AFTER A WHILE.
;
; GLOBAL STRUCTURE IS:
; ^AZAX3PBF(DUZ(2),NOW,EXPORT_IEN,BILL_IEN)=COVERED_DAYS_OLD_VALUE^DUZ
;
; INPUT:
; NOW = DATE/TIME THE CHANGE WAS MADE
; EXPDT = EXPORT DATE IEN FROM 3P TX STATUS FILE
; BILL = BILL IEN FROM 3P TX STATUS FILE
; CD = COVERED DAYS FROM 3P BILL FILE
;
I '$D(^AZAX3PBF(0)) D
. S ^AZAX3PBF(0)="RECORD OF 3P BILL FILE ENTRIES WHOSE COVERED DAYS FIELD HAS BEEN CHANGED BY AZAX3PBF ROUTINE. "
. S ^AZAX3PBF(0)=^AZAX3PBF(0)_" THIS GLOBAL CAN BE DELETED AFTER A WHILE."
;
S ^AZAX3PBF(DUZ(2),NOW,EXPDT,BILL)=CD_U_DUZ
Q
EXTDT(Y) ;
;----- RETURNS EXTERNAL DATE
;
X ^DD("DD")
Q Y
NOW() ;
;----- RETURNS CURRENT DATE/TIME IN INTERNAL FM FORMAT CYYMMDD.HHMMSS
;
N %,%I,X
D NOW^%DTC
Q %
AZAX3PBF ;IHS/PHXAO/AEF - FIX COVERED DAYS FIELD IN 3P BILL BATCHES
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;JULY 14, 2004
+2 ;;
+3 ;;DELETE THIS ROUTINE... THIS CODE HAS BEEN MOVED TO ^AZAXFCD
+4 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW EXPDT,OUT,QUIT
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 FOR
Begin DoDot:1
+8 DO EXP(.EXPDT,.OUT,.QUIT)
+9 IF QUIT
QUIT
+10 IF OUT
QUIT
+11 ;
+12 DO PROC(EXPDT)
End DoDot:1
IF QUIT
QUIT
+13 ;
+14 QUIT
PROC(EXPDT) ;
+1 ;----- PROCESS ENTRIES
+2 ;
+3 NEW BILL,CD,CNT,D1,NOW
+4 ;
+5 IF 'EXPDT
QUIT
+6 ;
+7 SET CNT=0
+8 SET NOW=$$NOW
+9 ;
+10 WRITE !!,"PROCESSING BATCH #",EXPDT," ",$$EXTDT($PIECE($GET(^ABMDTXST(DUZ(2),EXPDT,0)),U)),"..."
+11 ;
+12 SET D1=0
+13 FOR
SET D1=$ORDER(^ABMDTXST(DUZ(2),EXPDT,2,D1))
IF 'D1
QUIT
Begin DoDot:1
+14 SET CNT=$GET(CNT)+1
+15 IF '(CNT#10)
WRITE "."
+16 SET BILL=$PIECE($GET(^ABMDTXST(DUZ(2),EXPDT,2,D1,0)),U)
+17 IF 'BILL
QUIT
+18 SET CD=$PIECE($GET(^ABMDBILL(DUZ(2),BILL,7)),U,3)
+19 DO ARCH(NOW,EXPDT,BILL,CD)
+20 DO ONE(BILL)
End DoDot:1
+21 ;
+22 WRITE !,CNT," BILLS PROCESSED"
+23 QUIT
ONE(DA) ;
+1 ;----- EDIT ONE BILL
+2 ;
+3 NEW DIE,DR,X,Y
+4 ;
+5 SET DIE="^ABMDBILL("_DUZ(2)_","
+6 SET DR=".73///^S X=""@"""
+7 DO ^DIE
+8 QUIT
EXP(EXPDT,OUT,QUIT) ;
+1 ;----- SELECT EXPORT DATE FROM 3P TX STATUS FILE
+2 ;
+3 NEW DA,DIC,DIQ,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
+4 ;
+5 SET OUT=0
+6 SET QUIT=0
+7 ;
+8 WRITE !
+9 SET DIC="^ABMDTXST("_DUZ(2)_","
+10 SET DIC(0)="AEQM"
+11 DO ^DIC
+12 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y'>0)
SET QUIT=1
+13 IF QUIT
QUIT
+14 ;
+15 WRITE !
+16 SET DA=+Y
+17 SET DR="0:1"
+18 SET DIQ(0)="R"
+19 DO EN^DIQ
+20 ;
+21 WRITE !
+22 SET DIR("A",1)="WARNING! This option will delete the COVERED DAYS from all bills"
+23 SET DIR("A",2)="contained in this batch."
+24 SET DIR("A",3)=""
+25 SET DIR("A")="Do you REALLY want to delete the COVERED DAYS from this batch"
+26 SET DIR("B")="NO"
+27 SET DIR(0)="Y"
+28 DO ^DIR
+29 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))!(+Y'>0)
SET OUT=1
+30 IF OUT
QUIT
+31 ;
+32 SET EXPDT=DA
+33 QUIT
ARCH(NOW,EXPDT,BILL,CD) ;
+1 ;----- PUT AN ENTRY INTO THE ^AZAX3PBF GLOBAL FOR EACH 'COVERED DAYS'
+2 ; FIELD THAT IS CHANGED BY THIS ROUTINE. USED AS AN AUDIT TRAIL.
+3 ; THIS GLOBAL CAN BE DELETED AFTER A WHILE.
+4 ;
+5 ; GLOBAL STRUCTURE IS:
+6 ; ^AZAX3PBF(DUZ(2),NOW,EXPORT_IEN,BILL_IEN)=COVERED_DAYS_OLD_VALUE^DUZ
+7 ;
+8 ; INPUT:
+9 ; NOW = DATE/TIME THE CHANGE WAS MADE
+10 ; EXPDT = EXPORT DATE IEN FROM 3P TX STATUS FILE
+11 ; BILL = BILL IEN FROM 3P TX STATUS FILE
+12 ; CD = COVERED DAYS FROM 3P BILL FILE
+13 ;
+14 IF '$DATA(^AZAX3PBF(0))
Begin DoDot:1
+15 SET ^AZAX3PBF(0)="RECORD OF 3P BILL FILE ENTRIES WHOSE COVERED DAYS FIELD HAS BEEN CHANGED BY AZAX3PBF ROUTINE. "
+16 SET ^AZAX3PBF(0)=^AZAX3PBF(0)_" THIS GLOBAL CAN BE DELETED AFTER A WHILE."
End DoDot:1
+17 ;
+18 SET ^AZAX3PBF(DUZ(2),NOW,EXPDT,BILL)=CD_U_DUZ
+19 QUIT
EXTDT(Y) ;
+1 ;----- RETURNS EXTERNAL DATE
+2 ;
+3 XECUTE ^DD("DD")
+4 QUIT Y
NOW() ;
+1 ;----- RETURNS CURRENT DATE/TIME IN INTERNAL FM FORMAT CYYMMDD.HHMMSS
+2 ;
+3 NEW %,%I,X
+4 DO NOW^%DTC
+5 QUIT %
+6 +7
***** ERRORS & WARNINGS IN AZAX3PBF *****
NOW+6 W - Null line (no commands or comment).
NOW+7 W - Null line (no commands or comment).