- 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 Jan 18, 2025@02:45:48 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