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

PXRMETH.m

Go to the documentation of this file. 
  1. PXRMETH ; SLC/PJH - Reminder Extract History ;04/15/2014
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
  1.  ;
  1.  ;Main entry point for PXRM EXTRACT HISTORY
  1. START(EDIEN) ;
  1.  ;EDIEN is the extract definition IEN.
  1.  N VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
  1.  ;Details of last run
  1.  N DATA,NPERIOD,NSDATE,NTAS,PXRMVIEW
  1.  S DATA=$G(^PXRM(810.2,EDIEN,0))
  1.  S NPERIOD=$P(DATA,U,6),NSDATE=$P(DATA,U,7)
  1.  ;Default view is in date created order
  1.  S PXRMVIEW="D"
  1.  S X="IORESET"
  1.  D ENDR^%ZISS
  1.  S VALMCNT=0
  1.  D EN^VALM("PXRM EXTRACT HISTORY")
  1.  Q
  1.  ;
  1. DELETE ;Delete an extract, called by protocol PXRM EXTRACT SUMMARY DELETE.
  1.  N CLASS,IEN,IENLIST,IND
  1.  S IENLIST=$$LMSEL
  1.  F IND=1:1:$L(IENLIST,U) D
  1.  .S IEN=$P(IENLIST,U,IND)
  1.  .D DELETE^PXRMETXU(IEN)
  1.  ;Rebuild workfile
  1.  D BLDLIST^PXRMETH1(EDIEN)
  1.  ;Refresh
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. ENTRY ;Entry code
  1.  D BLDLIST^PXRMETH1(EDIEN),XQORM
  1.  Q
  1.  ;
  1. EXIT ;Exit code
  1.  K ^TMP("PXRMETH",$J)
  1.  K ^TMP("PXRMETHH",$J)
  1.  D CLEAN^VALM10
  1.  D FULL^VALM1
  1.  S VALMBCK="Q"
  1.  Q
  1.  ;
  1. EXTRACT(EDIEN) ;Run Extract/Transmission
  1.  ;Reset screen mode
  1.  W IORESET
  1.  ;Refresh on exit
  1.  S VALMBCK="R"
  1.  ;
  1.  ;Check is evaluation is disabled.
  1.  I $D(^XTMP("PXRM_DISEV",0)) D  Q
  1.  . W !,"Reminder evaluation is disabled, cannot start an Extract."
  1.  . H 2
  1.  ;
  1.  ;Get details from parameter file
  1.  N ANS,DATA,DUOUT,DTOUT,EDATE,EXSUMPUG,FREQ,MODE
  1.  N NAME,NAT,NEXT,PLISTPUG,RTN,REPL,STATUS,SNEXT,TEXT,XMIT
  1.  S DATA=$G(^PXRM(810.2,EDIEN,0))
  1.  S NAT=$P($G(^PXRM(810.2,EDIEN,100)),U)
  1.  ;Determine Extract Name and Frequency
  1.  S NAME=$P(DATA,U),FREQ=$P(DATA,U,3),NEXT=$P(DATA,U,6),RTN="PXRMETX"
  1.  ;Save next scheduled extract
  1.  S SNEXT=NEXT
  1.  ;Select extract period
  1. EXSEL D SELECT(FREQ,.NEXT) Q:$D(DUOUT)!$D(DTOUT)
  1.  ;Warn if period is still open
  1.  D WARN(NEXT,.STATUS)
  1.  ;Option to continue
  1.  S TEXT="Are you sure you want to run a "_NAME_" extract for "_$TR(NEXT,"/"," ")
  1. SURE ;
  1.  S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,1) Q:$D(DUOUT)!$D(DTOUT)  Q:'ANS
  1.  ;Purge options
  1. PLIST ;
  1.  S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
  1.  G:$D(DUOUT) SURE Q:$D(DTOUT)
  1.  S EXSUMPUG="N" D ASK^PXRMXD(.EXSUMPUG,"Purge Extract Summary after 5 years?: ",5)
  1.  G:$D(DUOUT) PLIST Q:$D(DTOUT)
  1.  ;Option to transmit
  1.  S TEXT="Transmit extract results to AAC"
  1.  I NAT="N" S XMIT=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
  1.  E  S XMIT=0
  1.  ;Option to replace scheduled run
  1.  S REPL=0
  1.  I XMIT,SNEXT=NEXT,STATUS="COMPLETE" D  Q:$D(DUOUT)!$D(DTOUT)
  1.  .S TEXT="Does this extract replace the scheduled extract"
  1.  .S REPL=$$ASKYN^PXRMEUT("N",TEXT,RTN,4) Q:$D(DUOUT)!$D(DTOUT)
  1.  ;
  1.  ;Note that the manual extract does not update 810.2
  1.  ;exept if the selected period is the same as the scheduled
  1.  ;period AND this period is complete
  1.  ;
  1.  ;Default is to extract and transmit and not update 810.2
  1.  S MODE=2 I 'XMIT S MODE=3
  1.  ;Update 810.2 if this extract is for current completed period
  1.  I REPL S MODE=0 I 'XMIT S MODE=1
  1.  ;
  1.  ;Extract/transmission run
  1.  N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1.  S ZTDESC="Run Reminder Extract"
  1.  S ZTRTN="RUN^PXRMETX(EDIEN,NEXT,MODE,EXSUMPUG)"
  1.  S ZTSAVE("EDIEN")=""
  1.  S ZTSAVE("MODE")=""
  1.  S ZTSAVE("NEXT")=""
  1.  S ZTSAVE("PLISTPUG")=""
  1.  S ZTSAVE("EXSUMPUG")=""
  1.  S ZTIO=""
  1.  ;
  1.  ;Select and verify start date/time for task
  1.  N DIR,DTOUT,DUOUT,MINDT,SDTIME,STIME,X,Y
  1.  S MINDT=$$NOW^XLFDT
  1.  W !,"Queue a "_ZTDESC_" for "_NEXT
  1.  S DIR("A",1)="Enter the date and time you want the job to start."
  1.  S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
  1.  S DIR("A")="Start the task at: "
  1.  S DIR(0)="DAU"_U_MINDT_"::RSX"
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q
  1.  S SDTIME=Y
  1.  ;
  1.  ;Put the task into the queue.
  1.  S ZTDTH=SDTIME
  1.  D ^%ZTLOAD
  1.  W !,"Task number ",ZTSK," queued." H 2
  1.  S VALMBCK="Q"
  1.  Q
  1.  ;
  1. HDR ; Header code
  1.  N VIEW
  1.  S VIEW=$S(PXRMVIEW="D":"Creation Date Order",1:"Extract Period Order")
  1.  S VALMHDR(2)="          Extract Name: "_$P($G(^PXRM(810.2,EDIEN,0)),U)
  1.  S VALMHDR(3)="   Next Extract Period: "_NPERIOD
  1.  S VALMHDR(4)="      Scheduled to Run: "_$$FMTE^XLFDT(NSDATE,"5Z")
  1.  S VALMHDR(4)=$$LJ^XLFSTR(VALMHDR(4),45)_"    View: "_VIEW
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  Q
  1.  ;
  1. HLP ;Help code
  1.  N ORU,ORUPRMT,SUB,XQORM
  1.  S SUB="PXRMETHH"
  1.  D EN^VALM("PXRM EXTRACT HELP")
  1.  Q
  1.  ;
  1. INIT ;Init
  1.  S VALMCNT=0
  1.  Q
  1.  ;
  1. LMSEL() ;Return selection list
  1.  N IENLIST,IND,VALMY,XIEN
  1.  D EN^VALM2(XQORNOD(0))
  1.  ;If there is no list quit.
  1.  I '$D(VALMY) Q ""
  1.  S PXRMDONE=0,IENLIST=""
  1.  S IND=""
  1.  F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
  1.  .;Get the ien.
  1.  .S XIEN=^TMP("PXRMETH",$J,"SEL",IND)
  1.  .S IENLIST=$S(IENLIST'="":IENLIST_U_XIEN,1:XIEN)
  1.  Q IENLIST
  1.  ;
  1. PEXIT ;PXRM EXCH MENU protocol exit code
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  D XQORM
  1.  Q
  1.  ;
  1. SELECT(FREQ,SEL) ;Select extract period
  1.  N BDATE,EDATE,DA,DIE,DIK,DIR,DR,FDATE,VALID,X
  1.  ;Get the new name.
  1.  F  D  Q:$D(DTOUT)!$D(DUOUT)  Q:SEL]""
  1.  .S DIR("A")="Select EXTRACT PERIOD "
  1.  .I FREQ="M" D
  1.  ..S DIR("A")=DIR("A")_"(Mnn/yyyy)"
  1.  ..S DIR(0)="F"_U_"7:8"_U_"K:'$$VALID^PXRMETH(FREQ,X) X"
  1.  .I FREQ="Q" D
  1.  ..S DIR("A")=DIR("A")_"(Qnn/yyyy)"
  1.  ..S DIR(0)="F"_U_"7:7"_U_"K:'$$VALID^PXRMETH(FREQ,X) X"
  1.  .I FREQ="Y" D
  1.  ..S DIR("A")=DIR("A")_"(yyyy)"
  1.  ..S DIR(0)="N"_U_"2000:2050"_U_"K:(X'?4N) X"
  1.  .;Default is next period
  1.  .S DIR("B")=NEXT
  1.  .W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT)
  1.  .;Calculate beginning and end dates for period
  1.  .S Y=$$UP^XLFSTR(Y) D CALC^PXRMEUT(Y,.BDATE,.EDATE)
  1.  .;Abort if period has not started
  1.  .I $$FMDIFF^XLFDT(BDATE,$$NOW^XLFDT)>0 D   Q
  1.  ..S FDATE=$$FMTE^XLFDT(BDATE,5)
  1.  ..W !,"ERROR -This period does not start until "_FDATE,*7
  1.  .S SEL=Y
  1.  Q
  1.  ;
  1. TLIST ;Extract summary display
  1.  N IEN,IENLIST,IND
  1.  S IENLIST=$$LMSEL
  1.  F IND=1:1:$L(IENLIST,U) D
  1.  .S IEN=$P(IENLIST,U,IND)
  1.  .D START^PXRMETT(IEN)
  1.  .S VALMBCK="R"
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. TRANS ;Run Transmission
  1.  N IEN,IENLIST,IND
  1.  S IENLIST=$$LMSEL
  1.  F IND=1:1:$L(IENLIST,U) D
  1.  .S IEN=$P(IENLIST,U,IND)
  1.  .I $P($G(^PXRMXT(810.3,IEN,100)),U)'="N" D  Q
  1.  ..W !,"Local extracts cannot be transmitted to AAC." H 2
  1.  .;Transmit extract summary
  1.  .N ANS,DUOUT,DTOUT,RTN,TEXT
  1.  .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
  1.  .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
  1.  .I ANS D TRANS^PXRMETX(IEN)
  1.  ;
  1.  ;Rebuild workfile
  1.  D BLDLIST^PXRMETH1(EDIEN)
  1.  ;Refresh
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. TRHIST ;Transmission History
  1.  N IEN,IENLIST,IND
  1.  S IENLIST=$$LMSEL
  1.  F IND=1:1:$L(IENLIST,U) D
  1.  .S IEN=$P(IENLIST,U,IND)
  1.  .D START^PXRMETHL(IEN)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. VALID(FREQ,INP) ;Validate Period input
  1.  W !
  1.  N PERIOD,YEAR
  1.  ;Convert to upper case
  1.  S INP=$$UP^XLFSTR(INP)
  1.  ;General format
  1.  I $E(INP)'=FREQ D EN^DDIOL("Format should be "_FREQ_"nn/yyyy") Q 0
  1.  S PERIOD=$P(INP,"/"),YEAR=$P(INP,"/",2)
  1.  S PERIOD=$P(PERIOD,FREQ,2)
  1.  ;All runs
  1.  I (YEAR<2000)!(YEAR>2050) D EN^DDIOL("Year should be in range 2000-2050") Q 0
  1.  ;Quarterly run
  1.  I FREQ="Q",(PERIOD>4)!(PERIOD<1) D EN^DDIOL("Quarter should be in range 1-4") Q 0
  1.  ;Monthly run
  1.  I FREQ="M",(PERIOD>12)!(PERIOD<1) D EN^DDIOL("Month should be in range 1-12") Q 0
  1.  ;Otherwise
  1.  Q 1
  1.  ;
  1. VIEW ;Select view
  1.  W IORESET
  1.  S VALMBCK="R"
  1.  N X,Y,CODE,DIR
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="S"_U_"D:Sort by Creation Date;"
  1.  S DIR(0)=DIR(0)_"P:Sort by Extract Period;"
  1.  S DIR("A")="TYPE OF VIEW"
  1.  S DIR("B")=$S(PXRMVIEW="P":"D",1:"P")
  1.  S DIR("?")="Select from the codes displayed. For detailed help type ??"
  1.  ;BOOKMARK - HELP NEEDS MOVING
  1.  S DIR("??")=U_"D HELP^PXRMSEL2(3)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  ;Change display type
  1.  S PXRMVIEW=Y
  1.  ;
  1.  ;Rebuild Workfile
  1.  D BLDLIST^PXRMETH1(EDIEN),HDR
  1.  Q
  1.  ;
  1. WARN(NEXT,STATUS) ;Warn if period is not completed
  1.  N BDATE,EDATE,FDATE
  1.  ;Calculate beginning and end dates for period
  1.  D CALC^PXRMEUT(NEXT,.BDATE,.EDATE)
  1.  ;No warning if period end date is a prior date
  1.  I $$FMDIFF^XLFDT($$NOW^XLFDT,EDATE)>0 S STATUS="COMPLETE" Q
  1.  ;Else Format date
  1.  S FDATE=$$FMTE^XLFDT(EDATE,5),STATUS="INCOMPLETE"
  1.  ;And Warn that period end date is a future date
  1.  W !!,"WARNING -This period is not complete until "_FDATE
  1.  Q
  1. XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT HISTORY SELECT ENTRY",0))_U_"1:"_VALMCNT
  1.  S XQORM("A")="Select Item: "
  1.  Q
  1.  ;
  1. XSEL ;PXRM EXTRACT HISTORY SELECT ENTRY validation
  1.  N SEL,PXRMSIEN
  1.  S SEL=$P(XQORNOD(0),"=",2)
  1.  ;Remove trailing ,
  1.  I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
  1.  ;Invalid selection
  1.  I SEL["," D  Q
  1.  .W $C(7),!,"Only one item number allowed." H 2
  1.  .S VALMBCK="R"
  1.  I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D  Q
  1.  .W $C(7),!,SEL_" is not a valid item number." H 2
  1.  .S VALMBCK="R"
  1.  ;
  1.  ;Get the list ien.
  1.  S PXRMSIEN=^TMP("PXRMETH",$J,"SEL",SEL)
  1.  ;
  1.  ;Full screen mode
  1.  D FULL^VALM1
  1.  ;
  1.  ;Options
  1.  N X,Y,DIR,OPTION K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="SBM"_U_"DE:Delete Extract;"
  1.  S DIR(0)=DIR(0)_"ES:Extract Summary;"
  1.  S DIR(0)=DIR(0)_"MT:Manual Transmission;"
  1.  S DIR(0)=DIR(0)_"TH:Transmission History;"
  1.  S DIR("A")="Select Action"
  1.  S DIR("B")="ES"
  1.  S DIR("?")="Select from the codes displayed. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMETH1(1)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
  1.  S OPTION=Y
  1.  ;
  1.  ;Delete an extract
  1.  I OPTION="DE" D
  1.  .D DELETE^PXRMETXU(PXRMSIEN)
  1.  .;Rebuild workfile
  1.  .D BLDLIST^PXRMETH1(PXRMSIEN)
  1.  .;Refresh
  1.  .S VALMBCK="R"
  1.  ;
  1.  ;Display Extract Summary
  1.  I OPTION="ES" D START^PXRMETT(PXRMSIEN)
  1.  ;
  1.  ;Transmission option
  1.  I OPTION="MT" D
  1.  .N ANS,DUOUT,DTOUT,RTN,TEXT
  1.  .I $P($G(^PXRMXT(810.3,PXRMSIEN,100)),U)'="N" D  Q
  1.  ..W !,"Local extracts cannot be transmitted to AAC" H 2 Q
  1.  .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
  1.  .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
  1.  .I ANS D TRANS^PXRMETX(PXRMSIEN)
  1.  ;
  1.  ;Transmission History
  1.  I OPTION="TH" D START^PXRMETHL(PXRMSIEN)
  1.  ;
  1.  S VALMBCK="R"
  1.  Q
  1.  ;