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