Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMETT.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CLINICAL_REMINDERS-PXRM/PXRMETT.m (modified) (9 diffs)

FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMETT.m

@@ -1 @@
-PXRMETT ; SLC/PJH - Extract Summary Display ;04/09/2007
- ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
- ;
- ;Main entry point for PXRM EXTRACT SUMMARY
+PXRMETT ; SLC/PKR/PJH - Reminder Patient List Patients ;08/08/2006
+ ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+ ;
+ ;Main entry point for PXRM PATIENT LIST
 START(IEN) N TOGGLE,TOGGLE1,VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
  S X="IORESET"
@@ -11 +11 @@
  ;
 BLDLIST(IEN,FINDINGS,PATIENT) ;Build workfile.
- ;FINDINGS=1 means display finding totals
  K ^TMP("PXRMETT",$J)
  ;Build a list of extract summary totals.
  N APPL,DATA,DUE,IND,LIST,NDUE,NAPPL,OLIST
- N PLCNT,PLIST,RIEN,RNAME,SARRAY,SEQ,SNAME,STATION,TOT
+ N PLCNT,PLIST,RIEN,RNAME,SARRAY,SNAME,STATION,TOT
  ;Build the list in alphabetical order.
- S VALMCNT=0,OLIST="",PLCNT=0
- S IND=0 F  S IND=$O(^PXRMXT(810.3,IEN,3,IND)) Q:IND'>0  D
+ S IND=0,VALMCNT=0,OLIST="",PLCNT=0
+ F  S IND=$O(^PXRMXT(810.3,IEN,3,IND)) Q:'IND  D
  .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,0)) Q:DATA=""
  .S RIEN=$P(DATA,U,2) Q:'RIEN
- .S RNAME=$P(^PXD(811.9,RIEN,0),U,3)
- .I RNAME="" S RNAME=$P(^PXD(811.9,RIEN,0),U,1)
+ .S RNAME=$P($G(^PXD(811.9,RIEN,0)),U)
  .S STATION=$P(DATA,U,3),SARRAY=""
  .D GETS^DIQ(4,STATION,99,"E","SARRAY")
@@ -31 +29 @@
  .S PLIST=$P(DATA,U,4)
  .I PLIST,PLIST'=OLIST D
- ..I PLCNT>0 D
- ...S VALMCNT=VALMCNT+1
- ...S ^TMP("PXRMETT",$J,VALMCNT,0)=""
- ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  ..S PLNAME=$P($G(^PXRMXP(810.5,PLIST,0)),U),OLIST=PLIST Q:PLNAME=""
  ..S VALMCNT=VALMCNT+1,PLCNT=PLCNT+1
@@ -40 +34 @@
  ..S ^TMP("PXRMETT",$J,"SEL",PLCNT)=PLIST
  ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR(PLCNT,4," ")_" "_PLNAME
+ ..S VALMCNT=VALMCNT+1
+ ..S ^TMP("PXRMETT",$J,VALMCNT,0)=""
+ ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  .S VALMCNT=VALMCNT+1
  .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FRE(VALMCNT,RNAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE)
+ .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
+ .S VALMCNT=VALMCNT+1
+ .S ^TMP("PXRMETT",$J,VALMCNT,0)=""
  .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  .;Finding totals
@@ -47 +47 @@
  ;
  S ^TMP("PXRMETT",$J,"VALMCNT")=VALMCNT
- Q
- ;
-ENTRY ;Entry code
- D BLDLIST(IEN,TOGGLE,TOGGLE1),XQORM
- Q
- ;
-EXIT ;Exit code
- K ^TMP("PXRMETT",$J)
- K ^TMP("PXRMETTH",$J)
- D CLEAN^VALM10
- D FULL^VALM1
- S VALMBCK="Q"
+ ;M ^TMP("PXRMETT",$J)=LIST
  Q
  ;
@@ -91 +80 @@
  Q
  ;
+PBLD(IEN,IND,SUB) ;
+ N ARRAY,NAME,LEN,PCNT,DFN,CNT,USTR
+ S VALMCNT=VALMCNT+1,CNT=0
+ S PCNT=0 F  S PCNT=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT)) Q:PCNT'>0  D
+ .S DFN=$P($G(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT,0)),U) Q:DFN'>0
+ .S NAME=$P($G(^DPT(DFN,0)),U)
+ .S CNT=CNT+1,ARRAY(NAME)=""
+ S ^TMP("PXRMETT",$J,VALMCNT,0)="     "_$$RJ^XLFSTR("Unique Applicable Patients ("_CNT_")",36," ")
+ S USTR=$P($G(^TMP("PXRMETT",$J,VALMCNT,0)),"U"),LEN=$L(USTR)
+ S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
+ S NAME="" F  S NAME=$O(ARRAY(NAME)) Q:NAME=""  D
+ .S VALMCNT=VALMCNT+1
+ .S ^TMP("PXRMETT",$J,VALMCNT,0)=USTR_$$LJ^XLFSTR(NAME,36," ")
+ .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
+ S VALMCNT=VALMCNT+1
+ S ^TMP("PXRMETT",$J,VALMCNT,0)="  "
+ S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
+ Q
+ ;
 FLIST ;Toggle list with/without finding totals
  S TOGGLE=(TOGGLE+1)#2
  I TOGGLE=0 S TOGGLE1=0
