Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETT.m
r613 r623 1 PXRMETT ; SLC/PJH - Extract Summary Display ;04/09/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;Main entry point for PXRM EXTRACT SUMMARY 5 START(IEN) N TOGGLE,TOGGLE1,VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD 6 S X="IORESET" 7 D ENDR^%ZISS 8 S VALMCNT=0,TOGGLE=0,TOGGLE1=0 9 D EN^VALM("PXRM EXTRACT SUMMARY") 10 Q 11 ; 12 BLDLIST(IEN,FINDINGS,PATIENT) ;Build workfile. 13 ;FINDINGS=1 means display finding totals 14 K ^TMP("PXRMETT",$J) 15 ;Build a list of extract summary totals. 16 N APPL,DATA,DUE,IND,LIST,NDUE,NAPPL,OLIST 17 N PLCNT,PLIST,RIEN,RNAME,SARRAY,SEQ,SNAME,STATION,TOT 18 ;Build the list in alphabetical order. 19 S VALMCNT=0,OLIST="",PLCNT=0 20 S IND=0 F S IND=$O(^PXRMXT(810.3,IEN,3,IND)) Q:IND'>0 D 21 .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,0)) Q:DATA="" 22 .S RIEN=$P(DATA,U,2) Q:'RIEN 23 .S RNAME=$P(^PXD(811.9,RIEN,0),U,3) 24 .I RNAME="" S RNAME=$P(^PXD(811.9,RIEN,0),U,1) 25 .S STATION=$P(DATA,U,3),SARRAY="" 26 .D GETS^DIQ(4,STATION,99,"E","SARRAY") 27 .S SNAME=$G(SARRAY(4,STATION_",",99,"E")) 28 .I SNAME="" S SNAME=STATION 29 .S TOT=+$P(DATA,U,5),APPL=+$P(DATA,U,6),NAPPL=+$P(DATA,U,7) 30 .S DUE=+$P(DATA,U,8),NDUE=+$P(DATA,U,9) 31 .S PLIST=$P(DATA,U,4) 32 .I PLIST,PLIST'=OLIST D 33 ..I PLCNT>0 D 34 ...S VALMCNT=VALMCNT+1 35 ...S ^TMP("PXRMETT",$J,VALMCNT,0)="" 36 ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 37 ..S PLNAME=$P($G(^PXRMXP(810.5,PLIST,0)),U),OLIST=PLIST Q:PLNAME="" 38 ..S VALMCNT=VALMCNT+1,PLCNT=PLCNT+1 39 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 40 ..S ^TMP("PXRMETT",$J,"SEL",PLCNT)=PLIST 41 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR(PLCNT,4," ")_" "_PLNAME 42 .S VALMCNT=VALMCNT+1 43 .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FRE(VALMCNT,RNAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE) 44 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 45 .;Finding totals 46 .I +FINDINGS>0 D FBLD(PATIENT) 47 ; 48 S ^TMP("PXRMETT",$J,"VALMCNT")=VALMCNT 49 Q 50 ; 51 ENTRY ;Entry code 52 D BLDLIST(IEN,TOGGLE,TOGGLE1),XQORM 53 Q 54 ; 55 EXIT ;Exit code 56 K ^TMP("PXRMETT",$J) 57 K ^TMP("PXRMETTH",$J) 58 D CLEAN^VALM10 59 D FULL^VALM1 60 S VALMBCK="Q" 61 Q 62 ; 63 FBLD(PATIENT) ;Build finding list 64 N APPL,DATA,DUE,ETYP,EVAL,GNAM,GTYP 65 N NAPPL,NDUE,OGNAM,SEQ,SUB,TIEN,TNAME,TOTAL 66 S SUB=0,OGNAM="" 67 F S SUB=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB)) Q:'SUB D 68 .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,1,SUB,0)) Q:DATA="" 69 .S TIEN=$P(DATA,U,2) Q:'TIEN 70 .S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U) 71 .S SEQ=$P(DATA,U),ETYP=$P(DATA,U,3),GNAM=$P(DATA,U,9),GTYP=$P(DATA,U,10) 72 .S TOT=+$P(DATA,U,4),APPL=+$P(DATA,U,5),NAPPL=+$P(DATA,U,6) 73 .S DUE=+$P(DATA,U,7),NDUE=+$P(DATA,U,8) 74 .I OGNAM'=GNAM D 75 ..I OGNAM'="" D 76 ...S VALMCNT=VALMCNT+1 77 ...S ^TMP("PXRMETT",$J,VALMCNT,0)="" 78 ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 79 ..S OGNAM=GNAM,VALMCNT=VALMCNT+1 80 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR("Counting Group: ",21)_GNAM 81 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="",VALMCNT=VALMCNT+1 82 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$J("",6)_$$LJ^XLFSTR($$TXT^PXRMEPM(ETYP,GTYP),49) 83 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 84 .S VALMCNT=VALMCNT+1 85 .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FREF(VALMCNT,TNAME,SEQ,TOT,APPL,NAPPL,DUE,NDUE,ETYP) 86 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 87 .I +PATIENT>0 D PBLD(IEN,IND,SUB) 88 S VALMCNT=VALMCNT+1 89 S ^TMP("PXRMETT",$J,VALMCNT,0)="" 90 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 91 Q 92 ; 93 FLIST ;Toggle list with/without finding totals 94 S TOGGLE=(TOGGLE+1)#2 95 I TOGGLE=0 S TOGGLE1=0 96 ;Rebuild Workfile 97 D BLDLIST(IEN,TOGGLE,TOGGLE1) 98 ;Refresh 99 S VALMBCK="R",VALMBG=1 100 Q 101 ; 102 FRE(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE) ;Format reminder entry 103 N TEMP,TNAME,TSOURCE 104 S TEMP=" " 105 S TNAME=SNAME_"/"_$E(NAME,1,35-$L(SNAME)) 106 S TEMP=TEMP_$$LJ^XLFSTR(TNAME,36," ") 107 S TEMP=TEMP_$$RJ^XLFSTR(TOT,8," ") 108 S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ") 109 S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ") 110 S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ") 111 S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ") 112 Q TEMP 113 ; 114 FREF(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE,ETYP) ;Format finding entry 115 N TEMP,TNAME,TSOURCE 116 S TEMP=" " 117 S TNAME=$E(NAME,1,31) 118 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,31," ") 119 S TEMP=TEMP_" "_$$RJ^XLFSTR(TOT,8," ") 120 I ETYP'="FC" D 121 .S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ") 122 .S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ") 123 .S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ") 124 .S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ") 125 Q TEMP 126 ; 127 HDR ; Header code 128 S VALMHDR(1)="Extract Summary Name: "_$P($G(^PXRMXT(810.3,IEN,0)),U) 129 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") 130 S VALMHDR(2)=VALMHDR(2)_" Created: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,6),"5Z") 131 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 132 Q 133 ; 134 HLP ;Help code 135 N ORU,ORUPRMT,XQORM 136 S SUB="PXRMETTH" 137 D EN^VALM("PXRM EXTRACT HELP") 138 Q 139 ; 140 INIT ;Init 141 S VALMCNT=0 142 Q 143 ; 144 PBLD(IEN,IND,SUB) ; 145 N ARRAY,NAME,LEN,PCNT,DFN,CNT,USTR 146 S VALMCNT=VALMCNT+1,CNT=0 147 S PCNT=0 F S PCNT=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT)) Q:PCNT'>0 D 148 .S DFN=$P($G(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT,0)),U) Q:DFN'>0 149 .S NAME=$P($G(^DPT(DFN,0)),U) 150 .S CNT=CNT+1,ARRAY(NAME)="" 151 S ^TMP("PXRMETT",$J,VALMCNT,0)=" "_$$RJ^XLFSTR("Unique Applicable Patients ("_CNT_")",36," ") 152 S USTR=$P($G(^TMP("PXRMETT",$J,VALMCNT,0)),"U"),LEN=$L(USTR) 153 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 154 S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D 155 .S VALMCNT=VALMCNT+1 156 .S ^TMP("PXRMETT",$J,VALMCNT,0)=USTR_$$LJ^XLFSTR(NAME,36," ") 157 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 158 S VALMCNT=VALMCNT+1 159 S ^TMP("PXRMETT",$J,VALMCNT,0)=" " 160 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 161 Q 162 ; 163 PEXIT ;Protocol exit code 164 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 165 D XQORM 166 Q 167 ; 168 PLIST(IEN) ;Patient list display 169 N IND,PLIEN,VALMY 170 D EN^VALM2(XQORNOD(0)) 171 ;If there is no list quit. 172 I '$D(VALMY) Q 173 ;PXRMDONE is newed in PXRMLPM 174 S PXRMDONE=0 175 S IND="" 176 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D 177 .;Get the ien. 178 .S PLIEN=^TMP("PXRMETT",$J,"SEL",IND) 179 .D START^PXRMLPP(PLIEN) 180 S VALMBCK="R" 181 Q 182 ; 183 PLIST1 ;Toggle list with/without finding totals 184 S TOGGLE1=(TOGGLE1+1)#2 185 ;Rebuild Workfile 186 D BLDLIST(IEN,TOGGLE,TOGGLE1) 187 ;Refresh 188 S VALMBCK="R",VALMBG=1 189 Q 190 ; 191 XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT SUMMARY SELECT ENTRY",0))_U_"1:"_VALMCNT 192 S XQORM("A")="Select Item: " 193 Q 194 ; 195 XSEL ;PXRM EXTRACT TOTALS SELECT ENTRY validation 196 N SEL,PLIEN 197 S SEL=$P(XQORNOD(0),"=",2) 198 ;Remove trailing , 199 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1) 200 ;Invalid selection 201 I SEL["," D Q 202 .W $C(7),!,"Only one item number allowed." H 2 203 .S VALMBCK="R" 204 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q 205 .W $C(7),!,SEL_" is not a valid item number." H 2 206 .S VALMBCK="R" 207 ;Get the list ien. 208 S PLIEN=^TMP("PXRMETT",$J,"SEL",SEL) 209 D START^PXRMLPP(PLIEN) 210 S VALMBCK="R" 211 Q 212 ; 1 PXRMETT ; SLC/PKR/PJH - Reminder Patient List Patients ;08/08/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;Main entry point for PXRM PATIENT LIST 5 START(IEN) N TOGGLE,TOGGLE1,VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD 6 S X="IORESET" 7 D ENDR^%ZISS 8 S VALMCNT=0,TOGGLE=0,TOGGLE1=0 9 D EN^VALM("PXRM EXTRACT SUMMARY") 10 Q 11 ; 12 BLDLIST(IEN,FINDINGS,PATIENT) ;Build workfile. 13 K ^TMP("PXRMETT",$J) 14 ;Build a list of extract summary totals. 15 N APPL,DATA,DUE,IND,LIST,NDUE,NAPPL,OLIST 16 N PLCNT,PLIST,RIEN,RNAME,SARRAY,SNAME,STATION,TOT 17 ;Build the list in alphabetical order. 18 S IND=0,VALMCNT=0,OLIST="",PLCNT=0 19 F S IND=$O(^PXRMXT(810.3,IEN,3,IND)) Q:'IND D 20 .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,0)) Q:DATA="" 21 .S RIEN=$P(DATA,U,2) Q:'RIEN 22 .S RNAME=$P($G(^PXD(811.9,RIEN,0)),U) 23 .S STATION=$P(DATA,U,3),SARRAY="" 24 .D GETS^DIQ(4,STATION,99,"E","SARRAY") 25 .S SNAME=$G(SARRAY(4,STATION_",",99,"E")) 26 .I SNAME="" S SNAME=STATION 27 .S TOT=+$P(DATA,U,5),APPL=+$P(DATA,U,6),NAPPL=+$P(DATA,U,7) 28 .S DUE=+$P(DATA,U,8),NDUE=+$P(DATA,U,9) 29 .S PLIST=$P(DATA,U,4) 30 .I PLIST,PLIST'=OLIST D 31 ..S PLNAME=$P($G(^PXRMXP(810.5,PLIST,0)),U),OLIST=PLIST Q:PLNAME="" 32 ..S VALMCNT=VALMCNT+1,PLCNT=PLCNT+1 33 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 34 ..S ^TMP("PXRMETT",$J,"SEL",PLCNT)=PLIST 35 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR(PLCNT,4," ")_" "_PLNAME 36 ..S VALMCNT=VALMCNT+1 37 ..S ^TMP("PXRMETT",$J,VALMCNT,0)="" 38 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 39 .S VALMCNT=VALMCNT+1 40 .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FRE(VALMCNT,RNAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE) 41 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 42 .S VALMCNT=VALMCNT+1 43 .S ^TMP("PXRMETT",$J,VALMCNT,0)="" 44 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 45 .;Finding totals 46 .I +FINDINGS>0 D FBLD(PATIENT) 47 ; 48 S ^TMP("PXRMETT",$J,"VALMCNT")=VALMCNT 49 ;M ^TMP("PXRMETT",$J)=LIST 50 Q 51 ; 52 FBLD(PATIENT) ;Build finding list 53 N APPL,DATA,DUE,ETYP,EVAL,GNAM,GTYP 54 N NAPPL,NDUE,OGNAM,SEQ,SUB,TIEN,TNAME,TOTAL 55 S SUB=0,OGNAM="" 56 F S SUB=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB)) Q:'SUB D 57 .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,1,SUB,0)) Q:DATA="" 58 .S TIEN=$P(DATA,U,2) Q:'TIEN 59 .S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U) 60 .S SEQ=$P(DATA,U),ETYP=$P(DATA,U,3),GNAM=$P(DATA,U,9),GTYP=$P(DATA,U,10) 61 .S TOT=+$P(DATA,U,4),APPL=+$P(DATA,U,5),NAPPL=+$P(DATA,U,6) 62 .S DUE=+$P(DATA,U,7),NDUE=+$P(DATA,U,8) 63 .I OGNAM'=GNAM D 64 ..I OGNAM'="" D 65 ...S VALMCNT=VALMCNT+1 66 ...S ^TMP("PXRMETT",$J,VALMCNT,0)="" 67 ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 68 ..S OGNAM=GNAM,VALMCNT=VALMCNT+1 69 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR("Counting Group: ",21)_GNAM 70 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="",VALMCNT=VALMCNT+1 71 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$J("",6)_$$LJ^XLFSTR($$TXT^PXRMEPM(ETYP,GTYP),49) 72 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 73 .S VALMCNT=VALMCNT+1 74 .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FREF(VALMCNT,TNAME,SEQ,TOT,APPL,NAPPL,DUE,NDUE,ETYP) 75 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 76 .I +PATIENT>0 D PBLD(IEN,IND,SUB) 77 S VALMCNT=VALMCNT+1 78 S ^TMP("PXRMETT",$J,VALMCNT,0)="" 79 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 80 Q 81 ; 82 PBLD(IEN,IND,SUB) ; 83 N ARRAY,NAME,LEN,PCNT,DFN,CNT,USTR 84 S VALMCNT=VALMCNT+1,CNT=0 85 S PCNT=0 F S PCNT=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT)) Q:PCNT'>0 D 86 .S DFN=$P($G(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT,0)),U) Q:DFN'>0 87 .S NAME=$P($G(^DPT(DFN,0)),U) 88 .S CNT=CNT+1,ARRAY(NAME)="" 89 S ^TMP("PXRMETT",$J,VALMCNT,0)=" "_$$RJ^XLFSTR("Unique Applicable Patients ("_CNT_")",36," ") 90 S USTR=$P($G(^TMP("PXRMETT",$J,VALMCNT,0)),"U"),LEN=$L(USTR) 91 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 92 S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D 93 .S VALMCNT=VALMCNT+1 94 .S ^TMP("PXRMETT",$J,VALMCNT,0)=USTR_$$LJ^XLFSTR(NAME,36," ") 95 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 96 S VALMCNT=VALMCNT+1 97 S ^TMP("PXRMETT",$J,VALMCNT,0)=" " 98 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="" 99 Q 100 ; 101 FLIST ;Toggle list with/without finding totals 102 S TOGGLE=(TOGGLE+1)#2 103 I TOGGLE=0 S TOGGLE1=0 104 ;Rebuild Workfile 105 D BLDLIST(IEN,TOGGLE,TOGGLE1) 106 ;Refresh 107 S VALMBCK="R",VALMBG=1 108 Q 109 ; 110 PLIST1 ;Toggle list with/without finding totals 111 S TOGGLE1=(TOGGLE1+1)#2 112 ;Rebuild Workfile 113 D BLDLIST(IEN,TOGGLE,TOGGLE1) 114 ;Refresh 115 S VALMBCK="R",VALMBG=1 116 Q 117 ; 118 FRE(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE) ;Format reminder entry 119 N TEMP,TNAME,TSOURCE 120 S TEMP=" " 121 S TNAME=SNAME_"/"_$E(NAME,1,35-$L(SNAME)) 122 S TEMP=TEMP_$$LJ^XLFSTR(TNAME,36," ") 123 S TEMP=TEMP_$$RJ^XLFSTR(TOT,8," ") 124 S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ") 125 S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ") 126 S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ") 127 S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ") 128 Q TEMP 129 ; 130 FREF(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE,ETYP) ;Format finding entry 131 N TEMP,TNAME,TSOURCE 132 S TEMP=" " 133 S TNAME=$E(NAME,1,31) 134 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,31," ") 135 S TEMP=TEMP_" "_$$RJ^XLFSTR(TOT,8," ") 136 I ETYP'="FC" D 137 .S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ") 138 .S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ") 139 .S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ") 140 .S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ") 141 Q TEMP 142 ; 143 ENTRY ;Entry code 144 D BLDLIST(IEN,TOGGLE,TOGGLE1),XQORM 145 Q 146 ; 147 EXIT ;Exit code 148 K ^TMP("PXRMETT",$J) 149 K ^TMP("PXRMETTH",$J) 150 D CLEAN^VALM10 151 D FULL^VALM1 152 S VALMBCK="Q" 153 Q 154 ; 155 HDR ; Header code 156 S VALMHDR(1)="Extract Summary Name: "_$P($G(^PXRMXT(810.3,IEN,0)),U) 157 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") 158 S VALMHDR(2)=VALMHDR(2)_" Created: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,6),"5Z") 159 ;S VALMHDR(3)=VALMHDR(3)_" Transmitted: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,4),"5Z") 160 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 161 Q 162 ; 163 HLP ;Help code 164 N ORU,ORUPRMT,XQORM 165 S SUB="PXRMETTH" 166 D EN^VALM("PXRM EXTRACT HELP") 167 Q 168 ; 169 INIT ;Init 170 S VALMCNT=0 171 Q 172 ; 173 XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT SUMMARY SELECT ENTRY",0))_U_"1:"_VALMCNT 174 S XQORM("A")="Select Item: " 175 Q 176 ; 177 XSEL ;PXRM EXTRACT TOTALS SELECT ENTRY validation 178 N SEL,PLIEN 179 S SEL=$P(XQORNOD(0),"=",2) 180 ;Remove trailing , 181 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1) 182 ;Invalid selection 183 I SEL["," D Q 184 .W $C(7),!,"Only one item number allowed." H 2 185 .S VALMBCK="R" 186 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q 187 .W $C(7),!,SEL_" is not a valid item number." H 2 188 .S VALMBCK="R" 189 ; 190 ;Get the list ien. 191 S PLIEN=^TMP("PXRMETT",$J,"SEL",SEL) 192 ; 193 D START^PXRMLPP(PLIEN) 194 ; 195 S VALMBCK="R" 196 Q 197 ; 198 PEXIT ;Protocol exit code 199 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 200 D XQORM 201 Q 202 ; 203 PLIST(IEN) ;Patient list display 204 N IND,PLIEN,VALMY 205 D EN^VALM2(XQORNOD(0)) 206 ;If there is no list quit. 207 I '$D(VALMY) Q 208 ;PXRMDONE is newed in PXRMLPM 209 S PXRMDONE=0 210 S IND="" 211 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D 212 .;Get the ien. 213 .S PLIEN=^TMP("PXRMETT",$J,"SEL",IND) 214 .D START^PXRMLPP(PLIEN) 215 ; 216 S VALMBCK="R" 217 Q
Note:
See TracChangeset
for help on using the changeset viewer.
