- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPMP0.m
r613 r623 1 PSOPMP0 ;BIRM/MFR - Patient Medication Profile - Listmanager ;10/28/06 2 ;;7.0;OUTPATIENT PHARMACY;**260,281**;DEC 1997;Build 41 3 ;Reference to EN1^GMRADPT supported by IA #10099 4 ;Reference to EN6^GMRVUTL supported by IA #1120 5 ;Reference to ^PS(55 supported by DBIA 2228 6 ; 7 EN ; - Menu option entry point 8 N PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSIGDP,PSOSTSGP,PSOSTORD,PSORDCNT,PSOSTSEQ,PSORDSEQ,PSOCHNG 9 N GRPLN,DIC,Y,DFN,GRPLN,HIGHLN,LASTLINE,VALMCNT 10 ; 11 ; - Division selection 12 I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT 13 ; 14 ; - Patient selection 15 W !! S DIC=2,DIC(0)="QEAM" D ^DIC G EXIT:Y<0 S DFN=+Y 16 ; 17 S PSODFN=DFN D CHKADDR^PSOBAI(DFN,1,1) ;bad address flag/update 18 ; 19 D LST(PSOSITE,DFN) 20 Q 21 ; 22 LST(SITE,PSODFN) ; - ListManager entry point 23 ; Loading Division/User preferences 24 D LOAD^PSOPMPPF(SITE,DUZ) 25 ; 26 W !,"Please wait..." 27 D EN^VALM("PSO PMP MAIN") 28 D FULL^VALM1 29 G EXIT 30 ; 31 HDR ; - Header 32 N LINE,POS,LINE1,LINE2,LINE3,LINE4,WT,WTDT,HT,HTDT,VADM,DFN,PNAME,DOB,SEX,X,GMRAL,ADVREA 33 ; 34 K VADM S DFN=PSODFN D DEM^VADPT 35 S PNAME=VADM(1) 36 S DOB=$S(+VADM(3):$P(VADM(3),"^",2)_" ("_$G(VADM(4))_")",1:"UNKNOWN") 37 S SEX=$P(VADM(5),"^",2) 38 S (WT,X)="",GMRVSTR="WT" D EN6^GMRVUTL I X'="" S WT=$J($P(X,"^",8)/2.2,6,2),WTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1) 39 S (HT,X)="",GMRVSTR="HT" D EN6^GMRVUTL I X'="" S HT=$J($P(X,"^",8)*2.54,6,2),HTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1) 40 S LINE1=PNAME 41 S LINE1=$$ALLERGY^PSOPMP1(LINE1,DFN) 42 S LINE2=" PID: "_$P(VADM(2),"^",2),$E(LINE2,50)="HEIGHT(cm): "_$S(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE") 43 S LINE3=" DOB: "_DOB,$E(LINE3,50)="WEIGHT(kg): "_$S(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE") 44 S LINE4=" SEX: "_SEX,$E(LINE4,43)="EXP/CANCEL CUTOFF: "_PSOEXDCE_" DAYS" 45 ; 46 K VALMHDR S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2,VALMHDR(3)=LINE3,VALMHDR(4)=LINE4 47 ; 48 D SETHDR^PSOPMP1() 49 Q 50 ; 51 INIT ; - Populates the Body section for ListMan 52 K ^TMP("PSOPMP0",$J) 53 ; 54 D SETSORT(PSOSRTBY),SETLINE 55 S VALMSG="Select the entry # to view or ?? for more actions" 56 Q 57 ; 58 SETLINE ; - Sets the line to be displayed in ListMan 59 N TYPE,STS,SUB,SEQ,LINE,Z,TOTAL,I,X,X1,ORDCNT,LBL,LN,IENSUB,GROUP,GRP,QTYL 60 I '$D(^TMP("PSOPMPSR",$J)) D Q 61 . F I=1:1:6 S ^TMP("PSOPMP0",$J,I,0)="" 62 . S ^TMP("PSOPMP0",$J,7,0)=" No prescriptions found for this patient." 63 . S VALMCNT=1 64 ; 65 ; - Resetting list to NORMAL video attributes 66 F I=1:1:$G(LASTLINE) D RESTORE^VALM10(I) 67 K GRPLN,HIGHLN 68 ; 69 ; - Building the list (line by line) 70 S (GROUP,STS,SUB)="",LINE=0 K ^TMP("PSOPMP0",$J) 71 F S GROUP=$O(^TMP("PSOPMPSR",$J,GROUP)) Q:GROUP="" D 72 . S GRP=$P(GROUP,"^") 73 . I GRP'["R"!('PSOSTSGP&($O(^TMP("PSOPMPSR",$J,GROUP),-1)'="")) D 74 . . D GROUP^PSOPMP1($P(GROUP,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP)),.LINE) 75 . F S STS=$O(^TMP("PSOPMPSR",$J,GROUP,STS)) Q:STS="" D 76 . . I STS'="<NULL>" D 77 . . . D GROUP^PSOPMP1($P(STS,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP,STS)),.LINE) 78 . . F S SUB=$O(^TMP("PSOPMPSR",$J,GROUP,STS,SUB),$S(PSORDER="A":1,1:-1)) Q:SUB="" D 79 . . . S Z=$G(^TMP("PSOPMPSR",$J,GROUP,STS,SUB)) 80 . . . S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3) 81 . . . S QTYL=$L($P(Z,"^",4)) S:QTYL<5 QTYL=5 82 . . . I GRP["R"!(GRP["T") S $E(X1,5)=$P(Z,"^",2),$E(X1,19)=$E($P(Z,"^",3),1,(32-QTYL)) 83 . . . I GRP["P"!(GRP["N") S $E(X1,5)=$P(Z,"^",3) 84 . . . I GRP["N" S $E(X1,49)="Date Documented:" 85 . . . I GRP'["N" S $E(X1,52-QTYL)=$J($P(Z,"^",4),QTYL),$E(X1,53)=$P(Z,"^",5),$E(X1,57)=$P(Z,"^",6) 86 . . . S $E(X1,66)=$P(Z,"^",7) 87 . . . S $E(X1,74)=$J($P(Z,"^",8),3),$E(X1,78)=$J($P(Z,"^",9),3) 88 . . . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X1,HIGHLN(LINE)="" 89 . . . S IENSUB=$S(GRP["R"!(GRP["T"):"RX",GRP["P":"PEN",1:"NVA") 90 . . . S ^TMP("PSOPMP0",$J,SEQ,IENSUB)=$P(Z,"^") 91 . . . I $G(PSOSIGDP) D SETSIG^PSOPMP1($S(GRP["R"!(GRP["T"):"R",GRP["P":"P",1:"N"),+Z,.LINE,PSODFN) 92 ; 93 ; - Saving NORMAL video attributes to be reset later 94 I LINE>$G(LASTLINE) D 95 . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I) 96 . S LASTLINE=LINE 97 ; 98 D VIDEO^PSOPMP1() 99 ; 100 S VALMCNT=+$G(LINE) 101 Q 102 ; 103 SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified 104 N SEQ,RX,RXNUM,DRUG,DRNAME,QTY,STATUS,STS,ISSDT,DOCDAT,LSTFD,REFREM,DAYSUP,SIG,Z,ORD,GRPCNT,GROUP,RFRX,OI,PSOBADR 105 ; 106 K ^TMP("PSOPMPSR",$J) 107 ; 108 ; - Loading prescription (file #55) 109 S SEQ=0 110 F S SEQ=$O(^PS(55,PSODFN,"P",SEQ)) Q:'SEQ D 111 . S RX=+$G(^PS(55,PSODFN,"P",SEQ,0)) I 'RX!($G(^PSRX(RX,0))="") Q 112 . I $$FILTER^PSOPMP1(RX) Q 113 . S RXNUM=$$GET1^DIQ(52,RX,.01) 114 . S DRUG=$$GET1^DIQ(52,RX,6,"I") 115 . S DRNAME=$$GET1^DIQ(50,DRUG,.01) 116 . S QTY=$$GET1^DIQ(52,RX,7) 117 . S STATUS=$$STSINFO^PSOPMP1(RX) 118 . S ISSDT=$$ISSDT^PSOPMP1(RX,"R") 119 . S LSTFD=$$LSTFD^PSOPMP1(RX) 120 . S REFREM=$$REFREM^PSOPMP1(RX) 121 . S DAYSUP=$$GET1^DIQ(52,RX,8) 122 . S PSOBADR=$O(^PSRX(RX,"L",9999),-1) 123 . I PSOBADR'="" S PSOBADR=$G(^PSRX(RX,"L",PSOBADR,0)) I PSOBADR["(BAD ADDRESS)" S PSOBADR="B" 124 . I PSOBADR'="B" S PSOBADR="" 125 . S Z="",$P(Z,"^")=RX,$P(Z,"^",2)=RXNUM_$$COPAY^PSOPMP1(RX)_$$ECME^PSOBPSUT(RX),$P(Z,"^",3)=$E(DRNAME,1,30) 126 . S $P(Z,"^",4)=QTY,$P(Z,"^",5)=$P(STATUS,"^",3)_$$CMOP^PSOPMP1(DRUG,RX)_PSOBADR,$P(Z,"^",6)=$P(ISSDT,"^",2) 127 . S $P(Z,"^",7)=$P(LSTFD,"^",2),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP 128 . S SORT=$S(FIELD="RX":RXNUM_" ",FIELD="DR":DRNAME_RXNUM,FIELD="ID":+ISSDT_RXNUM_" ",FIELD="LF":+LSTFD_RXNUM_" ") 129 . S STS="<NULL>" I $G(PSOSTSGP) S STS=$P(STATUS,"^")_"^"_$P(STATUS,"^",2) 130 . S GROUP=$P(PSORDSEQ("R"),"^")_"R^"_$P(PSORDSEQ("R"),"^",2) 131 . I $$FIND^PSOREJUT(RX) S GROUP=$P(PSORDSEQ("T"),"^")_"T^"_$P(PSORDSEQ("T"),"^",2),STS="<NULL>" 132 . S ^TMP("PSOPMPSR",$J,GROUP,STS,SORT)=Z 133 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1,GRPCNT(GROUP,STS)=$G(GRPCNT(GROUP,STS))+1 134 ; 135 S GROUP="" 136 F S GROUP=$O(GRPCNT(GROUP)) Q:GROUP="" D 137 . S ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP)) 138 . S STS="" F S STS=$O(GRPCNT(GROUP,STS)) Q:STS="" D 139 . . S ^TMP("PSOPMPSR",$J,GROUP,STS)=GRPCNT(GROUP,STS) 140 ; 141 ; - Loading pending orders (file #52.41) 142 S ORD=0,GROUP=$P(PSORDSEQ("P"),"^")_"P^"_$P(PSORDSEQ("P"),"^",2) 143 F S ORD=$O(^PS(52.41,"P",PSODFN,ORD)) Q:'ORD D 144 . S TYPE=$$GET1^DIQ(52.41,ORD,2,"I") 145 . I TYPE="DC"!(TYPE="DE")!(TYPE="HD") Q 146 . S DRNAME="",DRUG=+$$GET1^DIQ(52.41,ORD,11,"I") I DRUG S DRNAME=$$GET1^DIQ(50,DRUG,.01) 147 . I DRNAME="" D Q:DRNAME="" 148 . . S OI=$$GET1^DIQ(52.41,ORD,8,"I") I 'OI Q 149 . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02) 150 . S QTY=$$GET1^DIQ(52.41,ORD,12) 151 . S STATUS=$$GET1^DIQ(52.41,ORD,2,"I") 152 . S ISSDT=$$ISSDT^PSOPMP1(ORD,"P") 153 . S REFREM=$$GET1^DIQ(52.41,ORD,13) 154 . S DAYSUP=$$GET1^DIQ(52.41,ORD,101) 155 . S RFRX="" I STATUS="RF" S RFRX=$$GET1^DIQ(52.41,ORD,21,"I") I RFRX S RFRX=$$GET1^DIQ(52,RFRX,.01) 156 . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,45),$P(Z,"^",4)=QTY,$P(Z,"^",5)=$E(STATUS,1,2)_$$CMOP^PSOPMP1(DRUG) 157 . S $P(Z,"^",6)=$S(RFRX'="":"Rx#: "_RFRX,1:$P(ISSDT,"^",2)),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP 158 . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":+ISSDT_ORD,FIELD="LF":+ISSDT_ORD) 159 . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z 160 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1 161 ; 162 S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP)) 163 ; 164 ; - Loading Non-VA Med orders (file #55, sub-file #55.05) 165 S ORD=0,GROUP=$P(PSORDSEQ("N"),"^")_"N^"_$P(PSORDSEQ("N"),"^",2) 166 F S ORD=$O(^PS(55,PSODFN,"NVA",ORD)) Q:'ORD D 167 . I $$GET1^DIQ(55.05,ORD_","_PSODFN,5,"I") Q 168 . S DRNAME=$$GET1^DIQ(55.05,ORD_","_PSODFN,1) 169 . I DRNAME="" D Q:DRNAME="" 170 . . S OI=$$GET1^DIQ(55.05,ORD_","_PSODFN,.01,"I") I 'OI Q 171 . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02) 172 . S DOCDAT=$P($$GET1^DIQ(55.05,ORD_","_PSODFN_",",11,"I"),".") 173 . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,38),$P(Z,"^",7)=$$DAT^PSOPMP1(DOCDAT,"-") 174 . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":DOCDAT_ORD,FIELD="LF":DOCDAT_ORD) 175 . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z 176 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1 177 ; 178 S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP)) 179 ; 180 Q 181 ; 182 RX ; - Sort by Rx 183 D SORT("RX") 184 Q 185 DR ; - Sort by Drug 186 D SORT("DR") 187 Q 188 ID ; - Sort by Issue Date 189 D SORT("ID") 190 Q 191 LF ; - Sort by Last Fill Date 192 D SORT("LF") 193 Q 194 ; 195 SORT(FIELD) ; - Sort entries by FIELD 196 I PSOSRTBY=FIELD S PSORDER=$S(PSORDER="A":"D",1:"A") 197 E S PSOSRTBY=FIELD,PSORDER="A" 198 D REF 199 Q 200 ; 201 REF ; - Screen Refresh 202 W ?52,"Please wait..." D INIT,HDR S VALMBCK="R" 203 Q 204 GS ; - Group by Status 205 W ?52,"Please wait..." S PSOSTSGP=$S($G(PSOSTSGP):0,1:1) D INIT,HDR S VALMBCK="R" 206 Q 207 ; 208 SIG ; - Display SIG 209 W ?52,"Please wait..." S PSOSIGDP=$S($G(PSOSIGDP):0,1:1) D INIT,HDR S VALMBCK="R" 210 I 'PSOSIGDP S VALMBG=VALMBG\2 211 I PSOSIGDP S VALMBG=VALMBG*2-1 212 S:VALMBG>(VALMCNT-10) VALMBG=VALMCNT-10 S:VALMBG<1 VALMBG=1 213 Q 214 ; 215 PI ; - Patient Information 216 D EN^PSOLMPI S VALMBCK="R" 217 Q 218 ; 219 CV ; - Change View 220 D LST^PSOPMPPF(SITE,DUZ) W !?52,"Please wait..." D INIT,HDR 221 S VALMBG=1,VALMBCK="R" 222 Q 223 ; 224 SEL ; - Process selection of one entry 225 N PSOSEL,TYPE,XQORM,ORD,TITLE 226 S PSOSEL=+$P($P(Y(1),"^",4),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q 227 S TYPE=$O(^TMP("PSOPMP0",$J,PSOSEL,0)) I TYPE="" S VALMSG="Invalid selection!",VALMBCK="R" Q 228 S ORD=$G(^TMP("PSOPMP0",$J,PSOSEL,TYPE)) 229 I 'ORD S VALMSG="Invalid selection!",VALMBCK="R" Q 230 S TITLE=VALM("TITLE") 231 ; 232 ; - Regular prescription 233 I TYPE="RX" D S VALMBCK="R" D REF 234 . N PSOVDA,PSOSAVE,DA,PS 235 . S (PSOVDA,DA)=ORD,PS="REJECTMP" 236 . N LINE,TITLE,PSODFN D DP^PSORXVW 237 ; 238 ; - Pending Order 239 I TYPE="PEN" D 240 . N PSOACTOV,OR0 241 . S OR0=^PS(52.41,ORD,0),PSOACTOV="" 242 . N LINE,TITLE D PENHDR^PSOPMP1(PSODFN),DSPL^PSOORFI1 243 ; 244 ; - Pending Order 245 I TYPE="NVA" D 246 . N LINE,TITLE D EN^PSONVAVW(PSODFN,ORD) 247 ; 248 S VALMBCK="R",VALM("TITLE")=TITLE 249 Q 250 ; 251 EXIT ; 252 K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J) 253 Q 254 ; 255 HELP Q 1 PSOPMP0 ;BIRM/MFR - Patient Medication Profile - Listmanager ;10/28/06 2 ;;7.0;OUTPATIENT PHARMACY;**260**;DEC 1997;Build 84 3 ;Reference to EN1^GMRADPT supported by IA #10099 4 ;Reference to EN6^GMRVUTL supported by IA #1120 5 ;Reference to ^PS(55 supported by DBIA 2228 6 ; 7 EN ; - Menu option entry point 8 N PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSIGDP,PSOSTSGP,PSOSTORD,PSORDCNT,PSOSTSEQ,PSORDSEQ,PSOCHNG 9 N GRPLN,DIC,Y,DFN,GRPLN,HIGHLN,LASTLINE,VALMCNT 10 ; 11 ; - Division selection 12 I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT 13 ; 14 ; - Patient selection 15 W !! S DIC=2,DIC(0)="QEAM" D ^DIC G EXIT:Y<0 S DFN=+Y 16 ; 17 D LST(PSOSITE,DFN) 18 Q 19 ; 20 LST(SITE,PSODFN) ; - ListManager entry point 21 ; Loading Division/User preferences 22 D LOAD^PSOPMPPF(SITE,DUZ) 23 ; 24 W !,"Please wait..." 25 D EN^VALM("PSO PMP MAIN") 26 D FULL^VALM1 27 G EXIT 28 ; 29 HDR ; - Header 30 N LINE,POS,LINE1,LINE2,LINE3,LINE4,WT,WTDT,HT,HTDT,VADM,DFN,PNAME,DOB,SEX,X,GMRAL,ADVREA 31 ; 32 K VADM S DFN=PSODFN D DEM^VADPT 33 S PNAME=VADM(1) 34 S DOB=$S(+VADM(3):$P(VADM(3),"^",2)_" ("_$G(VADM(4))_")",1:"UNKNOWN") 35 S SEX=$P(VADM(5),"^",2) 36 S (WT,X)="",GMRVSTR="WT" D EN6^GMRVUTL I X'="" S WT=$J($P(X,"^",8)/2.2,6,2),WTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1) 37 S (HT,X)="",GMRVSTR="HT" D EN6^GMRVUTL I X'="" S HT=$J($P(X,"^",8)*2.54,6,2),HTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1) 38 S LINE1=PNAME 39 S LINE1=$$ALLERGY^PSOPMP1(LINE1,DFN) 40 S LINE2=" PID: "_$P(VADM(2),"^",2),$E(LINE2,50)="HEIGHT(cm): "_$S(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE") 41 S LINE3=" DOB: "_DOB,$E(LINE3,50)="WEIGHT(kg): "_$S(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE") 42 S LINE4=" SEX: "_SEX,$E(LINE4,43)="EXP/CANCEL CUTOFF: "_PSOEXDCE_" DAYS" 43 ; 44 K VALMHDR S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2,VALMHDR(3)=LINE3,VALMHDR(4)=LINE4 45 ; 46 D SETHDR^PSOPMP1() 47 Q 48 ; 49 INIT ; - Populates the Body section for ListMan 50 K ^TMP("PSOPMP0",$J) 51 ; 52 D SETSORT(PSOSRTBY),SETLINE 53 S VALMSG="Select the entry # to view or ?? for more actions" 54 Q 55 ; 56 SETLINE ; - Sets the line to be displayed in ListMan 57 N TYPE,STS,SUB,SEQ,LINE,Z,TOTAL,I,X,X1,ORDCNT,LBL,LN,IENSUB,GROUP,GRP,QTYL 58 I '$D(^TMP("PSOPMPSR",$J)) D Q 59 . F I=1:1:6 S ^TMP("PSOPMP0",$J,I,0)="" 60 . S ^TMP("PSOPMP0",$J,7,0)=" No prescriptions found for this patient." 61 . S VALMCNT=1 62 ; 63 ; - Resetting list to NORMAL video attributes 64 F I=1:1:$G(LASTLINE) D RESTORE^VALM10(I) 65 K GRPLN,HIGHLN 66 ; 67 ; - Building the list (line by line) 68 S (GROUP,STS,SUB)="",LINE=0 K ^TMP("PSOPMP0",$J) 69 F S GROUP=$O(^TMP("PSOPMPSR",$J,GROUP)) Q:GROUP="" D 70 . S GRP=$P(GROUP,"^") 71 . I GRP'["R"!('PSOSTSGP&($O(^TMP("PSOPMPSR",$J,GROUP),-1)'="")) D 72 . . D GROUP^PSOPMP1($P(GROUP,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP)),.LINE) 73 . F S STS=$O(^TMP("PSOPMPSR",$J,GROUP,STS)) Q:STS="" D 74 . . I STS'="<NULL>" D 75 . . . D GROUP^PSOPMP1($P(STS,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP,STS)),.LINE) 76 . . F S SUB=$O(^TMP("PSOPMPSR",$J,GROUP,STS,SUB),$S(PSORDER="A":1,1:-1)) Q:SUB="" D 77 . . . S Z=$G(^TMP("PSOPMPSR",$J,GROUP,STS,SUB)) 78 . . . S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3) 79 . . . S QTYL=$L($P(Z,"^",4)) S:QTYL<5 QTYL=5 80 . . . I GRP["R"!(GRP["T") S $E(X1,5)=$P(Z,"^",2),$E(X1,19)=$E($P(Z,"^",3),1,(32-QTYL)) 81 . . . I GRP["P"!(GRP["N") S $E(X1,5)=$P(Z,"^",3) 82 . . . I GRP["N" S $E(X1,49)="Date Documented:" 83 . . . I GRP'["N" S $E(X1,52-QTYL)=$J($P(Z,"^",4),QTYL),$E(X1,53)=$P(Z,"^",5),$E(X1,57)=$P(Z,"^",6) 84 . . . S $E(X1,66)=$P(Z,"^",7) 85 . . . S $E(X1,74)=$J($P(Z,"^",8),3),$E(X1,78)=$J($P(Z,"^",9),3) 86 . . . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X1,HIGHLN(LINE)="" 87 . . . S IENSUB=$S(GRP["R"!(GRP["T"):"RX",GRP["P":"PEN",1:"NVA") 88 . . . S ^TMP("PSOPMP0",$J,SEQ,IENSUB)=$P(Z,"^") 89 . . . I $G(PSOSIGDP) D SETSIG^PSOPMP1($S(GRP["R"!(GRP["T"):"R",GRP["P":"P",1:"N"),+Z,.LINE,PSODFN) 90 ; 91 ; - Saving NORMAL video attributes to be reset later 92 I LINE>$G(LASTLINE) D 93 . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I) 94 . S LASTLINE=LINE 95 ; 96 D VIDEO^PSOPMP1() 97 ; 98 S VALMCNT=+$G(LINE) 99 Q 100 ; 101 SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified 102 N SEQ,RX,RXNUM,DRUG,DRNAME,QTY,STATUS,STS,ISSDT,DOCDAT,LSTFD,REFREM,DAYSUP,SIG,Z,ORD,GRPCNT,GROUP,RFRX,OI 103 ; 104 K ^TMP("PSOPMPSR",$J) 105 ; 106 ; - Loading prescription (file #55) 107 S SEQ=0 108 F S SEQ=$O(^PS(55,PSODFN,"P",SEQ)) Q:'SEQ D 109 . S RX=+$G(^PS(55,PSODFN,"P",SEQ,0)) I 'RX!($G(^PSRX(RX,0))="") Q 110 . I $$FILTER^PSOPMP1(RX) Q 111 . S RXNUM=$$GET1^DIQ(52,RX,.01) 112 . S DRUG=$$GET1^DIQ(52,RX,6,"I") 113 . S DRNAME=$$GET1^DIQ(50,DRUG,.01) 114 . S QTY=$$GET1^DIQ(52,RX,7) 115 . S STATUS=$$STSINFO^PSOPMP1(RX) 116 . S ISSDT=$$ISSDT^PSOPMP1(RX,"R") 117 . S LSTFD=$$LSTFD^PSOPMP1(RX) 118 . S REFREM=$$REFREM^PSOPMP1(RX) 119 . S DAYSUP=$$GET1^DIQ(52,RX,8) 120 . S Z="",$P(Z,"^")=RX,$P(Z,"^",2)=RXNUM_$$COPAY^PSOPMP1(RX)_$$ECME^PSOBPSUT(RX),$P(Z,"^",3)=$E(DRNAME,1,30) 121 . S $P(Z,"^",4)=QTY,$P(Z,"^",5)=$P(STATUS,"^",3)_$$CMOP^PSOPMP1(DRUG,RX),$P(Z,"^",6)=$P(ISSDT,"^",2) 122 . S $P(Z,"^",7)=$P(LSTFD,"^",2),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP 123 . S SORT=$S(FIELD="RX":RXNUM_" ",FIELD="DR":DRNAME_RXNUM,FIELD="ID":+ISSDT_RXNUM_" ",FIELD="LF":+LSTFD_RXNUM_" ") 124 . S STS="<NULL>" I $G(PSOSTSGP) S STS=$P(STATUS,"^")_"^"_$P(STATUS,"^",2) 125 . S GROUP=$P(PSORDSEQ("R"),"^")_"R^"_$P(PSORDSEQ("R"),"^",2) 126 . I $$FIND^PSOREJUT(RX) S GROUP=$P(PSORDSEQ("T"),"^")_"T^"_$P(PSORDSEQ("T"),"^",2),STS="<NULL>" 127 . S ^TMP("PSOPMPSR",$J,GROUP,STS,SORT)=Z 128 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1,GRPCNT(GROUP,STS)=$G(GRPCNT(GROUP,STS))+1 129 ; 130 S GROUP="" 131 F S GROUP=$O(GRPCNT(GROUP)) Q:GROUP="" D 132 . S ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP)) 133 . S STS="" F S STS=$O(GRPCNT(GROUP,STS)) Q:STS="" D 134 . . S ^TMP("PSOPMPSR",$J,GROUP,STS)=GRPCNT(GROUP,STS) 135 ; 136 ; - Loading pending orders (file #52.41) 137 S ORD=0,GROUP=$P(PSORDSEQ("P"),"^")_"P^"_$P(PSORDSEQ("P"),"^",2) 138 F S ORD=$O(^PS(52.41,"P",PSODFN,ORD)) Q:'ORD D 139 . S TYPE=$$GET1^DIQ(52.41,ORD,2,"I") 140 . I TYPE="DC"!(TYPE="DE")!(TYPE="HD") Q 141 . S DRNAME="",DRUG=+$$GET1^DIQ(52.41,ORD,11,"I") I DRUG S DRNAME=$$GET1^DIQ(50,DRUG,.01) 142 . I DRNAME="" D Q:DRNAME="" 143 . . S OI=$$GET1^DIQ(52.41,ORD,8,"I") I 'OI Q 144 . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02) 145 . S QTY=$$GET1^DIQ(52.41,ORD,12) 146 . S STATUS=$$GET1^DIQ(52.41,ORD,2,"I") 147 . S ISSDT=$$ISSDT^PSOPMP1(ORD,"P") 148 . S REFREM=$$GET1^DIQ(52.41,ORD,13) 149 . S DAYSUP=$$GET1^DIQ(52.41,ORD,101) 150 . S RFRX="" I STATUS="RF" S RFRX=$$GET1^DIQ(52.41,ORD,21,"I") I RFRX S RFRX=$$GET1^DIQ(52,RFRX,.01) 151 . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,45),$P(Z,"^",4)=QTY,$P(Z,"^",5)=$E(STATUS,1,2)_$$CMOP^PSOPMP1(DRUG) 152 . S $P(Z,"^",6)=$S(RFRX'="":"Rx#: "_RFRX,1:$P(ISSDT,"^",2)),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP 153 . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":+ISSDT_ORD,FIELD="LF":+ISSDT_ORD) 154 . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z 155 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1 156 ; 157 S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP)) 158 ; 159 ; - Loading Non-VA Med orders (file #55, sub-file #55.05) 160 S ORD=0,GROUP=$P(PSORDSEQ("N"),"^")_"N^"_$P(PSORDSEQ("N"),"^",2) 161 F S ORD=$O(^PS(55,PSODFN,"NVA",ORD)) Q:'ORD D 162 . I $$GET1^DIQ(55.05,ORD_","_PSODFN,5,"I") Q 163 . S DRNAME=$$GET1^DIQ(55.05,ORD_","_PSODFN,1) 164 . I DRNAME="" D Q:DRNAME="" 165 . . S OI=$$GET1^DIQ(55.05,ORD_","_PSODFN,.01,"I") I 'OI Q 166 . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02) 167 . S DOCDAT=$P($$GET1^DIQ(55.05,ORD_","_PSODFN_",",11,"I"),".") 168 . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,38),$P(Z,"^",7)=$$DAT^PSOPMP1(DOCDAT,"-") 169 . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":DOCDAT_ORD,FIELD="LF":DOCDAT_ORD) 170 . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z 171 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1 172 ; 173 S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP)) 174 ; 175 Q 176 ; 177 RX ; - Sort by Rx 178 D SORT("RX") 179 Q 180 DR ; - Sort by Drug 181 D SORT("DR") 182 Q 183 ID ; - Sort by Issue Date 184 D SORT("ID") 185 Q 186 LF ; - Sort by Last Fill Date 187 D SORT("LF") 188 Q 189 ; 190 SORT(FIELD) ; - Sort entries by FIELD 191 I PSOSRTBY=FIELD S PSORDER=$S(PSORDER="A":"D",1:"A") 192 E S PSOSRTBY=FIELD,PSORDER="A" 193 D REF 194 Q 195 ; 196 REF ; - Screen Refresh 197 W ?52,"Please wait..." D INIT,HDR S VALMBCK="R" 198 Q 199 GS ; - Group by Status 200 W ?52,"Please wait..." S PSOSTSGP=$S($G(PSOSTSGP):0,1:1) D INIT,HDR S VALMBCK="R" 201 Q 202 ; 203 SIG ; - Display SIG 204 W ?52,"Please wait..." S PSOSIGDP=$S($G(PSOSIGDP):0,1:1) D INIT,HDR S VALMBCK="R" 205 I 'PSOSIGDP S VALMBG=VALMBG\2 206 I PSOSIGDP S VALMBG=VALMBG*2-1 207 S:VALMBG>(VALMCNT-10) VALMBG=VALMCNT-10 S:VALMBG<1 VALMBG=1 208 Q 209 ; 210 PI ; - Patient Information 211 D EN^PSOLMPI S VALMBCK="R" 212 Q 213 ; 214 CV ; - Change View 215 D LST^PSOPMPPF(SITE,DUZ) W !?52,"Please wait..." D INIT,HDR 216 S VALMBG=1,VALMBCK="R" 217 Q 218 ; 219 SEL ; - Process selection of one entry 220 N PSOSEL,TYPE,XQORM,ORD,TITLE 221 S PSOSEL=+$P($P(Y(1),"^",4),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q 222 S TYPE=$O(^TMP("PSOPMP0",$J,PSOSEL,0)) I TYPE="" S VALMSG="Invalid selection!",VALMBCK="R" Q 223 S ORD=$G(^TMP("PSOPMP0",$J,PSOSEL,TYPE)) 224 I 'ORD S VALMSG="Invalid selection!",VALMBCK="R" Q 225 S TITLE=VALM("TITLE") 226 ; 227 ; - Regular prescription 228 I TYPE="RX" D 229 . N PSOVDA,PSOSAVE,DA,PS 230 . S (PSOVDA,DA)=ORD,PS="REJECT" 231 . N LINE,TITLE,PSODFN D DP^PSORXVW 232 ; 233 ; - Pending Order 234 I TYPE="PEN" D 235 . N PSOACTOV,OR0 236 . S OR0=^PS(52.41,ORD,0),PSOACTOV="" 237 . N LINE,TITLE D PENHDR^PSOPMP1(PSODFN),DSPL^PSOORFI1 238 ; 239 ; - Pending Order 240 I TYPE="NVA" D 241 . N LINE,TITLE D EN^PSONVAVW(PSODFN,ORD) 242 ; 243 S VALMBCK="R",VALM("TITLE")=TITLE 244 Q 245 ; 246 EXIT ; 247 K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J) 248 Q 249 ; 250 HELP Q
Note:
See TracChangeset
for help on using the changeset viewer.