+ ;Rebuild Workfile
+ D BLDLIST(IEN,TOGGLE,TOGGLE1)
+ ;Refresh
+ S VALMBCK="R",VALMBG=1
+ Q
+ ;
+PLIST1 ;Toggle list with/without finding totals
+ S TOGGLE1=(TOGGLE1+1)#2
  ;Rebuild Workfile
  D BLDLIST(IEN,TOGGLE,TOGGLE1)
@@ -125 +141 @@
  Q TEMP
  ;
+ENTRY ;Entry code
+ D BLDLIST(IEN,TOGGLE,TOGGLE1),XQORM
+ Q
+ ;
+EXIT ;Exit code
+ K ^TMP("PXRMETT",$J)
+ K ^TMP("PXRMETTH",$J)
+ D CLEAN^VALM10
+ D FULL^VALM1
+ S VALMBCK="Q"
+ Q
+ ;
 HDR ; Header code
  S VALMHDR(1)="Extract Summary Name: "_$P($G(^PXRMXT(810.3,IEN,0)),U)
  S VALMHDR(2)="      Extract Period: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,2),"5Z")_" - "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,3),"5Z")
  S VALMHDR(2)=VALMHDR(2)_"   Created: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,6),"5Z")
+ ;S VALMHDR(3)=VALMHDR(3)_"        Transmitted: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,4),"5Z")
  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  Q
@@ -142 +171 @@
  Q
  ;
-PBLD(IEN,IND,SUB) ;
- N ARRAY,NAME,LEN,PCNT,DFN,CNT,USTR
- S VALMCNT=VALMCNT+1,CNT=0
- S PCNT=0 F  S PCNT=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT)) Q:PCNT'>0  D
- .S DFN=$P($G(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT,0)),U) Q:DFN'>0
- .S NAME=$P($G(^DPT(DFN,0)),U)
- .S CNT=CNT+1,ARRAY(NAME)=""
- S ^TMP("PXRMETT",$J,VALMCNT,0)="     "_$$RJ^XLFSTR("Unique Applicable Patients ("_CNT_")",36," ")
- S USTR=$P($G(^TMP("PXRMETT",$J,VALMCNT,0)),"U"),LEN=$L(USTR)
- S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
- S NAME="" F  S NAME=$O(ARRAY(NAME)) Q:NAME=""  D
- .S VALMCNT=VALMCNT+1
- .S ^TMP("PXRMETT",$J,VALMCNT,0)=USTR_$$LJ^XLFSTR(NAME,36," ")
- .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
- S VALMCNT=VALMCNT+1
- S ^TMP("PXRMETT",$J,VALMCNT,0)="  "
- S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
+XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT SUMMARY SELECT ENTRY",0))_U_"1:"_VALMCNT
+ S XQORM("A")="Select Item: "
+ Q
+ ;
+XSEL ;PXRM EXTRACT TOTALS SELECT ENTRY validation
+ N SEL,PLIEN
+ 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 PLIEN=^TMP("PXRMETT",$J,"SEL",SEL)
+ ;
+ D START^PXRMLPP(PLIEN)
+ ;
+ S VALMBCK="R"
  Q
  ;
@@ -178 +213 @@
  .S PLIEN=^TMP("PXRMETT",$J,"SEL",IND)
  .D START^PXRMLPP(PLIEN)
+ ;
  S VALMBCK="R"
  Q
- ;
-PLIST1 ;Toggle list with/without finding totals
- S TOGGLE1=(TOGGLE1+1)#2
- ;Rebuild Workfile
- D BLDLIST(IEN,TOGGLE,TOGGLE1)
- ;Refresh
- S VALMBCK="R",VALMBG=1
- Q
- ;
-XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT SUMMARY SELECT ENTRY",0))_U_"1:"_VALMCNT
- S XQORM("A")="Select Item: "
- Q
- ;
-XSEL ;PXRM EXTRACT TOTALS SELECT ENTRY validation
- N SEL,PLIEN
- 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 PLIEN=^TMP("PXRMETT",$J,"SEL",SEL)
- D START^PXRMLPP(PLIEN)
- S VALMBCK="R"
- Q
- ;