PXRMETM ; SLC/PKR/PJH - Extract/Transmission Management ;09/06/2007
;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
;
;Main entry point for PXRM EXTRACT MANAGEMENT
START N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
S X="IORESET"
D ENDR^%ZISS
S VALMCNT=0
D EN^VALM("PXRM EXTRACT MANAGEMENT")
W IORESET
D KILL^%ZISS
Q
;
BLDLIST ;Build workfile
K ^TMP("PXRMETM",$J)
N IEN,IND,PLIST
D LIST("PXRMETM",.VALMCNT)
Q
;
ENTRY ;Entry code
D BLDLIST,XQORM
Q
;
EXIT ;Exit code
K ^TMP("PXRMETM",$J)
K ^TMP("PXRMETMH",$J)
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="Q"
Q
;
FMT(NUMBER,NAME,CLASS) ;Format entry number, name
;and date packed.
N TCLASS,TEMP,TNAME,TSOURCE
S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
S TNAME=$E(NAME,1,46)
S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
S TCLASS=$S(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
S TEMP=TEMP_" "_TCLASS
Q TEMP
;
GEN ;Ad hoc report option
;Reset Screen Mode
W IORESET
;
N IND,LISTIEN,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 LISTIEN=^TMP("PXRMETM",$J,"SEL",IND)
.D GENSEL(LISTIEN)
;
S VALMBCK="R"
Q
;
GENSEL(IEN) ;Report for selected extract definition
N ANS,BEGIN,END,RTN,TEXT
D DATES^PXRMEUT(.BEGIN,.END,"Report")
;Options
S RTN="PXRMETM",TEXT="Run compliance report for this period"
S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,1) Q:'ANS Q:$D(DUOUT)!$D(DTOUT)
;Print Report
D ADHOC^PXRMETCO(IEN,BEGIN,END)
Q
;
HDR ; Header code
S VALMHDR(1)="Available Extract Definitions:"
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
HELP(CALL) ;General help text routine
N HTEXT
I CALL=1 D
.S HTEXT(1)="Select EDM to edit/display extract definitions.\\"
.S HTEXT(2)="Select VSE to view previous extracts or"
.S HTEXT(3)="initiate a manual extract or transmission."
D HELP^PXRMEUT(.HTEXT)
Q
;
HLIST ;Extract History
N IND,LISTIEN,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 LISTIEN=^TMP("PXRMETM",$J,"SEL",IND)
.D START^PXRMETH(LISTIEN)
S VALMBCK="R"
Q
;
HLP ;Help code
N ORU,ORUPRMT,SUB,XQORM
S SUB="PXRMETMH"
D EN^VALM("PXRM EXTRACT HELP")
Q
;
INIT ;Init
S VALMCNT=0
Q
;
LIST(NODE,VALMCNT) ;Build a list of extract definition entries.
N EPCLASS,IND,FNAME,NAME
;Build the list in alphabetical order.
S VALMCNT=0
S NAME=""
F S NAME=$O(^PXRM(810.2,"B",NAME)) Q:NAME="" D
.S IND=$O(^PXRM(810.2,"B",NAME,"")) Q:'IND
.S FNAME=$P($G(^PXRM(810.2,IND,0)),U)
.S EPCLASS=$P($G(^PXRM(810.2,IND,100)),U)
.S VALMCNT=VALMCNT+1
.S ^TMP(NODE,$J,VALMCNT,0)=$$FMT(VALMCNT,FNAME,EPCLASS)
.S ^TMP(NODE,$J,"IDX",VALMCNT,VALMCNT)=""
.S ^TMP(NODE,$J,"SEL",VALMCNT)=IND
Q
;
PEXIT ;Protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Reset after page up/down etc
D XQORM
Q
;
PLIST ;Extract Definition Inquiry
N IND,EPIEN,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 EPIEN=^TMP("PXRMETM",$J,"SEL",IND)
.D START^PXRMEPED(EPIEN)
S VALMBCK="R"
Q
;
XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT MANAGEMENT SELECT ENTRY",0))_U_"1:"_VALMCNT
S XQORM("A")="Select Item: "
Q
;
XSEL ;PXRM EXTRACT MANAGEMENT SELECT ENTRY validation
N EDIEN,SEL
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 EDIEN=^TMP("PXRMETM",$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_"EDM:Extract Definition Management;"
S DIR(0)=DIR(0)_"VSE:Examine/Schedule Extract;"
S DIR("A")="Select Action"
S DIR("B")="VSE"
S DIR("?")="Select from the codes displayed. For detailed help type ??"
S DIR("??")=U_"D HELP^PXRMETM(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 Definitions
I OPTION="EDM" D START^PXRMEPED(EDIEN)
;
;Examine/Run Extract
I OPTION="VSE" D START^PXRMETH(EDIEN)
;
;Examine/Run Extract
I OPTION="ERE" D GENSEL(EDIEN)
;
S VALMBCK="R"
Q
;
PXRMETM ; SLC/PKR/PJH - Extract/Transmission Management ;09/06/2007
+1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+2 ;
+3 ;Main entry point for PXRM EXTRACT MANAGEMENT
START NEW PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
+1 SET X="IORESET"
+2 DO ENDR^%ZISS
+3 SET VALMCNT=0
+4 DO EN^VALM("PXRM EXTRACT MANAGEMENT")
+5 WRITE IORESET
+6 DO KILL^%ZISS
+7 QUIT
+8 ;
BLDLIST ;Build workfile
+1 KILL ^TMP("PXRMETM",$JOB)
+2 NEW IEN,IND,PLIST
+3 DO LIST("PXRMETM",.VALMCNT)
+4 QUIT
+5 ;
ENTRY ;Entry code
+1 DO BLDLIST
DO XQORM
+2 QUIT
+3 ;
EXIT ;Exit code
+1 KILL ^TMP("PXRMETM",$JOB)
+2 KILL ^TMP("PXRMETMH",$JOB)
+3 DO CLEAN^VALM10
+4 DO FULL^VALM1
+5 SET VALMBCK="Q"
+6 QUIT
+7 ;
FMT(NUMBER,NAME,CLASS) ;Format entry number, name
+1 ;and date packed.
+2 NEW TCLASS,TEMP,TNAME,TSOURCE
+3 SET TEMP=$$RJ^XLFSTR(NUMBER,5," ")
+4 SET TNAME=$EXTRACT(NAME,1,46)
+5 SET TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
+6 SET TCLASS=$SELECT(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
+7 SET TEMP=TEMP_" "_TCLASS
+8 QUIT TEMP
+9 ;
GEN ;Ad hoc report option
+1 ;Reset Screen Mode
+2 WRITE IORESET
+3 ;
+4 NEW IND,LISTIEN,VALMY
+5 DO EN^VALM2(XQORNOD(0))
+6 ;If there is no list quit.
+7 IF '$DATA(VALMY)
QUIT
+8 SET PXRMDONE=0
+9 SET IND=""
+10 FOR
SET IND=$ORDER(VALMY(IND))
IF (+IND=0)!(PXRMDONE)
QUIT
Begin DoDot:1
+11 ;Get the ien.
+12 SET LISTIEN=^TMP("PXRMETM",$JOB,"SEL",IND)
+13 DO GENSEL(LISTIEN)
End DoDot:1
+14 ;
+15 SET VALMBCK="R"
+16 QUIT
+17 ;
GENSEL(IEN) ;Report for selected extract definition
+1 NEW ANS,BEGIN,END,RTN,TEXT
+2 DO DATES^PXRMEUT(.BEGIN,.END,"Report")
+3 ;Options
+4 SET RTN="PXRMETM"
SET TEXT="Run compliance report for this period"
+5 SET ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,1)
IF 'ANS
QUIT
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+6 ;Print Report
+7 DO ADHOC^PXRMETCO(IEN,BEGIN,END)
+8 QUIT
+9 ;
HDR ; Header code
+1 SET VALMHDR(1)="Available Extract Definitions:"
+2 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+3 QUIT
+4 ;
HELP(CALL) ;General help text routine
+1 NEW HTEXT
+2 IF CALL=1
Begin DoDot:1
+3 SET HTEXT(1)="Select EDM to edit/display extract definitions.\\"
+4 SET HTEXT(2)="Select VSE to view previous extracts or"
+5 SET HTEXT(3)="initiate a manual extract or transmission."
End DoDot:1
+6 DO HELP^PXRMEUT(.HTEXT)
+7 QUIT
+8 ;
HLIST ;Extract History
+1 NEW IND,LISTIEN,VALMY
+2 DO EN^VALM2(XQORNOD(0))
+3 ;If there is no list quit.
+4 IF '$DATA(VALMY)
QUIT
+5 SET PXRMDONE=0
+6 SET IND=""
+7 FOR
SET IND=$ORDER(VALMY(IND))
IF (+IND=0)!(PXRMDONE)
QUIT
Begin DoDot:1
+8 ;Get the ien.
+9 SET LISTIEN=^TMP("PXRMETM",$JOB,"SEL",IND)
+10 DO START^PXRMETH(LISTIEN)
End DoDot:1
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
HLP ;Help code
+1 NEW ORU,ORUPRMT,SUB,XQORM
+2 SET SUB="PXRMETMH"
+3 DO EN^VALM("PXRM EXTRACT HELP")
+4 QUIT
+5 ;
INIT ;Init
+1 SET VALMCNT=0
+2 QUIT
+3 ;
LIST(NODE,VALMCNT) ;Build a list of extract definition entries.
+1 NEW EPCLASS,IND,FNAME,NAME
+2 ;Build the list in alphabetical order.
+3 SET VALMCNT=0
+4 SET NAME=""
+5 FOR
SET NAME=$ORDER(^PXRM(810.2,"B",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+6 SET IND=$ORDER(^PXRM(810.2,"B",NAME,""))
IF 'IND
QUIT
+7 SET FNAME=$PIECE($GET(^PXRM(810.2,IND,0)),U)
+8 SET EPCLASS=$PIECE($GET(^PXRM(810.2,IND,100)),U)
+9 SET VALMCNT=VALMCNT+1
+10 SET ^TMP(NODE,$JOB,VALMCNT,0)=$$FMT(VALMCNT,FNAME,EPCLASS)
+11 SET ^TMP(NODE,$JOB,"IDX",VALMCNT,VALMCNT)=""
+12 SET ^TMP(NODE,$JOB,"SEL",VALMCNT)=IND
End DoDot:1
+13 QUIT
+14 ;
PEXIT ;Protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 ;Reset after page up/down etc
+3 DO XQORM
+4 QUIT
+5 ;
PLIST ;Extract Definition Inquiry
+1 NEW IND,EPIEN,VALMY
+2 DO EN^VALM2(XQORNOD(0))
+3 ;If there is no list quit.
+4 IF '$DATA(VALMY)
QUIT
+5 SET PXRMDONE=0
+6 SET IND=""
+7 FOR
SET IND=$ORDER(VALMY(IND))
IF (+IND=0)!(PXRMDONE)
QUIT
Begin DoDot:1
+8 ;Get the ien.
+9 SET EPIEN=^TMP("PXRMETM",$JOB,"SEL",IND)
+10 DO START^PXRMEPED(EPIEN)
End DoDot:1
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
XQORM SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM EXTRACT MANAGEMENT SELECT ENTRY",0))_U_"1:"_VALMCNT
+1 SET XQORM("A")="Select Item: "
+2 QUIT
+3 ;
XSEL ;PXRM EXTRACT MANAGEMENT SELECT ENTRY validation
+1 NEW EDIEN,SEL
+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 EDIEN=^TMP("PXRMETM",$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_"EDM:Extract Definition Management;"
+22 SET DIR(0)=DIR(0)_"VSE:Examine/Schedule Extract;"
+23 SET DIR("A")="Select Action"
+24 SET DIR("B")="VSE"
+25 SET DIR("?")="Select from the codes displayed. For detailed help type ??"
+26 SET DIR("??")=U_"D HELP^PXRMETM(1)"
+27 DO ^DIR
KILL DIR
+28 IF $DATA(DIROUT)
SET DTOUT=1
+29 IF $DATA(DTOUT)!($DATA(DUOUT))
SET VALMBCK="R"
QUIT
+30 SET OPTION=Y
+31 ;
+32 ;Display Extract Definitions
+33 IF OPTION="EDM"
DO START^PXRMEPED(EDIEN)
+34 ;
+35 ;Examine/Run Extract
+36 IF OPTION="VSE"
DO START^PXRMETH(EDIEN)
+37 ;
+38 ;Examine/Run Extract
+39 IF OPTION="ERE"
DO GENSEL(EDIEN)
+40 ;
+41 SET VALMBCK="R"
+42 QUIT
+43 ;
