ECXTREX ;BPFO/JRP - Queue DSS Fiscal Year Specific Extract;8-AUG-2003 ;3/17/17 13:11
;;3.0;DSS EXTRACTS;**49,71,84,92,105,112,120,166,178**;Dec 22, 1997;Build 67
;
EN ;Main entry point
W @IOF
N DIC,X,Y,DTOUT,DUOUT
W !,"****************************************************************"
W !,"* *"
W !,"* Use this option with caution since it will allow you to *"
W !,"* run any supported DSS extract using specific fiscal year *"
W !,"* logic. By running this option you may negatively impact *"
W !,"* your extract data. *"
W !,"* *"
W !,"* DO NOT USE this option unless you are an official test site *"
W !,"* for the DSS Fiscal Year Conversion. *"
W !,"*--------------------------------------------------------------*"
W !,"* *"
W !,"* Note that this option does not update the last date used for *"
W !,"* the given extraction. It also does not verify that the time *"
W !,"* frame selected is after the last date used for the extract. *"
W !,"* *"
W !,"****************************************************************"
W !!
D PAUSE
;does user hold key?
;I '$$KCHK^XUSRB("ECX DSS TEST",$G(DUZ)) D Q
;.W !!,"You do not have approved access to this option.",!,"Exiting...",!!
;.D PAUSE
;is this a test site for DSS FY conversion patch?
;I '$$CHKTEST^ECXTREX() D Q
;.W !!,"This site is not a DSS Fiscal Year Conversion test site.",!,"Exiting...",!!
;.D PAUSE
N ECXTEST,ECXREL S ECXTEST=$$CHKTEST^ECXTREX()
;
;Pick extract to queue
S DIC="^ECX(727.1,"
S DIC(0)="AEQMZ"
S DIC("A")="Select DSS Extract to queue: "
S DIC("S")="I ('$P(^(0),U,12))&($P(^(0),U,8)'="""")&($G(^(7))'[""Inactive"")"
S DIC("W")="W ""("",$P(^(0),U,8),"")"""
D ^DIC
I ($D(DUOUT))!($D(DTOUT))!(Y<1) Q
N ECXRTN,ECXDA
S ECXDA=+Y
;Get extract specific routine name
S ECXRTN=$G(^ECX(727.1,ECXDA,"ROU"))
I ECXRTN="" D Q
.W !!,"Selected extract is not correctly defined in the EXTRACT"
.W !,"DEFINITIONS file (#727.1). The ROUTINE field (#4) does not"
.W !,"have a value in it."
.W !
.D PAUSE
;Get time frame for extract
N STRTDT,ENDDT,DIR,DIRUT,DIROUT,OUT,ECXDATES
S OUT=0 F S (STRTDT,ENDDT)="" D Q:OUT
.;Get start date (must be in past)
.S DIR(0)="DOA"
.S $P(DIR(0),"^",2)=":"_DT_":AEXP"
.S DIR("A")="Starting with Date: "
.D ^DIR
.I $D(DIROUT)!$D(DIRUT)!(Y="") S (STRTDT,ENDDT)="" S OUT=1 Q
.S STRTDT=Y
.K DIR
.;Get end date (must be in same month; must be in past)
.S DIR(0)="DOA"
.S X=$E(STRTDT,1,5)_"01"
.S X=$$FMADD^XLFDT(X,32)
.S X=$$FMADD^XLFDT(X,-($E(X,6,7)))
.I X>DT S X=DT
.S $P(DIR(0),"^",2)=STRTDT_":"_X_":AEXP"
.S DIR("A")="Ending with Date: "
.S DIR("B")=$$FMTE^XLFDT(X,"5D")
.D ^DIR
.I $D(DIROUT)!$D(DIRUT)!(Y="") S (STRTDT,ENDDT)="" S OUT=1 Q
.S ENDDT=Y
.S OUT=1
Q:(STRTDT="")!(ENDDT="")
S ECXDATES=STRTDT_"^"_ENDDT_"^1"
LOGIC ;Get extract logic to use
N ECXLOGIC,YEAR,ECXY,ECXFY,ECXREL
S ECXFY=$P($P(ECXTEST,"#",2),"FY",2)
S ECXREL=$P(ECXTEST,"#",3)
S YEAR=$E(DT)+17_$E(DT,2,3)
S X=$E(DT,1,3)_"1000" I DT>X D
. I (ECXREL)!($$KCHK^XUSRB("ECX DSS TEST",$G(DUZ))) S YEAR=YEAR+1
K DIR
S DIR("A")="Select fiscal year logic to use for extract"
S DIR(0)="SO^"
F X=YEAR:1:YEAR D ;178 Only allow current year and next year if user has ECX DSS TEST key
.S Y=$E(X,5)
.S Y=$S((Y="")!(Y=" "):"",1:"Revision "_Y_" of ")
.S DIR(0)=DIR(0)_X_":"_Y_"Fiscal Year "_$E(X,1,4)_";"
I $$KCHK^XUSRB("ECX DSS TEST",$G(DUZ)) D
.S X=$E(DT,1,3)_"1000" I DT'>X S X=YEAR+1 D
..S Y=$E(X,5)
..S Y=$S((Y="")!(Y=" "):"",1:"Revision "_Y_" of ")
..S DIR(0)=DIR(0)_X_":"_Y_"Fiscal Year "_$E(X,1,4)_";"
D ^DIR
I $D(DIROUT)!$D(DIRUT) Q
S ECXLOGIC=Y
N ECXERR S ECXERR=0
I ECXLOGIC>YEAR D
. I ECXREL Q
. S ECXERR=1
I ECXLOGIC=YEAR D
. I YEAR'=ECXFY Q
. I ECXREL Q
. S ECXERR=1
I ECXERR S ECXERR=0 D I ECXERR Q
. S DIR(0)="Y" W !
. S DIR("A",1)="WARNING: Logic has not been released for this year. Do not use unless directed"
. S DIR("A")="by MCAO. Do you want to continue",DIR("B")="YES" D ^DIR
. S:$G(DIRUT) ECXERR=1 S:Y=0 ECXERR=1
;Queue extract
D @("BEG^"_ECXRTN)
Q
PAUSE ;pause screen
N DIR,X,Y
S DIR(0)="E"
W !!
D ^DIR
W !!
Q
;
CHKTEST() ;check/set release version
; input none
N ECXY,ECXNM,ECXDT,FDA,JJ,LINE,RESULT,XX
;get patch name from field #73
S ECXY=$$GET1^DIQ(728,"1,",73) I ECXY="" Q ""
S ECXNM=$P(ECXY,"#"),ECXFY=$P(ECXY,"#",2),ECXSQ=$P(ECXY,"#",3)
;if Kernel function not on system, allow access by default
S LINE="INSTALDT^XPDUTL",JJ=$T(@LINE) I JJ="" Q ""
;quit if patch never installed
S JJ=$$INSTALDT^XPDUTL(ECXNM,.RESULT) I 'JJ Q ""
;get status of last patch of that name installed here
S ECXDT=$O(RESULT(""),-1) I 'ECXDT Q ""
S XX=RESULT(ECXDT)
;if last version is national, set field #73,
I $P(XX,U,2) S ECXSQ=$P(XX,U,2)
D TESTON(ECXNM,ECXFY,ECXSQ)
Q $$GET1^DIQ(728,"1,",73)
;INSTALDT^XPDUTL doesn't work for host file
;
TESTON(XPDNM,ECXFY,ECXSQ) ;sets field #73 of file #728
; input XPDNM - variable defined by KIDS; name of patch
; ECXFY - variable defined for patch fiscal year extract
; ECXSQ - variable defined for patch release sequence # (optional)
; output none
; called only by post-install routine of DSS FY Conversion patch
; if patch is TEST version
N ECXNM,FDA
S ECXNM=$G(XPDNM)
S ECXFY=$G(ECXFY)
S ECXSQ=$G(ECXSQ)
Q:(ECXNM="")
Q:(ECXFY="")
;update field #73 of file #728
S FDA(728,"1,",73)=ECXNM_"#"_ECXFY_"#"_ECXSQ
D FILE^DIE("","FDA")
;if released version & not a field office, then, kill testing key
I ($G(ECXSQ)'=""),'$$FODMN^ECXTRANS() D
.N ECXSKEY
.S ECXSKEY=$$LKUP^XPDKEY("ECX DSS TEST") Q:'ECXSKEY
.D DEL^XPDKEY(+$G(ECXSKEY))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXTREX 6092 printed Dec 13, 2024@01:54:07 Page 2
ECXTREX ;BPFO/JRP - Queue DSS Fiscal Year Specific Extract;8-AUG-2003 ;3/17/17 13:11
+1 ;;3.0;DSS EXTRACTS;**49,71,84,92,105,112,120,166,178**;Dec 22, 1997;Build 67
+2 ;
EN ;Main entry point
+1 WRITE @IOF
+2 NEW DIC,X,Y,DTOUT,DUOUT
+3 WRITE !,"****************************************************************"
+4 WRITE !,"* *"
+5 WRITE !,"* Use this option with caution since it will allow you to *"
+6 WRITE !,"* run any supported DSS extract using specific fiscal year *"
+7 WRITE !,"* logic. By running this option you may negatively impact *"
+8 WRITE !,"* your extract data. *"
+9 WRITE !,"* *"
+10 WRITE !,"* DO NOT USE this option unless you are an official test site *"
+11 WRITE !,"* for the DSS Fiscal Year Conversion. *"
+12 WRITE !,"*--------------------------------------------------------------*"
+13 WRITE !,"* *"
+14 WRITE !,"* Note that this option does not update the last date used for *"
+15 WRITE !,"* the given extraction. It also does not verify that the time *"
+16 WRITE !,"* frame selected is after the last date used for the extract. *"
+17 WRITE !,"* *"
+18 WRITE !,"****************************************************************"
+19 WRITE !!
+20 DO PAUSE
+21 ;does user hold key?
+22 ;I '$$KCHK^XUSRB("ECX DSS TEST",$G(DUZ)) D Q
+23 ;.W !!,"You do not have approved access to this option.",!,"Exiting...",!!
+24 ;.D PAUSE
+25 ;is this a test site for DSS FY conversion patch?
+26 ;I '$$CHKTEST^ECXTREX() D Q
+27 ;.W !!,"This site is not a DSS Fiscal Year Conversion test site.",!,"Exiting...",!!
+28 ;.D PAUSE
+29 NEW ECXTEST,ECXREL
SET ECXTEST=$$CHKTEST^ECXTREX()
+30 ;
+31 ;Pick extract to queue
+32 SET DIC="^ECX(727.1,"
+33 SET DIC(0)="AEQMZ"
+34 SET DIC("A")="Select DSS Extract to queue: "
+35 SET DIC("S")="I ('$P(^(0),U,12))&($P(^(0),U,8)'="""")&($G(^(7))'[""Inactive"")"
+36 SET DIC("W")="W ""("",$P(^(0),U,8),"")"""
+37 DO ^DIC
+38 IF ($DATA(DUOUT))!($DATA(DTOUT))!(Y<1)
QUIT
+39 NEW ECXRTN,ECXDA
+40 SET ECXDA=+Y
+41 ;Get extract specific routine name
+42 SET ECXRTN=$GET(^ECX(727.1,ECXDA,"ROU"))
+43 IF ECXRTN=""
Begin DoDot:1
+44 WRITE !!,"Selected extract is not correctly defined in the EXTRACT"
+45 WRITE !,"DEFINITIONS file (#727.1). The ROUTINE field (#4) does not"
+46 WRITE !,"have a value in it."
+47 WRITE !
+48 DO PAUSE
End DoDot:1
QUIT
+49 ;Get time frame for extract
+50 NEW STRTDT,ENDDT,DIR,DIRUT,DIROUT,OUT,ECXDATES
+51 SET OUT=0
FOR
SET (STRTDT,ENDDT)=""
Begin DoDot:1
+52 ;Get start date (must be in past)
+53 SET DIR(0)="DOA"
+54 SET $PIECE(DIR(0),"^",2)=":"_DT_":AEXP"
+55 SET DIR("A")="Starting with Date: "
+56 DO ^DIR
+57 IF $DATA(DIROUT)!$DATA(DIRUT)!(Y="")
SET (STRTDT,ENDDT)=""
SET OUT=1
QUIT
+58 SET STRTDT=Y
+59 KILL DIR
+60 ;Get end date (must be in same month; must be in past)
+61 SET DIR(0)="DOA"
+62 SET X=$EXTRACT(STRTDT,1,5)_"01"
+63 SET X=$$FMADD^XLFDT(X,32)
+64 SET X=$$FMADD^XLFDT(X,-($EXTRACT(X,6,7)))
+65 IF X>DT
SET X=DT
+66 SET $PIECE(DIR(0),"^",2)=STRTDT_":"_X_":AEXP"
+67 SET DIR("A")="Ending with Date: "
+68 SET DIR("B")=$$FMTE^XLFDT(X,"5D")
+69 DO ^DIR
+70 IF $DATA(DIROUT)!$DATA(DIRUT)!(Y="")
SET (STRTDT,ENDDT)=""
SET OUT=1
QUIT
+71 SET ENDDT=Y
+72 SET OUT=1
End DoDot:1
if OUT
QUIT
+73 if (STRTDT="")!(ENDDT="")
QUIT
+74 SET ECXDATES=STRTDT_"^"_ENDDT_"^1"
LOGIC ;Get extract logic to use
+1 NEW ECXLOGIC,YEAR,ECXY,ECXFY,ECXREL
+2 SET ECXFY=$PIECE($PIECE(ECXTEST,"#",2),"FY",2)
+3 SET ECXREL=$PIECE(ECXTEST,"#",3)
+4 SET YEAR=$EXTRACT(DT)+17_$EXTRACT(DT,2,3)
+5 SET X=$EXTRACT(DT,1,3)_"1000"
IF DT>X
Begin DoDot:1
+6 IF (ECXREL)!($$KCHK^XUSRB("ECX DSS TEST",$GET(DUZ)))
SET YEAR=YEAR+1
End DoDot:1
+7 KILL DIR
+8 SET DIR("A")="Select fiscal year logic to use for extract"
+9 SET DIR(0)="SO^"
+10 ;178 Only allow current year and next year if user has ECX DSS TEST key
FOR X=YEAR:1:YEAR
Begin DoDot:1
+11 SET Y=$EXTRACT(X,5)
+12 SET Y=$SELECT((Y="")!(Y=" "):"",1:"Revision "_Y_" of ")
+13 SET DIR(0)=DIR(0)_X_":"_Y_"Fiscal Year "_$EXTRACT(X,1,4)_";"
End DoDot:1
+14 IF $$KCHK^XUSRB("ECX DSS TEST",$GET(DUZ))
Begin DoDot:1
+15 SET X=$EXTRACT(DT,1,3)_"1000"
IF DT'>X
SET X=YEAR+1
Begin DoDot:2
+16 SET Y=$EXTRACT(X,5)
+17 SET Y=$SELECT((Y="")!(Y=" "):"",1:"Revision "_Y_" of ")
+18 SET DIR(0)=DIR(0)_X_":"_Y_"Fiscal Year "_$EXTRACT(X,1,4)_";"
End DoDot:2
End DoDot:1
+19 DO ^DIR
+20 IF $DATA(DIROUT)!$DATA(DIRUT)
QUIT
+21 SET ECXLOGIC=Y
+22 NEW ECXERR
SET ECXERR=0
+23 IF ECXLOGIC>YEAR
Begin DoDot:1
+24 IF ECXREL
QUIT
+25 SET ECXERR=1
End DoDot:1
+26 IF ECXLOGIC=YEAR
Begin DoDot:1
+27 IF YEAR'=ECXFY
QUIT
+28 IF ECXREL
QUIT
+29 SET ECXERR=1
End DoDot:1
+30 IF ECXERR
SET ECXERR=0
Begin DoDot:1
+31 SET DIR(0)="Y"
WRITE !
+32 SET DIR("A",1)="WARNING: Logic has not been released for this year. Do not use unless directed"
+33 SET DIR("A")="by MCAO. Do you want to continue"
SET DIR("B")="YES"
DO ^DIR
+34 if $GET(DIRUT)
SET ECXERR=1
if Y=0
SET ECXERR=1
End DoDot:1
IF ECXERR
QUIT
+35 ;Queue extract
+36 DO @("BEG^"_ECXRTN)
+37 QUIT
PAUSE ;pause screen
+1 NEW DIR,X,Y
+2 SET DIR(0)="E"
+3 WRITE !!
+4 DO ^DIR
+5 WRITE !!
+6 QUIT
+7 ;
CHKTEST() ;check/set release version
+1 ; input none
+2 NEW ECXY,ECXNM,ECXDT,FDA,JJ,LINE,RESULT,XX
+3 ;get patch name from field #73
+4 SET ECXY=$$GET1^DIQ(728,"1,",73)
IF ECXY=""
QUIT ""
+5 SET ECXNM=$PIECE(ECXY,"#")
SET ECXFY=$PIECE(ECXY,"#",2)
SET ECXSQ=$PIECE(ECXY,"#",3)
+6 ;if Kernel function not on system, allow access by default
+7 SET LINE="INSTALDT^XPDUTL"
SET JJ=$TEXT(@LINE)
IF JJ=""
QUIT ""
+8 ;quit if patch never installed
+9 SET JJ=$$INSTALDT^XPDUTL(ECXNM,.RESULT)
IF 'JJ
QUIT ""
+10 ;get status of last patch of that name installed here
+11 SET ECXDT=$ORDER(RESULT(""),-1)
IF 'ECXDT
QUIT ""
+12 SET XX=RESULT(ECXDT)
+13 ;if last version is national, set field #73,
+14 IF $PIECE(XX,U,2)
SET ECXSQ=$PIECE(XX,U,2)
+15 DO TESTON(ECXNM,ECXFY,ECXSQ)
+16 QUIT $$GET1^DIQ(728,"1,",73)
+17 ;INSTALDT^XPDUTL doesn't work for host file
+18 ;
TESTON(XPDNM,ECXFY,ECXSQ) ;sets field #73 of file #728
+1 ; input XPDNM - variable defined by KIDS; name of patch
+2 ; ECXFY - variable defined for patch fiscal year extract
+3 ; ECXSQ - variable defined for patch release sequence # (optional)
+4 ; output none
+5 ; called only by post-install routine of DSS FY Conversion patch
+6 ; if patch is TEST version
+7 NEW ECXNM,FDA
+8 SET ECXNM=$GET(XPDNM)
+9 SET ECXFY=$GET(ECXFY)
+10 SET ECXSQ=$GET(ECXSQ)
+11 if (ECXNM="")
QUIT
+12 if (ECXFY="")
QUIT
+13 ;update field #73 of file #728
+14 SET FDA(728,"1,",73)=ECXNM_"#"_ECXFY_"#"_ECXSQ
+15 DO FILE^DIE("","FDA")
+16 ;if released version & not a field office, then, kill testing key
+17 IF ($GET(ECXSQ)'="")
IF '$$FODMN^ECXTRANS()
Begin DoDot:1
+18 NEW ECXSKEY
+19 SET ECXSKEY=$$LKUP^XPDKEY("ECX DSS TEST")
if 'ECXSKEY
QUIT
+20 DO DEL^XPDKEY(+$GET(ECXSKEY))
End DoDot:1
+21 QUIT
