PXRMEPM ; SLC/PKR/PJH - Extract Definition Management ;07/17/2007
;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
;
;Main entry point for PXRM EXTRACT DEFINITIONS
START N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
S X="IORESET"
D ENDR^%ZISS
S VALMCNT=0
D EN^VALM("PXRM EXTRACT DEFINITIONS")
Q
;
BLDLIST ;Build workfile
K ^TMP("PXRMEPM",$J)
N IEN,IND,PLIST
D LIST^PXRMETM("PXRMEPM",.VALMCNT)
Q
;
ENTRY ;Entry code
D BLDLIST,XQORM
Q
;
EXIT ;Exit code
K ^TMP("PXRMEPM",$J)
K ^TMP("PXRMEPMH",$J)
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="Q"
Q
;
HDR ; Header code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
HLP ;Help code
N ORU,ORUPRMT,SUB,XQORM
S SUB="PXRMEPMH"
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"
;Reset after page up/down etc
D XQORM
Q
;
XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT DEFINITION SELECT ENTRY",0))_U_"1:"_VALMCNT
S XQORM("A")="Select Item: "
Q
;
XSEL ;PXRM EXTRACT DEFINITION SELECT ENTRY validation
N SEL,IEN
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 IEN=^TMP("PXRMEPM",$J,"SEL",SEL)
;Display/Edit Extract Definition
D START^PXRMEPED(IEN)
D BLDLIST
S VALMBCK="R"
Q
;
HELP(CALL) ;General help text routine
N HTEXT
I CALL=1 D
.S HTEXT(1)="Select DE to display or edit a definition."
.S HTEXT(2)="Select ED to edit a definition"
D HELP^PXRMEUT(.HTEXT)
Q
;
EPADD ;Add Rule Option
;Reset Screen Mode
W IORESET
;
;Add Rule
D ADD^PXRMEPED
;
;Rebuild Workfile
D BLDLIST
S VALMBCK="R"
Q
;
EPINQ ;Definition Inquiry - PXRM EXTRACT DEFINITION DISPLAY/EDIT entry
N IND,LRIEN,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 LRIEN=^TMP("PXRMEPM",$J,"SEL",IND)
.D START^PXRMEPED(LRIEN)
D BLDLIST
S VALMBCK="R"
Q
;
PPLR ;Display rule set components
;used by [PXRM EXTRACT DEFINITION] template)
N ACT,DATA,FIRST,IEN,LRDATA,LRIEN,SEQ,SUB
S IEN=$P(X,U,2) Q:'IEN
W !," Description: ",$P($G(^PXRM(810.4,IEN,0)),U,2)
S SEQ="",FIRST=1
F S SEQ=$O(^PXRM(810.4,IEN,30,"B",SEQ)) Q:'SEQ D
.S SUB=$O(^PXRM(810.4,IEN,30,"B",SEQ,"")) Q:'SUB
.S DATA=$G(^PXRM(810.4,IEN,30,SUB,0)) Q:DATA=""
.S LRIEN=$P(DATA,U,2) Q:LRIEN=""
.S ACT=$P(DATA,U,3),LRDATA=$G(^PXRM(810.4,LRIEN,0))
.I FIRST W !!,?2,"List Rules:" S FIRST=0
.W !,?2,SEQ,?7,$P(LRDATA,U),?66
.W $S(ACT="A":"ADD PATIENT",ACT="R":"REMOVE PATIENT",ACT="F":"INSERT FINDING",1:"SELECT PATIENT")
.;Display List Rule fields
.D LROUT^PXRMLRED(LRIEN,23)
.W !
Q
;
PPFR ;Display counting rules and count type
;used by [PXRM EXTRACT DEFINITION] template)
W !
N DATA,GIEN,GSTATUS,IEN,SEQ,SUB
S IEN=$P(X,U,3) Q:'IEN
S SEQ=""
F S SEQ=$O(^PXRM(810.7,IEN,10,"B",SEQ)) Q:SEQ="" D
.S SUB=$O(^PXRM(810.7,IEN,10,"B",SEQ,"")) Q:'SUB
.S DATA=$G(^PXRM(810.7,IEN,10,SUB,0)) Q:DATA=""
.S GIEN=$P(DATA,U,2) Q:GIEN=""
.S GSTATUS=$P(DATA,U,3)
.;Get counting groups
.N CTYP,CTXT,DATA,EXCL,FIRST,GNAME,PNAME,TIEN,TNAME,GSEQ,GSUB
.S DATA=$G(^PXRM(810.8,GIEN,0)),GNAME=$P(DATA,U)
.S CTYP=$P(DATA,U,3),PNAME=$P(DATA,U,2),GSEQ="",FIRST=1
.S CTXT=$$TXT(CTYP,GSTATUS)
.F S GSEQ=$O(^PXRM(810.8,GIEN,10,"B",GSEQ)) Q:GSEQ="" D
..S GSUB=$O(^PXRM(810.8,GIEN,10,"B",GSEQ,"")) Q:'GSUB
..S DATA=$G(^PXRM(810.8,GIEN,10,GSUB,0)) Q:DATA=""
..S TIEN=$P(DATA,U,2) Q:TIEN=""
..S EXCL=$P(DATA,U,3) Q:EXCL="E"
..S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U)
..I FIRST D
...W !,?14,SEQ
...W ?18,"Counting Group: ",GNAME
...W !,?18,$$TXT(CTYP,GSTATUS)
...W !,?23,"Terms:" S FIRST=0
..W ?30,TNAME,!
Q
;
SCREEN ;Screen for 810.210 field .02
S DIC("S")="I $P(^(0),U,3)=3"
Q
;
TXT(COUNT,COHORT) ;Text to describe group
N TXT
;Determine count type
I COUNT="MRFP" S TXT="Most recent finding patient counts for "
I COUNT="MRF" S TXT="Most recent finding counts for "
I COUNT="UR" S TXT="Utilization in period finding counts for "
;Error
I $G(TXT)="" Q "Unknown count type - error"
;Determine cohort
S TXT=TXT_$S(COHORT="A":"APPLICABLE",1:"TOTAL")_" patients"
Q TXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEPM 4641 printed Dec 13, 2024@01:44:35 Page 2
PXRMEPM ; SLC/PKR/PJH - Extract Definition Management ;07/17/2007
+1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+2 ;
+3 ;Main entry point for PXRM EXTRACT DEFINITIONS
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 DEFINITIONS")
+5 QUIT
+6 ;
BLDLIST ;Build workfile
+1 KILL ^TMP("PXRMEPM",$JOB)
+2 NEW IEN,IND,PLIST
+3 DO LIST^PXRMETM("PXRMEPM",.VALMCNT)
+4 QUIT
+5 ;
ENTRY ;Entry code
+1 DO BLDLIST
DO XQORM
+2 QUIT
+3 ;
EXIT ;Exit code
+1 KILL ^TMP("PXRMEPM",$JOB)
+2 KILL ^TMP("PXRMEPMH",$JOB)
+3 DO CLEAN^VALM10
+4 DO FULL^VALM1
+5 SET VALMBCK="Q"
+6 QUIT
+7 ;
HDR ; Header code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 QUIT
+3 ;
HLP ;Help code
+1 NEW ORU,ORUPRMT,SUB,XQORM
+2 SET SUB="PXRMEPMH"
+3 DO EN^VALM("PXRM EXTRACT HELP")
+4 QUIT
+5 ;
INIT ;Init
+1 SET VALMCNT=0
+2 QUIT
+3 ;
PEXIT ;PXRM EXCH MENU 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 ;
XQORM SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM EXTRACT DEFINITION SELECT ENTRY",0))_U_"1:"_VALMCNT
+1 SET XQORM("A")="Select Item: "
+2 QUIT
+3 ;
XSEL ;PXRM EXTRACT DEFINITION SELECT ENTRY validation
+1 NEW SEL,IEN
+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 IEN=^TMP("PXRMEPM",$JOB,"SEL",SEL)
+15 ;Display/Edit Extract Definition
+16 DO START^PXRMEPED(IEN)
+17 DO BLDLIST
+18 SET VALMBCK="R"
+19 QUIT
+20 ;
HELP(CALL) ;General help text routine
+1 NEW HTEXT
+2 IF CALL=1
Begin DoDot:1
+3 SET HTEXT(1)="Select DE to display or edit a definition."
+4 SET HTEXT(2)="Select ED to edit a definition"
End DoDot:1
+5 DO HELP^PXRMEUT(.HTEXT)
+6 QUIT
+7 ;
EPADD ;Add Rule Option
+1 ;Reset Screen Mode
+2 WRITE IORESET
+3 ;
+4 ;Add Rule
+5 DO ADD^PXRMEPED
+6 ;
+7 ;Rebuild Workfile
+8 DO BLDLIST
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
EPINQ ;Definition Inquiry - PXRM EXTRACT DEFINITION DISPLAY/EDIT entry
+1 NEW IND,LRIEN,VALMY
+2 DO EN^VALM2(XQORNOD(0))
+3 ;
+4 ;If there is no list quit.
+5 IF '$DATA(VALMY)
QUIT
+6 SET PXRMDONE=0
+7 SET IND=""
+8 FOR
SET IND=$ORDER(VALMY(IND))
if (+IND=0)!(PXRMDONE)
QUIT
Begin DoDot:1
+9 ;Get the ien.
+10 SET LRIEN=^TMP("PXRMEPM",$JOB,"SEL",IND)
+11 DO START^PXRMEPED(LRIEN)
End DoDot:1
+12 DO BLDLIST
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
PPLR ;Display rule set components
+1 ;used by [PXRM EXTRACT DEFINITION] template)
+2 NEW ACT,DATA,FIRST,IEN,LRDATA,LRIEN,SEQ,SUB
+3 SET IEN=$PIECE(X,U,2)
if 'IEN
QUIT
+4 WRITE !," Description: ",$PIECE($GET(^PXRM(810.4,IEN,0)),U,2)
+5 SET SEQ=""
SET FIRST=1
+6 FOR
SET SEQ=$ORDER(^PXRM(810.4,IEN,30,"B",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+7 SET SUB=$ORDER(^PXRM(810.4,IEN,30,"B",SEQ,""))
if 'SUB
QUIT
+8 SET DATA=$GET(^PXRM(810.4,IEN,30,SUB,0))
if DATA=""
QUIT
+9 SET LRIEN=$PIECE(DATA,U,2)
if LRIEN=""
QUIT
+10 SET ACT=$PIECE(DATA,U,3)
SET LRDATA=$GET(^PXRM(810.4,LRIEN,0))
+11 IF FIRST
WRITE !!,?2,"List Rules:"
SET FIRST=0
+12 WRITE !,?2,SEQ,?7,$PIECE(LRDATA,U),?66
+13 WRITE $SELECT(ACT="A":"ADD PATIENT",ACT="R":"REMOVE PATIENT",ACT="F":"INSERT FINDING",1:"SELECT PATIENT")
+14 ;Display List Rule fields
+15 DO LROUT^PXRMLRED(LRIEN,23)
+16 WRITE !
End DoDot:1
+17 QUIT
+18 ;
PPFR ;Display counting rules and count type
+1 ;used by [PXRM EXTRACT DEFINITION] template)
+2 WRITE !
+3 NEW DATA,GIEN,GSTATUS,IEN,SEQ,SUB
+4 SET IEN=$PIECE(X,U,3)
if 'IEN
QUIT
+5 SET SEQ=""
+6 FOR
SET SEQ=$ORDER(^PXRM(810.7,IEN,10,"B",SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+7 SET SUB=$ORDER(^PXRM(810.7,IEN,10,"B",SEQ,""))
if 'SUB
QUIT
+8 SET DATA=$GET(^PXRM(810.7,IEN,10,SUB,0))
if DATA=""
QUIT
+9 SET GIEN=$PIECE(DATA,U,2)
if GIEN=""
QUIT
+10 SET GSTATUS=$PIECE(DATA,U,3)
+11 ;Get counting groups
+12 NEW CTYP,CTXT,DATA,EXCL,FIRST,GNAME,PNAME,TIEN,TNAME,GSEQ,GSUB
+13 SET DATA=$GET(^PXRM(810.8,GIEN,0))
SET GNAME=$PIECE(DATA,U)
+14 SET CTYP=$PIECE(DATA,U,3)
SET PNAME=$PIECE(DATA,U,2)
SET GSEQ=""
SET FIRST=1
+15 SET CTXT=$$TXT(CTYP,GSTATUS)
+16 FOR
SET GSEQ=$ORDER(^PXRM(810.8,GIEN,10,"B",GSEQ))
if GSEQ=""
QUIT
Begin DoDot:2
+17 SET GSUB=$ORDER(^PXRM(810.8,GIEN,10,"B",GSEQ,""))
if 'GSUB
QUIT
+18 SET DATA=$GET(^PXRM(810.8,GIEN,10,GSUB,0))
if DATA=""
QUIT
+19 SET TIEN=$PIECE(DATA,U,2)
if TIEN=""
QUIT
+20 SET EXCL=$PIECE(DATA,U,3)
if EXCL="E"
QUIT
+21 SET TNAME=$PIECE($GET(^PXRMD(811.5,TIEN,0)),U)
+22 IF FIRST
Begin DoDot:3
+23 WRITE !,?14,SEQ
+24 WRITE ?18,"Counting Group: ",GNAME
+25 WRITE !,?18,$$TXT(CTYP,GSTATUS)
+26 WRITE !,?23,"Terms:"
SET FIRST=0
End DoDot:3
+27 WRITE ?30,TNAME,!
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
SCREEN ;Screen for 810.210 field .02
+1 SET DIC("S")="I $P(^(0),U,3)=3"
+2 QUIT
+3 ;
TXT(COUNT,COHORT) ;Text to describe group
+1 NEW TXT
+2 ;Determine count type
+3 IF COUNT="MRFP"
SET TXT="Most recent finding patient counts for "
+4 IF COUNT="MRF"
SET TXT="Most recent finding counts for "
+5 IF COUNT="UR"
SET TXT="Utilization in period finding counts for "
+6 ;Error
+7 IF $GET(TXT)=""
QUIT "Unknown count type - error"
+8 ;Determine cohort
+9 SET TXT=TXT_$SELECT(COHORT="A":"APPLICABLE",1:"TOTAL")_" patients"
+10 QUIT TXT
