Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXTREX

ECXTREX.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN ;Main entry point
  1. W @IOF
  1. N DIC,X,Y,DTOUT,DUOUT
  1. W !,"****************************************************************"
  1. W !,"* *"
  1. W !,"* Use this option with caution since it will allow you to *"
  1. W !,"* run any supported DSS extract using specific fiscal year *"
  1. W !,"* logic. By running this option you may negatively impact *"
  1. W !,"* your extract data. *"
  1. W !,"* *"
  1. W !,"* DO NOT USE this option unless you are an official test site *"
  1. W !,"* for the DSS Fiscal Year Conversion. *"
  1. W !,"*--------------------------------------------------------------*"
  1. W !,"* *"
  1. W !,"* Note that this option does not update the last date used for *"
  1. W !,"* the given extraction. It also does not verify that the time *"
  1. W !,"* frame selected is after the last date used for the extract. *"
  1. W !,"* *"
  1. W !,"****************************************************************"
  1. W !!
  1. D PAUSE
  1. ;does user hold key?
  1. ;I '$$KCHK^XUSRB("ECX DSS TEST",$G(DUZ)) D Q
  1. ;.W !!,"You do not have approved access to this option.",!,"Exiting...",!!
  1. ;.D PAUSE
  1. ;is this a test site for DSS FY conversion patch?
  1. ;I '$$CHKTEST^ECXTREX() D Q
  1. ;.W !!,"This site is not a DSS Fiscal Year Conversion test site.",!,"Exiting...",!!
  1. ;.D PAUSE
  1. N ECXTEST,ECXREL S ECXTEST=$$CHKTEST^ECXTREX()
  1. ;
  1. ;Pick extract to queue
  1. S DIC="^ECX(727.1,"
  1. S DIC(0)="AEQMZ"
  1. S DIC("A")="Select DSS Extract to queue: "
  1. S DIC("S")="I ('$P(^(0),U,12))&($P(^(0),U,8)'="""")&($G(^(7))'[""Inactive"")"
  1. S DIC("W")="W ""("",$P(^(0),U,8),"")"""
  1. D ^DIC
  1. I ($D(DUOUT))!($D(DTOUT))!(Y<1) Q
  1. N ECXRTN,ECXDA
  1. S ECXDA=+Y
  1. ;Get extract specific routine name
  1. S ECXRTN=$G(^ECX(727.1,ECXDA,"ROU"))
  1. I ECXRTN="" D Q
  1. .W !!,"Selected extract is not correctly defined in the EXTRACT"
  1. .W !,"DEFINITIONS file (#727.1). The ROUTINE field (#4) does not"
  1. .W !,"have a value in it."
  1. .W !
  1. .D PAUSE
  1. ;Get time frame for extract
  1. N STRTDT,ENDDT,DIR,DIRUT,DIROUT,OUT,ECXDATES
  1. S OUT=0 F S (STRTDT,ENDDT)="" D Q:OUT
  1. .;Get start date (must be in past)
  1. .S DIR(0)="DOA"
  1. .S $P(DIR(0),"^",2)=":"_DT_":AEXP"
  1. .S DIR("A")="Starting with Date: "
  1. .D ^DIR
  1. .I $D(DIROUT)!$D(DIRUT)!(Y="") S (STRTDT,ENDDT)="" S OUT=1 Q
  1. .S STRTDT=Y
  1. .K DIR
  1. .;Get end date (must be in same month; must be in past)
  1. .S DIR(0)="DOA"
  1. .S X=$E(STRTDT,1,5)_"01"
  1. .S X=$$FMADD^XLFDT(X,32)
  1. .S X=$$FMADD^XLFDT(X,-($E(X,6,7)))
  1. .I X>DT S X=DT
  1. .S $P(DIR(0),"^",2)=STRTDT_":"_X_":AEXP"
  1. .S DIR("A")="Ending with Date: "
  1. .S DIR("B")=$$FMTE^XLFDT(X,"5D")
  1. .D ^DIR
  1. .I $D(DIROUT)!$D(DIRUT)!(Y="") S (STRTDT,ENDDT)="" S OUT=1 Q
  1. .S ENDDT=Y
  1. .S OUT=1
  1. Q:(STRTDT="")!(ENDDT="")
  1. S ECXDATES=STRTDT_"^"_ENDDT_"^1"
  1. LOGIC ;Get extract logic to use
  1. N ECXLOGIC,YEAR,ECXY,ECXFY,ECXREL
  1. S ECXFY=$P($P(ECXTEST,"#",2),"FY",2)
  1. S ECXREL=$P(ECXTEST,"#",3)
  1. S YEAR=$E(DT)+17_$E(DT,2,3)
  1. S X=$E(DT,1,3)_"1000" I DT>X D
  1. . I (ECXREL)!($$KCHK^XUSRB("ECX DSS TEST",$G(DUZ))) S YEAR=YEAR+1
  1. K DIR
  1. S DIR("A")="Select fiscal year logic to use for extract"
  1. S DIR(0)="SO^"
  1. F X=YEAR:1:YEAR D ;178 Only allow current year and next year if user has ECX DSS TEST key
  1. .S Y=$E(X,5)
  1. .S Y=$S((Y="")!(Y=" "):"",1:"Revision "_Y_" of ")
  1. .S DIR(0)=DIR(0)_X_":"_Y_"Fiscal Year "_$E(X,1,4)_";"
  1. I $$KCHK^XUSRB("ECX DSS TEST",$G(DUZ)) D
  1. .S X=$E(DT,1,3)_"1000" I DT'>X S X=YEAR+1 D
  1. ..S Y=$E(X,5)
  1. ..S Y=$S((Y="")!(Y=" "):"",1:"Revision "_Y_" of ")
  1. ..S DIR(0)=DIR(0)_X_":"_Y_"Fiscal Year "_$E(X,1,4)_";"
  1. D ^DIR
  1. I $D(DIROUT)!$D(DIRUT) Q
  1. S ECXLOGIC=Y
  1. N ECXERR S ECXERR=0
  1. I ECXLOGIC>YEAR D
  1. . I ECXREL Q
  1. . S ECXERR=1
  1. I ECXLOGIC=YEAR D
  1. . I YEAR'=ECXFY Q
  1. . I ECXREL Q
  1. . S ECXERR=1
  1. I ECXERR S ECXERR=0 D I ECXERR Q
  1. . S DIR(0)="Y" W !
  1. . S DIR("A",1)="WARNING: Logic has not been released for this year. Do not use unless directed"
  1. . S DIR("A")="by MCAO. Do you want to continue",DIR("B")="YES" D ^DIR
  1. . S:$G(DIRUT) ECXERR=1 S:Y=0 ECXERR=1
  1. ;Queue extract
  1. D @("BEG^"_ECXRTN)
  1. Q
  1. PAUSE ;pause screen
  1. N DIR,X,Y
  1. S DIR(0)="E"
  1. W !!
  1. D ^DIR
  1. W !!
  1. Q
  1. ;
  1. CHKTEST() ;check/set release version
  1. ; input none
  1. N ECXY,ECXNM,ECXDT,FDA,JJ,LINE,RESULT,XX
  1. ;get patch name from field #73
  1. S ECXY=$$GET1^DIQ(728,"1,",73) I ECXY="" Q ""
  1. S ECXNM=$P(ECXY,"#"),ECXFY=$P(ECXY,"#",2),ECXSQ=$P(ECXY,"#",3)
  1. ;if Kernel function not on system, allow access by default
  1. S LINE="INSTALDT^XPDUTL",JJ=$T(@LINE) I JJ="" Q ""
  1. ;quit if patch never installed
  1. S JJ=$$INSTALDT^XPDUTL(ECXNM,.RESULT) I 'JJ Q ""
  1. ;get status of last patch of that name installed here
  1. S ECXDT=$O(RESULT(""),-1) I 'ECXDT Q ""
  1. S XX=RESULT(ECXDT)
  1. ;if last version is national, set field #73,
  1. I $P(XX,U,2) S ECXSQ=$P(XX,U,2)
  1. D TESTON(ECXNM,ECXFY,ECXSQ)
  1. Q $$GET1^DIQ(728,"1,",73)
  1. ;INSTALDT^XPDUTL doesn't work for host file
  1. ;
  1. TESTON(XPDNM,ECXFY,ECXSQ) ;sets field #73 of file #728
  1. ; input XPDNM - variable defined by KIDS; name of patch
  1. ; ECXFY - variable defined for patch fiscal year extract
  1. ; ECXSQ - variable defined for patch release sequence # (optional)
  1. ; output none
  1. ; called only by post-install routine of DSS FY Conversion patch
  1. ; if patch is TEST version
  1. N ECXNM,FDA
  1. S ECXNM=$G(XPDNM)
  1. S ECXFY=$G(ECXFY)
  1. S ECXSQ=$G(ECXSQ)
  1. Q:(ECXNM="")
  1. Q:(ECXFY="")
  1. ;update field #73 of file #728
  1. S FDA(728,"1,",73)=ECXNM_"#"_ECXFY_"#"_ECXSQ
  1. D FILE^DIE("","FDA")
  1. ;if released version & not a field office, then, kill testing key
  1. I ($G(ECXSQ)'=""),'$$FODMN^ECXTRANS() D
  1. .N ECXSKEY
  1. .S ECXSKEY=$$LKUP^XPDKEY("ECX DSS TEST") Q:'ECXSKEY
  1. .D DEL^XPDKEY(+$G(ECXSKEY))
  1. Q