- 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
- 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.
- ;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
- ;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 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 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
- ..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
- ..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)=$$FRE(VALMCNT,RNAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE)
- .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
- .;Finding totals
- .I +FINDINGS>0 D FBLD(PATIENT)
- ;
- 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"
- 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
- ;
- 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
- ;
- 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
- ;
- 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 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
- ;
- 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
- ;
- 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
- ;
- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMETT 6917 printed Feb 18, 2025@23:11:04 Page 2
- PXRMETT ; SLC/PJH - Extract Summary Display ;04/09/2007
- +1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
- +2 ;
- +3 ;Main entry point for PXRM EXTRACT SUMMARY
- START(IEN) NEW TOGGLE,TOGGLE1,VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
- +1 SET X="IORESET"
- +2 DO ENDR^%ZISS
- +3 SET VALMCNT=0
- SET TOGGLE=0
- SET TOGGLE1=0
- +4 DO EN^VALM("PXRM EXTRACT SUMMARY")
- +5 QUIT
- +6 ;
- BLDLIST(IEN,FINDINGS,PATIENT) ;Build workfile.
- +1 ;FINDINGS=1 means display finding totals
- +2 KILL ^TMP("PXRMETT",$JOB)
- +3 ;Build a list of extract summary totals.
- +4 NEW APPL,DATA,DUE,IND,LIST,NDUE,NAPPL,OLIST
- +5 NEW PLCNT,PLIST,RIEN,RNAME,SARRAY,SEQ,SNAME,STATION,TOT
- +6 ;Build the list in alphabetical order.
- +7 SET VALMCNT=0
- SET OLIST=""
- SET PLCNT=0
- +8 SET IND=0
- FOR
- SET IND=$ORDER(^PXRMXT(810.3,IEN,3,IND))
- if IND'>0
- QUIT
- Begin DoDot:1
- +9 SET DATA=$GET(^PXRMXT(810.3,IEN,3,IND,0))
- if DATA=""
- QUIT
- +10 SET RIEN=$PIECE(DATA,U,2)
- if 'RIEN
- QUIT
- +11 SET RNAME=$PIECE(^PXD(811.9,RIEN,0),U,3)
- +12 IF RNAME=""
- SET RNAME=$PIECE(^PXD(811.9,RIEN,0),U,1)
- +13 SET STATION=$PIECE(DATA,U,3)
- SET SARRAY=""
- +14 DO GETS^DIQ(4,STATION,99,"E","SARRAY")
- +15 SET SNAME=$GET(SARRAY(4,STATION_",",99,"E"))
- +16 IF SNAME=""
- SET SNAME=STATION
- +17 SET TOT=+$PIECE(DATA,U,5)
- SET APPL=+$PIECE(DATA,U,6)
- SET NAPPL=+$PIECE(DATA,U,7)
- +18 SET DUE=+$PIECE(DATA,U,8)
- SET NDUE=+$PIECE(DATA,U,9)
- +19 SET PLIST=$PIECE(DATA,U,4)
- +20 IF PLIST
- IF PLIST'=OLIST
- Begin DoDot:2
- +21 IF PLCNT>0
- Begin DoDot:3
- +22 SET VALMCNT=VALMCNT+1
- +23 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=""
- +24 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- End DoDot:3
- +25 SET PLNAME=$PIECE($GET(^PXRMXP(810.5,PLIST,0)),U)
- SET OLIST=PLIST
- if PLNAME=""
- QUIT
- +26 SET VALMCNT=VALMCNT+1
- SET PLCNT=PLCNT+1
- +27 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- +28 SET ^TMP("PXRMETT",$JOB,"SEL",PLCNT)=PLIST
- +29 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=$$RJ^XLFSTR(PLCNT,4," ")_" "_PLNAME
- End DoDot:2
- +30 SET VALMCNT=VALMCNT+1
- +31 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=$$FRE(VALMCNT,RNAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE)
- +32 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- +33 ;Finding totals
- +34 IF +FINDINGS>0
- DO FBLD(PATIENT)
- End DoDot:1
- +35 ;
- +36 SET ^TMP("PXRMETT",$JOB,"VALMCNT")=VALMCNT
- +37 QUIT
- +38 ;
- ENTRY ;Entry code
- +1 DO BLDLIST(IEN,TOGGLE,TOGGLE1)
- DO XQORM
- +2 QUIT
- +3 ;
- EXIT ;Exit code
- +1 KILL ^TMP("PXRMETT",$JOB)
- +2 KILL ^TMP("PXRMETTH",$JOB)
- +3 DO CLEAN^VALM10
- +4 DO FULL^VALM1
- +5 SET VALMBCK="Q"
- +6 QUIT
- +7 ;
- FBLD(PATIENT) ;Build finding list
- +1 NEW APPL,DATA,DUE,ETYP,EVAL,GNAM,GTYP
- +2 NEW NAPPL,NDUE,OGNAM,SEQ,SUB,TIEN,TNAME,TOTAL
- +3 SET SUB=0
- SET OGNAM=""
- +4 FOR
- SET SUB=$ORDER(^PXRMXT(810.3,IEN,3,IND,1,SUB))
- if 'SUB
- QUIT
- Begin DoDot:1
- +5 SET DATA=$GET(^PXRMXT(810.3,IEN,3,IND,1,SUB,0))
- if DATA=""
- QUIT
- +6 SET TIEN=$PIECE(DATA,U,2)
- if 'TIEN
- QUIT
- +7 SET TNAME=$PIECE($GET(^PXRMD(811.5,TIEN,0)),U)
- +8 SET SEQ=$PIECE(DATA,U)
- SET ETYP=$PIECE(DATA,U,3)
- SET GNAM=$PIECE(DATA,U,9)
- SET GTYP=$PIECE(DATA,U,10)
- +9 SET TOT=+$PIECE(DATA,U,4)
- SET APPL=+$PIECE(DATA,U,5)
- SET NAPPL=+$PIECE(DATA,U,6)
- +10 SET DUE=+$PIECE(DATA,U,7)
- SET NDUE=+$PIECE(DATA,U,8)
- +11 IF OGNAM'=GNAM
- Begin DoDot:2
- +12 IF OGNAM'=""
- Begin DoDot:3
- +13 SET VALMCNT=VALMCNT+1
- +14 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=""
- +15 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- End DoDot:3
- +16 SET OGNAM=GNAM
- SET VALMCNT=VALMCNT+1
- +17 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=$$RJ^XLFSTR("Counting Group: ",21)_GNAM
- +18 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- SET VALMCNT=VALMCNT+1
- +19 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=$JUSTIFY("",6)_$$LJ^XLFSTR($$TXT^PXRMEPM(ETYP,GTYP),49)
- +20 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- End DoDot:2
- +21 SET VALMCNT=VALMCNT+1
- +22 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=$$FREF(VALMCNT,TNAME,SEQ,TOT,APPL,NAPPL,DUE,NDUE,ETYP)
- +23 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- +24 IF +PATIENT>0
- DO PBLD(IEN,IND,SUB)
- End DoDot:1
- +25 SET VALMCNT=VALMCNT+1
- +26 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=""
- +27 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- +28 QUIT
- +29 ;
- FLIST ;Toggle list with/without finding totals
- +1 SET TOGGLE=(TOGGLE+1)#2
- +2 IF TOGGLE=0
- SET TOGGLE1=0
- +3 ;Rebuild Workfile
- +4 DO BLDLIST(IEN,TOGGLE,TOGGLE1)
- +5 ;Refresh
- +6 SET VALMBCK="R"
- SET VALMBG=1
- +7 QUIT
- +8 ;
- FRE(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE) ;Format reminder entry
- +1 NEW TEMP,TNAME,TSOURCE
- +2 SET TEMP=" "
- +3 SET TNAME=SNAME_"/"_$EXTRACT(NAME,1,35-$LENGTH(SNAME))
- +4 SET TEMP=TEMP_$$LJ^XLFSTR(TNAME,36," ")
- +5 SET TEMP=TEMP_$$RJ^XLFSTR(TOT,8," ")
- +6 SET TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ")
- +7 SET TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ")
- +8 SET TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ")
- +9 SET TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ")
- +10 QUIT TEMP
- +11 ;
- FREF(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE,ETYP) ;Format finding entry
- +1 NEW TEMP,TNAME,TSOURCE
- +2 SET TEMP=" "
- +3 SET TNAME=$EXTRACT(NAME,1,31)
- +4 SET TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,31," ")
- +5 SET TEMP=TEMP_" "_$$RJ^XLFSTR(TOT,8," ")
- +6 IF ETYP'="FC"
- Begin DoDot:1
- +7 SET TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ")
- +8 SET TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ")
- +9 SET TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ")
- +10 SET TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ")
- End DoDot:1
- +11 QUIT TEMP
- +12 ;
- HDR ; Header code
- +1 SET VALMHDR(1)="Extract Summary Name: "_$PIECE($GET(^PXRMXT(810.3,IEN,0)),U)
- +2 SET VALMHDR(2)=" Extract Period: "_$$FMTE^XLFDT($PIECE($GET(^PXRMXT(810.3,IEN,0)),U,2),"5Z")_" - "_$$FMTE^XLFDT($PIECE($GET(^PXRMXT(810.3,IEN,0)),U,3),"5Z")
- +3 SET VALMHDR(2)=VALMHDR(2)_" Created: "_$$FMTE^XLFDT($PIECE($GET(^PXRMXT(810.3,IEN,0)),U,6),"5Z")
- +4 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- +5 QUIT
- +6 ;
- HLP ;Help code
- +1 NEW ORU,ORUPRMT,XQORM
- +2 SET SUB="PXRMETTH"
- +3 DO EN^VALM("PXRM EXTRACT HELP")
- +4 QUIT
- +5 ;
- INIT ;Init
- +1 SET VALMCNT=0
- +2 QUIT
- +3 ;
- PBLD(IEN,IND,SUB) ;
- +1 NEW ARRAY,NAME,LEN,PCNT,DFN,CNT,USTR
- +2 SET VALMCNT=VALMCNT+1
- SET CNT=0
- +3 SET PCNT=0
- FOR
- SET PCNT=$ORDER(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT))
- if PCNT'>0
- QUIT
- Begin DoDot:1
- +4 SET DFN=$PIECE($GET(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT,0)),U)
- if DFN'>0
- QUIT
- +5 SET NAME=$PIECE($GET(^DPT(DFN,0)),U)
- +6 SET CNT=CNT+1
- SET ARRAY(NAME)=""
- End DoDot:1
- +7 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=" "_$$RJ^XLFSTR("Unique Applicable Patients ("_CNT_")",36," ")
- +8 SET USTR=$PIECE($GET(^TMP("PXRMETT",$JOB,VALMCNT,0)),"U")
- SET LEN=$LENGTH(USTR)
- +9 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- +10 SET NAME=""
- FOR
- SET NAME=$ORDER(ARRAY(NAME))
- if NAME=""
- QUIT
- Begin DoDot:1
- +11 SET VALMCNT=VALMCNT+1
- +12 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=USTR_$$LJ^XLFSTR(NAME,36," ")
- +13 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- End DoDot:1
- +14 SET VALMCNT=VALMCNT+1
- +15 SET ^TMP("PXRMETT",$JOB,VALMCNT,0)=" "
- +16 SET ^TMP("PXRMETT",$JOB,"IDX",VALMCNT,PLCNT)=""
- +17 QUIT
- +18 ;
- PEXIT ;Protocol exit code
- +1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- +2 DO XQORM
- +3 QUIT
- +4 ;
- PLIST(IEN) ;Patient list display
- +1 NEW IND,PLIEN,VALMY
- +2 DO EN^VALM2(XQORNOD(0))
- +3 ;If there is no list quit.
- +4 IF '$DATA(VALMY)
- QUIT
- +5 ;PXRMDONE is newed in PXRMLPM
- +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 PLIEN=^TMP("PXRMETT",$JOB,"SEL",IND)
- +11 DO START^PXRMLPP(PLIEN)
- End DoDot:1
- +12 SET VALMBCK="R"
- +13 QUIT
- +14 ;
- PLIST1 ;Toggle list with/without finding totals
- +1 SET TOGGLE1=(TOGGLE1+1)#2
- +2 ;Rebuild Workfile
- +3 DO BLDLIST(IEN,TOGGLE,TOGGLE1)
- +4 ;Refresh
- +5 SET VALMBCK="R"
- SET VALMBG=1
- +6 QUIT
- +7 ;
- XQORM SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM EXTRACT SUMMARY SELECT ENTRY",0))_U_"1:"_VALMCNT
- +1 SET XQORM("A")="Select Item: "
- +2 QUIT
- +3 ;
- XSEL ;PXRM EXTRACT TOTALS SELECT ENTRY validation
- +1 NEW SEL,PLIEN
- +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 ;Get the list ien.
- +13 SET PLIEN=^TMP("PXRMETT",$JOB,"SEL",SEL)
- +14 DO START^PXRMLPP(PLIEN)
- +15 SET VALMBCK="R"
- +16 QUIT
- +17 ;