Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMETT

PXRMETT.m

Go to the documentation of this file.
  1. PXRMETT ; SLC/PJH - Extract Summary Display ;04/09/2007
  1. ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
  1. ;
  1. ;Main entry point for PXRM EXTRACT SUMMARY
  1. START(IEN) N TOGGLE,TOGGLE1,VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
  1. S X="IORESET"
  1. D ENDR^%ZISS
  1. S VALMCNT=0,TOGGLE=0,TOGGLE1=0
  1. D EN^VALM("PXRM EXTRACT SUMMARY")
  1. Q
  1. ;
  1. BLDLIST(IEN,FINDINGS,PATIENT) ;Build workfile.
  1. ;FINDINGS=1 means display finding totals
  1. K ^TMP("PXRMETT",$J)
  1. ;Build a list of extract summary totals.
  1. N APPL,DATA,DUE,IND,LIST,NDUE,NAPPL,OLIST
  1. N PLCNT,PLIST,RIEN,RNAME,SARRAY,SEQ,SNAME,STATION,TOT
  1. ;Build the list in alphabetical order.
  1. S VALMCNT=0,OLIST="",PLCNT=0
  1. S IND=0 F S IND=$O(^PXRMXT(810.3,IEN,3,IND)) Q:IND'>0 D
  1. .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,0)) Q:DATA=""
  1. .S RIEN=$P(DATA,U,2) Q:'RIEN
  1. .S RNAME=$P(^PXD(811.9,RIEN,0),U,3)
  1. .I RNAME="" S RNAME=$P(^PXD(811.9,RIEN,0),U,1)
  1. .S STATION=$P(DATA,U,3),SARRAY=""
  1. .D GETS^DIQ(4,STATION,99,"E","SARRAY")
  1. .S SNAME=$G(SARRAY(4,STATION_",",99,"E"))
  1. .I SNAME="" S SNAME=STATION
  1. .S TOT=+$P(DATA,U,5),APPL=+$P(DATA,U,6),NAPPL=+$P(DATA,U,7)
  1. .S DUE=+$P(DATA,U,8),NDUE=+$P(DATA,U,9)
  1. .S PLIST=$P(DATA,U,4)
  1. .I PLIST,PLIST'=OLIST D
  1. ..I PLCNT>0 D
  1. ...S VALMCNT=VALMCNT+1
  1. ...S ^TMP("PXRMETT",$J,VALMCNT,0)=""
  1. ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. ..S PLNAME=$P($G(^PXRMXP(810.5,PLIST,0)),U),OLIST=PLIST Q:PLNAME=""
  1. ..S VALMCNT=VALMCNT+1,PLCNT=PLCNT+1
  1. ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. ..S ^TMP("PXRMETT",$J,"SEL",PLCNT)=PLIST
  1. ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR(PLCNT,4," ")_" "_PLNAME
  1. .S VALMCNT=VALMCNT+1
  1. .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FRE(VALMCNT,RNAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE)
  1. .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. .;Finding totals
  1. .I +FINDINGS>0 D FBLD(PATIENT)
  1. ;
  1. S ^TMP("PXRMETT",$J,"VALMCNT")=VALMCNT
  1. Q
  1. ;
  1. ENTRY ;Entry code
  1. D BLDLIST(IEN,TOGGLE,TOGGLE1),XQORM
  1. Q
  1. ;
  1. EXIT ;Exit code
  1. K ^TMP("PXRMETT",$J)
  1. K ^TMP("PXRMETTH",$J)
  1. D CLEAN^VALM10
  1. D FULL^VALM1
  1. S VALMBCK="Q"
  1. Q
  1. ;
  1. FBLD(PATIENT) ;Build finding list
  1. N APPL,DATA,DUE,ETYP,EVAL,GNAM,GTYP
  1. N NAPPL,NDUE,OGNAM,SEQ,SUB,TIEN,TNAME,TOTAL
  1. S SUB=0,OGNAM=""
  1. F S SUB=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB)) Q:'SUB D
  1. .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,1,SUB,0)) Q:DATA=""
  1. .S TIEN=$P(DATA,U,2) Q:'TIEN
  1. .S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U)
  1. .S SEQ=$P(DATA,U),ETYP=$P(DATA,U,3),GNAM=$P(DATA,U,9),GTYP=$P(DATA,U,10)
  1. .S TOT=+$P(DATA,U,4),APPL=+$P(DATA,U,5),NAPPL=+$P(DATA,U,6)
  1. .S DUE=+$P(DATA,U,7),NDUE=+$P(DATA,U,8)
  1. .I OGNAM'=GNAM D
  1. ..I OGNAM'="" D
  1. ...S VALMCNT=VALMCNT+1
  1. ...S ^TMP("PXRMETT",$J,VALMCNT,0)=""
  1. ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. ..S OGNAM=GNAM,VALMCNT=VALMCNT+1
  1. ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR("Counting Group: ",21)_GNAM
  1. ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="",VALMCNT=VALMCNT+1
  1. ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$J("",6)_$$LJ^XLFSTR($$TXT^PXRMEPM(ETYP,GTYP),49)
  1. ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. .S VALMCNT=VALMCNT+1
  1. .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FREF(VALMCNT,TNAME,SEQ,TOT,APPL,NAPPL,DUE,NDUE,ETYP)
  1. .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. .I +PATIENT>0 D PBLD(IEN,IND,SUB)
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("PXRMETT",$J,VALMCNT,0)=""
  1. S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. Q
  1. ;
  1. FLIST ;Toggle list with/without finding totals
  1. S TOGGLE=(TOGGLE+1)#2
  1. I TOGGLE=0 S TOGGLE1=0
  1. ;Rebuild Workfile
  1. D BLDLIST(IEN,TOGGLE,TOGGLE1)
  1. ;Refresh
  1. S VALMBCK="R",VALMBG=1
  1. Q
  1. ;
  1. FRE(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE) ;Format reminder entry
  1. N TEMP,TNAME,TSOURCE
  1. S TEMP=" "
  1. S TNAME=SNAME_"/"_$E(NAME,1,35-$L(SNAME))
  1. S TEMP=TEMP_$$LJ^XLFSTR(TNAME,36," ")
  1. S TEMP=TEMP_$$RJ^XLFSTR(TOT,8," ")
  1. S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ")
  1. S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ")
  1. S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ")
  1. S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ")
  1. Q TEMP
  1. ;
  1. FREF(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE,ETYP) ;Format finding entry
  1. N TEMP,TNAME,TSOURCE
  1. S TEMP=" "
  1. S TNAME=$E(NAME,1,31)
  1. S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,31," ")
  1. S TEMP=TEMP_" "_$$RJ^XLFSTR(TOT,8," ")
  1. I ETYP'="FC" D
  1. .S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ")
  1. .S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ")
  1. .S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ")
  1. .S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ")
  1. Q TEMP
  1. ;
  1. HDR ; Header code
  1. S VALMHDR(1)="Extract Summary Name: "_$P($G(^PXRMXT(810.3,IEN,0)),U)
  1. 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")
  1. S VALMHDR(2)=VALMHDR(2)_" Created: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,6),"5Z")
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. Q
  1. ;
  1. HLP ;Help code
  1. N ORU,ORUPRMT,XQORM
  1. S SUB="PXRMETTH"
  1. D EN^VALM("PXRM EXTRACT HELP")
  1. Q
  1. ;
  1. INIT ;Init
  1. S VALMCNT=0
  1. Q
  1. ;
  1. PBLD(IEN,IND,SUB) ;
  1. N ARRAY,NAME,LEN,PCNT,DFN,CNT,USTR
  1. S VALMCNT=VALMCNT+1,CNT=0
  1. S PCNT=0 F S PCNT=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT)) Q:PCNT'>0 D
  1. .S DFN=$P($G(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT,0)),U) Q:DFN'>0
  1. .S NAME=$P($G(^DPT(DFN,0)),U)
  1. .S CNT=CNT+1,ARRAY(NAME)=""
  1. S ^TMP("PXRMETT",$J,VALMCNT,0)=" "_$$RJ^XLFSTR("Unique Applicable Patients ("_CNT_")",36," ")
  1. S USTR=$P($G(^TMP("PXRMETT",$J,VALMCNT,0)),"U"),LEN=$L(USTR)
  1. S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
  1. .S VALMCNT=VALMCNT+1
  1. .S ^TMP("PXRMETT",$J,VALMCNT,0)=USTR_$$LJ^XLFSTR(NAME,36," ")
  1. .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("PXRMETT",$J,VALMCNT,0)=" "
  1. S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
  1. Q
  1. ;
  1. PEXIT ;Protocol exit code
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. D XQORM
  1. Q
  1. ;
  1. PLIST(IEN) ;Patient list display
  1. N IND,PLIEN,VALMY
  1. D EN^VALM2(XQORNOD(0))
  1. ;If there is no list quit.
  1. I '$D(VALMY) Q
  1. ;PXRMDONE is newed in PXRMLPM
  1. S PXRMDONE=0
  1. S IND=""
  1. F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
  1. .;Get the ien.
  1. .S PLIEN=^TMP("PXRMETT",$J,"SEL",IND)
  1. .D START^PXRMLPP(PLIEN)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. PLIST1 ;Toggle list with/without finding totals
  1. S TOGGLE1=(TOGGLE1+1)#2
  1. ;Rebuild Workfile
  1. D BLDLIST(IEN,TOGGLE,TOGGLE1)
  1. ;Refresh
  1. S VALMBCK="R",VALMBG=1
  1. Q
  1. ;
  1. XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT SUMMARY SELECT ENTRY",0))_U_"1:"_VALMCNT
  1. S XQORM("A")="Select Item: "
  1. Q
  1. ;
  1. XSEL ;PXRM EXTRACT TOTALS SELECT ENTRY validation
  1. N SEL,PLIEN
  1. S SEL=$P(XQORNOD(0),"=",2)
  1. ;Remove trailing ,
  1. I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
  1. ;Invalid selection
  1. I SEL["," D Q
  1. .W $C(7),!,"Only one item number allowed." H 2
  1. .S VALMBCK="R"
  1. I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
  1. .W $C(7),!,SEL_" is not a valid item number." H 2
  1. .S VALMBCK="R"
  1. ;Get the list ien.
  1. S PLIEN=^TMP("PXRMETT",$J,"SEL",SEL)
  1. D START^PXRMLPP(PLIEN)
  1. S VALMBCK="R"
  1. Q
  1. ;