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"
 D ENDR^%ZISS
 S VALMCNT=0,TOGGLE=0,TOGGLE1=0
 D EN^VALM("PXRM EXTRACT SUMMARY")
 Q
 ;
BLDLIST(IEN,FINDINGS,PATIENT) ;Build workfile.
 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,SNAME,STATION,TOT
 ;Build the list in alphabetical order.
 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($G(^PXD(811.9,RIEN,0)),U)
 .S STATION=$P(DATA,U,3),SARRAY=""
 .D GETS^DIQ(4,STATION,99,"E","SARRAY")
 .S SNAME=$G(SARRAY(4,STATION_",",99,"E"))
 .I SNAME="" S SNAME=STATION
 .S TOT=+$P(DATA,U,5),APPL=+$P(DATA,U,6),NAPPL=+$P(DATA,U,7)
 .S DUE=+$P(DATA,U,8),NDUE=+$P(DATA,U,9)
 .S PLIST=$P(DATA,U,4)
 .I PLIST,PLIST'=OLIST D
 ..S PLNAME=$P($G(^PXRMXP(810.5,PLIST,0)),U),OLIST=PLIST Q:PLNAME=""
 ..S VALMCNT=VALMCNT+1,PLCNT=PLCNT+1
 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
 ..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
 .I +FINDINGS>0 D FBLD(PATIENT)
 ;
 S ^TMP("PXRMETT",$J,"VALMCNT")=VALMCNT
 ;M ^TMP("PXRMETT",$J)=LIST
 Q
 ;
FBLD(PATIENT) ;Build finding list
 N APPL,DATA,DUE,ETYP,EVAL,GNAM,GTYP
 N NAPPL,NDUE,OGNAM,SEQ,SUB,TIEN,TNAME,TOTAL
 S SUB=0,OGNAM=""
 F  S SUB=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB)) Q:'SUB  D
 .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,1,SUB,0)) Q:DATA=""
 .S TIEN=$P(DATA,U,2) Q:'TIEN
 .S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U)
 .S SEQ=$P(DATA,U),ETYP=$P(DATA,U,3),GNAM=$P(DATA,U,9),GTYP=$P(DATA,U,10)
 .S TOT=+$P(DATA,U,4),APPL=+$P(DATA,U,5),NAPPL=+$P(DATA,U,6)
 .S DUE=+$P(DATA,U,7),NDUE=+$P(DATA,U,8)
 .I OGNAM'=GNAM D
 ..I OGNAM'="" D
 ...S VALMCNT=VALMCNT+1
 ...S ^TMP("PXRMETT",$J,VALMCNT,0)=""
 ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
 ..S OGNAM=GNAM,VALMCNT=VALMCNT+1
 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR("Counting Group: ",21)_GNAM
 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="",VALMCNT=VALMCNT+1
 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$J("",6)_$$LJ^XLFSTR($$TXT^PXRMEPM(ETYP,GTYP),49)
 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
 .S VALMCNT=VALMCNT+1
 .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FREF(VALMCNT,TNAME,SEQ,TOT,APPL,NAPPL,DUE,NDUE,ETYP)
 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
 .I +PATIENT>0 D PBLD(IEN,IND,SUB)
 S VALMCNT=VALMCNT+1
 S ^TMP("PXRMETT",$J,VALMCNT,0)=""
 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
 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)
 ;Refresh
 S VALMBCK="R",VALMBG=1
 Q
 ;
FRE(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE) ;Format reminder entry
 N TEMP,TNAME,TSOURCE
 S TEMP="     "
 S TNAME=SNAME_"/"_$E(NAME,1,35-$L(SNAME))
 S TEMP=TEMP_$$LJ^XLFSTR(TNAME,36," ")
 S TEMP=TEMP_$$RJ^XLFSTR(TOT,8," ")
 S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ")
 S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ")
 S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ")
 S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ")
 Q TEMP
 ;
FREF(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE,ETYP) ;Format finding entry
 N TEMP,TNAME,TSOURCE
 S TEMP="      "
 S TNAME=$E(NAME,1,31)
 S TEMP=TEMP_"  "_$$LJ^XLFSTR(TNAME,31," ")
 S TEMP=TEMP_"  "_$$RJ^XLFSTR(TOT,8," ")
 I ETYP'="FC" D
 .S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ")
 .S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ")
 .S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ")
 .S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ")
 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
 ;
HLP ;Help code
 N ORU,ORUPRMT,XQORM
 S SUB="PXRMETTH"
 D EN^VALM("PXRM EXTRACT HELP")
 Q
 ;
INIT ;Init
 S VALMCNT=0
 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
 ;
PEXIT ;Protocol exit code
 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
 D XQORM
 Q
 ;
PLIST(IEN) ;Patient list display
 N IND,PLIEN,VALMY
 D EN^VALM2(XQORNOD(0))
 ;If there is no list quit.
 I '$D(VALMY) Q
 ;PXRMDONE is newed in PXRMLPM
 S PXRMDONE=0
 S IND=""
 F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
 .;Get the ien.
 .S PLIEN=^TMP("PXRMETT",$J,"SEL",IND)
 .D START^PXRMLPP(PLIEN)
 ;
 S VALMBCK="R"
 Q