Index: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMETH.m
===================================================================
--- FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETH.m	(revision 631)
+++ FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMETH.m	(revision 636)
@@ -1,12 +1,11 @@
-PXRMETH ; SLC/PJH - Reminder Extract History ;10/11/2007
- ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+PXRMETH ; SLC/PJH - Reminder Extract History ;08/15/2006
+ ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  ;
  ;Main entry point for PXRM EXTRACT HISTORY
-START(EDIEN) ;
- ;EDIEN is the extract definition IEN.
+START(IEN) ;
  N VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
  ;Details of last run
  N DATA,NPERIOD,NSDATE,NTAS,PXRMVIEW
- S DATA=$G(^PXRM(810.2,EDIEN,0))
+ S DATA=$G(^PXRM(810.2,IEN,0))
  S NPERIOD=$P(DATA,U,6),NSDATE=$P(DATA,U,7)
  ;Default view is in date created order
@@ -18,18 +17,6 @@
  Q
  ;
-DELETE ;Delete an extract, called by protocol PXRM EXTRACT SUMMARY DELETE.
- N CLASS,IEN,IENLIST,IND
- S IENLIST=$$LMSEL
- F IND=1:1:$L(IENLIST,U) D
- .S IEN=$P(IENLIST,U,IND)
- .D DELETE^PXRMETXU(IEN)
- ;Rebuild workfile
- D BLDLIST^PXRMETH1(EDIEN)
- ;Refresh
- S VALMBCK="R"
- Q
- ;
 ENTRY ;Entry code
- D BLDLIST^PXRMETH1(EDIEN),XQORM
+ D BLDLIST^PXRMETH1(IEN),XQORM
  Q
  ;
@@ -42,5 +29,88 @@
  Q
  ;
