- 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 Jan 18, 2025@02:55:20 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