-EXTRACT(EDIEN) ;Run Extract/Transmission
+HDR ; Header code
+ N VIEW
+ S VIEW=$S(PXRMVIEW="D":"Creation Date Order",1:"Extract Period Order")
+ S VALMHDR(2)="          Extract Name: "_$P($G(^PXRM(810.2,IEN,0)),U)
+ S VALMHDR(3)="   Next Extract Period: "_NPERIOD
+ S VALMHDR(4)="      Scheduled to Run: "_NSDATE
+ S VALMHDR(4)=$$LJ^XLFSTR(VALMHDR(4),45)_"    View: "_VIEW
+ S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
+ Q
+ ;
+HLP ;Help code
+ N ORU,ORUPRMT,SUB,XQORM
+ S SUB="PXRMETHH"
+ D EN^VALM("PXRM EXTRACT HELP")
+ Q
+ ;
+INIT ;Init
+ S VALMCNT=0
+ Q
+ ;
+PEXIT ;PXRM EXCH MENU protocol exit code
+ S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
+ D XQORM
+ Q
+ ;
+XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT HISTORY SELECT ENTRY",0))_U_"1:"_VALMCNT
+ S XQORM("A")="Select Item: "
+ Q
+ ;
+XSEL ;PXRM EXTRACT HISTORY SELECT ENTRY validation
+ N SEL,PXRMSIEN
+ S SEL=$P(XQORNOD(0),"=",2)
+ ;Remove trailing ,
+ I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
+ ;Invalid selection
+ I SEL["," D  Q
+ .W $C(7),!,"Only one item number allowed." H 2
+ .S VALMBCK="R"
+ I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D  Q
+ .W $C(7),!,SEL_" is not a valid item number." H 2
+ .S VALMBCK="R"
+ ;
+ ;Get the list ien.
+ S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",SEL,SEL)
+ ;
+ ;Full screen mode
+ D FULL^VALM1
+ ;
+ ;Options
+ N X,Y,DIR,OPTION K DIROUT,DIRUT,DTOUT,DUOUT
+ S DIR(0)="SBM"_U_"ES:Extract Summary;"
+ S DIR(0)=DIR(0)_"MT:Manual Transmission;"
+ S DIR(0)=DIR(0)_"TH:Transmission History;"
+ S DIR("A")="Select Action"
+ S DIR("B")="ES"
+ S DIR("?")="Select from the codes displayed. For detailed help type ??"
+ S DIR("??")=U_"D HELP^PXRMETH1(1)"
+ D ^DIR K DIR
+ I $D(DIROUT) S DTOUT=1
+ I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
+ S OPTION=Y
+ ;
+ ;Display Extract Summary
+ I OPTION="ES" D
+ .D START^PXRMETT(PXRMSIEN)
+ ;
+ ;Transmission option
+ I OPTION="MT" D
+ .N ANS,DUOUT,DTOUT,RTN,TEXT
+ .I $P($G(^PXRMXT(810.3,PXRMSIEN,100)),U)'="N" D  Q
+ ..W !,"Local extracts cannot be transmitted to AAC" H 2 Q
+ .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
+ .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
+ .I ANS D TRANS^PXRMETX(PXRMSIEN)
+ ;
+ ;Transmission History
+ I OPTION="TH" D
+ .D START^PXRMETHL(PXRMSIEN)
+ ;
+ S VALMBCK="R"
+ Q
+ ;
+EXTRACT(IEN) ;Run Extract/Transmission
+ ;
  ;Reset screen mode
  W IORESET
@@ -51,6 +121,6 @@
  N ANS,DATA,DUOUT,DTOUT,EDATE,EXSUMPUG,FREQ,MODE
  N NAME,NAT,NEXT,PLISTPUG,RTN,REPL,STATUS,SNEXT,TEXT,XMIT
- S DATA=$G(^PXRM(810.2,EDIEN,0))
- S NAT=$P($G(^PXRM(810.2,EDIEN,100)),U)
+ S DATA=$G(^PXRM(810.2,IEN,0))
+ S NAT=$P($G(^PXRM(810.2,IEN,100)),U)
  ;Determine Extract Name and Frequency
  S NAME=$P(DATA,U),FREQ=$P(DATA,U,3),NEXT=$P(DATA,U,6),RTN="PXRMETX"
@@ -93,6 +163,6 @@
  N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  S ZTDESC="Reminder Extract "_NAME
- S ZTRTN="RUN^PXRMETX(EDIEN,NEXT,MODE,EXSUMPUG)"
- S ZTSAVE("EDIEN")=""
+ S ZTRTN="RUN^PXRMETX(IEN,NEXT,MODE,EXSUMPUG)"
+ S ZTSAVE("IEN")=""
  S ZTSAVE("MODE")=""
  S ZTSAVE("NEXT")=""
@@ -117,46 +187,10 @@
  D ^%ZTLOAD
  W !,"Task number ",ZTSK," queued." H 2
+ ;
  S VALMBCK="Q"
  Q
  ;
-HDR ; Header code
- N VIEW
- S VIEW=$S(PXRMVIEW="D":"Creation Date Order",1:"Extract Period Order")
- S VALMHDR(2)="          Extract Name: "_$P($G(^PXRM(810.2,EDIEN,0)),U)
- S VALMHDR(3)="   Next Extract Period: "_NPERIOD
- S VALMHDR(4)="      Scheduled to Run: "_$$FMTE^XLFDT(NSDATE,"5Z")
- S VALMHDR(4)=$$LJ^XLFSTR(VALMHDR(4),45)_"    View: "_VIEW
- S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
- Q
- ;
-HLP ;Help code
- N ORU,ORUPRMT,SUB,XQORM
- S SUB="PXRMETHH"
- D EN^VALM("PXRM EXTRACT HELP")
- Q
- ;
-INIT ;Init
- S VALMCNT=0
- Q
- ;
-LMSEL() ;Return selection list
- N IENLIST,IND,VALMY,XIEN
- D EN^VALM2(XQORNOD(0))
- ;If there is no list quit.
- I '$D(VALMY) Q ""
- S PXRMDONE=0,IENLIST=""
- S IND=""
- F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
- .;Get the ien.
- .S XIEN=^TMP("PXRMETH",$J,"SEL",IND)
- .S IENLIST=$S(IENLIST'="":IENLIST_U_XIEN,1:XIEN)
- Q IENLIST
- ;
-PEXIT ;PXRM EXCH MENU protocol exit code
- S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
- D XQORM
- Q
- ;
 SELECT(FREQ,SEL) ;Select extract period
+ ;
  N BDATE,EDATE,DA,DIE,DIK,DIR,DR,FDATE,VALID,X
  ;Get the new name.
@@ -184,29 +218,40 @@
  Q
  ;
-TLIST ;Extract summary display
- N IEN,IENLIST,IND
- S IENLIST=$$LMSEL
- F IND=1:1:$L(IENLIST,U) D
- .S IEN=$P(IENLIST,U,IND)
- .D START^PXRMETT(IEN)
- .S VALMBCK="R"
+TLIST ;Extract Totals
+ N IND,PXRMSIEN,VALMY
+ D EN^VALM2(XQORNOD(0))
+ ;If there is no list quit.
+ I '$D(VALMY) Q
+ ;PXRMDONE is newed in PXRMLPM
+ S PXRMDONE=0
+ S IND=""
+ F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
+ .;Get the ien.
+ .S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",IND,IND)
+ .D START^PXRMETT(PXRMSIEN)
+ ;
  S VALMBCK="R"
  Q
  ;
 TRANS ;Run Transmission
- N IEN,IENLIST,IND
- S IENLIST=$$LMSEL
- F IND=1:1:$L(IENLIST,U) D
- .S IEN=$P(IENLIST,U,IND)
- .I $P($G(^PXRMXT(810.3,IEN,100)),U)'="N" D  Q
- ..W !,"Local extracts cannot be transmitted to AAC." H 2
+ N IND,PXRMXIEN,VALMY
+ D EN^VALM2(XQORNOD(0))
+ ;If there is no list quit.
+ I '$D(VALMY) Q
+ S PXRMDONE=0
+ S IND=""
+ F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
+ .;Get the ien.
+ .S PXRMXIEN=^TMP("PXRMETH",$J,"IDX",IND,IND)
+ .I $P($G(^PXRMXT(810.3,PXRMXIEN,100)),U)'="N" D  Q
+ ..W !,"Local extracts cannot be transmitted to AAC." H 1
  .;Transmit extract summary
  .N ANS,DUOUT,DTOUT,RTN,TEXT
  .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
  .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
- .I ANS D TRANS^PXRMETX(IEN)
+ .I ANS D TRANS^PXRMETX(PXRMXIEN)
  ;
  ;Rebuild workfile
- D BLDLIST^PXRMETH1(EDIEN)
+ D BLDLIST^PXRMETH1(IEN)
  ;Refresh
  S VALMBCK="R"
@@ -214,9 +259,16 @@
  ;
 TRHIST ;Transmission History
- N IEN,IENLIST,IND
- S IENLIST=$$LMSEL
- F IND=1:1:$L(IENLIST,U) D
- .S IEN=$P(IENLIST,U,IND)
- .D START^PXRMETHL(IEN)
+ N IND,PXRMSIEN,VALMY
+ D EN^VALM2(XQORNOD(0))
+ ;If there is no list quit.
+ I '$D(VALMY) Q
+ ;PXRMDONE is newed in PXRMLPM
+ S PXRMDONE=0
+ S IND=""
+ F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
+ .;Get the ien.
+ .S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",IND,IND)
+ .D START^PXRMETHL(PXRMSIEN)
+ ;
  S VALMBCK="R"
  Q
@@ -241,6 +293,9 @@
  ;
 VIEW ;Select view
+ ;
  W IORESET
- S VALMBCK="R"
+ ;
+ S VALMBCK="R"
+ ;
  N X,Y,CODE,DIR
  K DIROUT,DIRUT,DTOUT,DUOUT
@@ -259,5 +314,5 @@
  ;
  ;Rebuild Workfile
- D BLDLIST^PXRMETH1(EDIEN),HDR
+ D BLDLIST^PXRMETH1(IEN),HDR
  Q
  ;
@@ -273,67 +328,2 @@
  W !!,"WARNING -This period is not complete until "_FDATE
  Q
-XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT HISTORY SELECT ENTRY",0))_U_"1:"_VALMCNT
- S XQORM("A")="Select Item: "
- Q
- ;
-XSEL ;PXRM EXTRACT HISTORY SELECT ENTRY validation
- N SEL,PXRMSIEN
- S SEL=$P(XQORNOD(0),"=",2)
- ;Remove trailing ,
- I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
- ;Invalid selection
- I SEL["," D  Q
- .W $C(7),!,"Only one item number allowed." H 2
- .S VALMBCK="R"
- I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D  Q
- .W $C(7),!,SEL_" is not a valid item number." H 2
- .S VALMBCK="R"
- ;
- ;Get the list ien.
- ;S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",SEL,SEL)
- S PXRMSIEN=^TMP("PXRMETH",$J,"SEL",SEL)
- ;
- ;Full screen mode
- D FULL^VALM1
- ;
- ;Options
- N X,Y,DIR,OPTION K DIROUT,DIRUT,DTOUT,DUOUT
- S DIR(0)="SBM"_U_"DE:Delete Extract;"
- S DIR(0)=DIR(0)_"ES:Extract Summary;"
- S DIR(0)=DIR(0)_"MT:Manual Transmission;"
- S DIR(0)=DIR(0)_"TH:Transmission History;"
- S DIR("A")="Select Action"
- S DIR("B")="ES"
- S DIR("?")="Select from the codes displayed. For detailed help type ??"
- S DIR("??")=U_"D HELP^PXRMETH1(1)"
- D ^DIR K DIR
- I $D(DIROUT) S DTOUT=1
- I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
- S OPTION=Y
- ;
- ;Delete an extract
- I OPTION="DE" D
- .D DELETE^PXRMETXU(PXRMSIEN)
- .;Rebuild workfile
- .D BLDLIST^PXRMETH1(PXRMSIEN)
- .;Refresh
- .S VALMBCK="R"
- ;
- ;Display Extract Summary
- I OPTION="ES" D START^PXRMETT(PXRMSIEN)
- ;
- ;Transmission option
- I OPTION="MT" D
- .N ANS,DUOUT,DTOUT,RTN,TEXT
- .I $P($G(^PXRMXT(810.3,PXRMSIEN,100)),U)'="N" D  Q
- ..W !,"Local extracts cannot be transmitted to AAC" H 2 Q
- .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
- .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
- .I ANS D TRANS^PXRMETX(PXRMSIEN)
- ;
- ;Transmission History
- I OPTION="TH" D START^PXRMETHL(PXRMSIEN)
- ;
- S VALMBCK="R"
- Q
- ;
