- 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/PSOORUT1.m
r613 r623 1 PSOORUT1 ;BIR/SAB - Utility routine for oerr interface ;6/28/07 7:36am 2 ;;7.0;OUTPATIENT PHARMACY;**1,14,30,46,132,148,233,274,225**;DEC 1997;Build 29 3 ;External reference to ^PSDRUG supported by DBIA 221 4 ;External reference to ^PSXOPUTL supported by DBIA 2203 5 ;called from HD^PSOORUTL 6 REL ;removed order from hold 7 S ACT=1,ORS=0 8 I POERR("PSOFILNM")["S" S DA=+POERR("PSOFILNM") D G EXIT^PSOORUTL 9 .Q:'$D(^PS(52.41,DA,0)) Q:$P(^PS(52.41,DA,0),"^",3)="RF" 10 .S $P(^PS(52.41,DA,0),"^",3)="NW",POERR("STAT")="OR",POERR("FILLER")=DA_"^P" 11 .S:$G(POERR("COMM"))']"" POERR("COMM")="Order RELEASED from HOLD by OE/RR before finished." S $P(^PS(52.41,DA,4),"^")=POERR("COMM"),ORS=1 12 S DA=POERR("PSOFILNM") I $D(^PSRX(DA,0)) S ORS=1,PSDA=DA D G EXIT^PSOORUTL 13 .S POERR("FILLER")=DA_"^R",POERR("STAT")="OR" 14 .S:'$D(POERR("COMM")) POERR("COMM")="Prescription Released from HOLD by OE/RR" 15 .I DT>$P(^PSRX(DA,2),"^",6) D 16 ..S EXP=$P(^PSRX(DA,2),"^",6) S:$P(^PSRX(DA,"STA"),"^")<12 $P(^PSRX(DA,"STA"),"^")=11,PSOEXFLG=1 S POERR("STAT")="UR",POERR("COMM")="Medication Expired on "_$E(EXP,4,5)_"/"_$E(EXP,6,7)_"/"_$E(EXP,2,3)_".",POERR("PHARMST")="" D ECAN^PSOUTL(DA) Q 17 .I $P(^PSRX(DA,"STA"),"^")'=16 S POERR("STAT")="UR",POERR("COMM")="Unable to Release from Hold" Q 18 .S RXFL(DA)=0,FDT=$P(^PSRX(DA,2),"^",2) 19 .I $O(^PSRX(DA,1,0)) F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S FDT=$P(^PSRX(DA,1,I,0),"^"),RXFL(DA)=I 20 .I FDT>DT N PSOSITEZ,ZPSOPAR6 S PSOSITEZ=$S($P($G(^PSRX(DA,2)),"^",9):$P(^(2),"^",9),1:$O(^PS(59,0))),ZPSOPAR6=$P($G(^PS(59,PSOSITEZ,1)),"^",6) I ZPSOPAR6 D Q 21 ..S RXXDA=DA,DA=$O(^PS(52.5,"B",RXXDA,0)) I DA S DIK="^PS(52.5," D ^DIK K DIK 22 ..S DA=RXXDA 23 ..S DIC="^PS(52.5,",DIC(0)="L",DLAYGO=52.5,X=RXXDA,DIC("DR")=".02///"_FDT_";.03////"_$P(^PSRX(DA,0),"^",2)_";.04///M;.05///0;.06////"_PSOSITEZ_";2///0;9///"_RXFL(DA) K DD,DO D FILE^DICN K RXFL,DD,DO 24 ..S DA=RXXDA K RXXDA S $P(^PSRX(DA,"STA"),"^")=5,LFD=$E(FDT,4,5)_"-"_$E(FDT,6,7)_"-"_$E(FDT,2,3) D ACT1 25 ..S PSOSUSZ=1 26 .E S $P(^PSRX(DA,"STA"),"^")=0 27 .S RXF=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S RXF=I S:I>5 RXF=I+1 28 .D ACT^PSOORUTL 29 .I $$SUBMIT^PSOBPSUT(DA) D ECMESND^PSOBPSU1(DA,,$$RXFLDT^PSOBPSUT(DA),$S('$O(^PSRX(DA,1,0)):"OF",1:"RF")) 30 G EXIT^PSOORUTL 31 ACT1 S RXF=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S RXF=I S:I>5 RXF=I+1 32 S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA S IR=FDA 33 S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR 34 D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^S^"_POERR("USER")_"^"_RXF_"^"_"RX Placed on Suspense until "_LFD 35 Q 36 SUS ; 37 I $P($G(^PSRX(+$G(FILLER),"STA")),"^")=5 N PSOMSORR,PLACERXX D EN^PSOHLSN1(+$G(FILLER),"SC","ZS","") 38 Q 39 BLD ;builds med profile for Listman 40 K ^TMP("PSOPF",$J),PSOLST S:$G(PSOOPT)'=3 PSOOPT=0 I '$G(PSOSD) S ^TMP("PSOPF",$J,1,0)="This patient has no prescriptions" S PSOCNT=0,PSOPF=1 Q 41 D EOJ,SHOW 42 EOJ ; 43 K PSOQFLG,PSODRG,PSODATA,PSOLF 44 Q 45 ;----------------------------------------------------------------- 46 SHOW ; 47 ; - ePharmacy modification to create a section for Rx with REJECTs 48 N PSOTMP,PSOSTS,PSODRNM,I,PSORX 49 S (PSOSTS,PSODRNM)="" 50 F S PSOSTS=$O(PSOSD(PSOSTS)) Q:PSOSTS="" D 51 . F S PSODRNM=$O(PSOSD(PSOSTS,PSODRNM)) Q:PSODRNM="" D 52 . . S PSORX=+$G(PSOSD(PSOSTS,PSODRNM)) 53 . . I PSOSTS="ACTIVE",$$FIND^PSOREJUT(PSORX) D Q 54 . . . S PSOTMP(" REJECT",PSODRNM)=PSOSTS 55 . . S PSOTMP(PSOSTS,PSODRNM)=PSOSTS 56 ; 57 S (PSOSTS,PSODRG)="",(PSOCNT,PSOQFLG,IEN)=0 58 K RN,DL S $P(RN," ",12)=" ",$P(DL," ",40)=" " 59 F PSCNT=0:0 S PSOSTS=$O(PSOTMP(PSOSTS)) Q:PSOSTS="" D 60 . D STA 61 . F PSOCT=0:0 S PSODRG=$O(PSOTMP(PSOSTS,PSODRG)) Q:PSODRG="" Q:PSOCNT>1000!PSOQFLG D 62 . . S PSOSTA=PSOTMP(PSOSTS,PSODRG) 63 . . S PSODATA=PSOSD(PSOSTA,PSODRG) I PSOSTA="ZNONVA" D NVA Q 64 . . S PSOCNT=PSOCNT+1 I PSOSTA="PENDING" D PEN Q 65 . . S:'$D(^PSRX(+PSODATA,0)) PSOCNT=PSOCNT-1 D:$D(^(0)) DISPL 66 S (VALMCNT,PSOPF)=IEN 67 SHOWX K DIRUT,DTOUT,DUOUT,DIROUT,PSODRG 68 Q 69 ; 70 DISPL S IEN=IEN+1 N PSOID,PSOCMOP,STATLTH,ECME 71 K PSOLNT,PSOQTL,PSOLSP S PSOLRX=$S($G(^PSRX(+PSODATA,"IB")):13,1:14)-$L($P(^PSRX(+PSODATA,0),"^")),$P(PSOLNT," ",PSOLRX)=" ",PSODQL=$L($P(PSODRG,"^"))+$L($P(^PSRX(+PSODATA,0),"^",7)) 72 I PSODQL<39 S $P(PSOQTL," ",(40-PSODQL))=" " 73 E S $P(PSOQTL," ",(52-$L($P(^PSRX(+PSODATA,0),"^",7))))=" ",$P(PSOLSP," ",(41-$L($P(PSODRG,"^"))))=" " 74 S ECME=$$ECME^PSOBPSUT(+PSODATA) I ECME'="" S PSOLNT=$E(PSOLNT,1,$L(PSOLNT)-1) 75 S ^TMP("PSOPF",$J,IEN,0)=$J(PSOCNT,2)_$S($L(PSOCNT)<3:" ",1:"")_$P(^PSRX(+PSODATA,0),"^")_$S($G(^PSRX(+PSODATA,"IB")):"$",1:"")_ECME_PSOLNT_$P(PSODRG,"^")_$S(PSODQL<39:PSOQTL_$P(^PSRX(+PSODATA,0),"^",7)_" ",1:$G(PSOLSP)) 76 S STA="A^N^R^H^N^S^^^^^^E^DC^^DC^DE^H^P^" 77 S PSOCMOP="" 78 I $D(^PSDRUG("AQ",$P(^PSRX(+PSODATA,0),"^",6))) S PSOCMOP=">" 79 N X S X="PSXOPUTL" X ^%ZOSF("TEST") K X I $T D 80 .N DA S DA=+PSODATA D ^PSXOPUTL K DA 81 .I $G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2) S PSOCMOP="T" 82 .K PSXZ 83 N PSOBADR 84 S PSOBADR=$O(^PSRX(+PSODATA,"L",9999),-1) 85 I PSOBADR'="" S PSOBADR=$G(^PSRX(+PSODATA,"L",PSOBADR,0)) I PSOBADR["(BAD ADDRESS)" S PSOBADR="B" 86 I PSOBADR'="B" S PSOBADR="" 87 S STAPRT=$P(STA,"^",$P(PSODATA,"^",2)+1)_PSOCMOP_PSOBADR 88 S STATLTH=$L(STAPRT) 89 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_STAPRT_$S(STATLTH=0:" ",STATLTH=1:" ",STATLTH=2:" ",1:"") 90 S PSOID=$P(^PSRX(+PSODATA,0),"^",13),PSOLF=+$G(^(3)),^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$E(PSOID,4,5)_"-"_$E(PSOID,6,7)_" " 91 F PSOX=0:0 S PSOX=$O(^PSRX(+PSODATA,1,PSOX)) Q:'PSOX D 92 . I +$G(^PSRX(+PSODATA,1,PSOX,0))=PSOLF,$P($G(^PSRX(+PSODATA,1,PSOX,0)),"^",16) S PSOLF=PSOLF_"^R" 93 K PSOX 94 I '$O(^PSRX(+PSODATA,1,0)),$P(^PSRX(+PSODATA,2),"^",15) S PSOLF=PSOLF_"^R" 95 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$S($G(PSOLF):$E(PSOLF,4,5),1:" ")_"-"_$S($G(PSOLF):$E(PSOLF,6,7),1:" ")_$S($P(PSOLF,"^",2)="R":"R ",1:" ") 96 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$J($P(PSODATA,"^",6),2)_" "_$J($P(PSODATA,"^",8),3) 97 I PSODQL>38 S IEN=IEN+1 S ^TMP("PSOPF",$J,IEN,0)=PSOQTL_"Qty: "_$P(^PSRX(+PSODATA,0),"^",7) 98 K PSOLNT,PSOQTL,PSOLSP,PSOLRX,PSODQL 99 S PSOLST(PSOCNT)="52^"_+PSODATA_"^"_PSOSTA 100 K PSODATA,PSOLF S PSOPF=IEN 101 Q 102 ; 103 STA N LABEL,LINE,POS 104 S LABEL=PSOSTS,IEN=IEN+1 105 I PSOSTS="ZNONVA" S LABEL="Non-VA MEDS (Not dispensed by VA)" 106 I PSOSTS=" REJECT" S LABEL="REFILL TOO SOON/DUR REJECTS (Third Party)" 107 S POS=80-$L(LABEL)/2,$P(LINE,"-",81)="",$E(LINE,POS+1,POS+$L(LABEL))=LABEL 108 S ^TMP("PSOPF",$J,IEN,0)=LINE 109 Q 110 PENX S PSOLST(PSOCNT)="52.41^"_$P(PSODATA,"^",10)_"^"_PSOSTA 111 K PSODATA,PSOLF,RN,PSOLSP,PSOQTL,PSOLNT 112 Q 113 PEN ; 114 N PSOQTL,PSOLNT,PSOLNTZ,PSOQTLX,PSCMOPF,SPACEZ 115 Q:'$D(^PS(52.41,$P(PSODATA,"^",10),0)) 116 S PSCMOPF=0 I $P($G(PSODATA),"^",11),$D(^PSDRUG("AQ",$P(PSODATA,"^",11))) S PSCMOPF=1 117 S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=$J(PSOCNT,2)_$S($L(PSOCNT)<3:" ",1:"")_$P(PSODRG,"^") 118 I $P($G(^PS(52.41,+$P(PSODATA,"^",10),0)),"^",23)=1 S ^TMP("PSOPF",$J,IEN,"RV")="" 119 S PSOLNT=$L($P(PSODRG,"^")),PSOLNTZ=$L($P(PSODATA,"^",8)) 120 S $P(PSOQTLX," ",(11-PSOLNTZ))=" " 121 S:PSOLNT<37 $P(PSOQTL," ",(37-PSOLNT))=" " 122 I PSOLNT<38 D G PENX 123 .I PSOLNT=37 S PSOQTL="" 124 .I $P(^PS(52.41,$P(PSODATA,"^",10),0),"^",3)="RF" S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$G(PSOQTL)_" Refill Request Rx #: "_$P(^PSRX($P(^PS(52.41,$P(PSODATA,"^",10),0),"^",19),0),"^") Q 125 .S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$G(PSOQTL)_" "_"QTY: "_$P(PSODATA,"^",8)_$G(PSOQTLX)_" ISDT: "_$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_$S($G(PSCMOPF):"> ",1:" ") 126 .S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_"REF: "_$S($L($P(PSODATA,"^",6))>1:"",1:" ")_$P(PSODATA,"^",6) 127 S IEN=IEN+1,$P(SPACEZ," ",42)=" " 128 I $P(^PS(52.41,$P(PSODATA,"^",10),0),"^",3)="RF" S ^TMP("PSOPF",$J,IEN,0)=SPACEZ_"Refill Request Rx #: "_$P(^PSRX($P(^PS(52.41,$P(PSODATA,"^",10),0),"^",19),0),"^") G PENX 129 S ^TMP("PSOPF",$J,IEN,0)=SPACEZ_"QTY: "_$P(PSODATA,"^",8)_$G(PSOQTLX)_" ISDT: "_$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_$S($G(PSCMOPF):"> ",1:" ")_"REF: "_$S($L($P(PSODATA,"^",6))>1:"",1:" ") 130 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",6) 131 G PENX 132 ; 133 NVA ; Setting the Non-VA Meds on the Medication Profile Screen (ListMan) 134 S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" "_$P(PSODRG,"^")_" " 135 I ($L(^TMP("PSOPF",$J,IEN,0))+$L($P(PSODATA,"^",6))>70) S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" " 136 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",6)_" " 137 I ($L(^TMP("PSOPF",$J,IEN,0))+$L($P(PSODATA,"^",8))>70) S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" " 138 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",8) 139 I ($L(^TMP("PSOPF",$J,IEN,0))+20)>70 D Q 140 . S IEN=IEN+1,$P(^TMP("PSOPF",$J,IEN,0)," ",51)="Date Documented: "_$E($P(PSODATA,"^",9),4,5)_"/"_$E($P(PSODATA,"^",9),6,7)_"/"_$E($P(PSODATA,"^",9),2,3) 141 F I=0:0 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_" " Q:$L(^TMP("PSOPF",$J,IEN,0))>49 142 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_"Date Documented: "_$E($P(PSODATA,"^",9),4,5)_"/"_$E($P(PSODATA,"^",9),6,7)_"/"_$E($P(PSODATA,"^",9),2,3) 143 Q 1 PSOORUT1 ;BIR/SAB - Utility routine for oerr interface ;02/22/95 2 ;;7.0;OUTPATIENT PHARMACY;**1,14,30,46,132,148,233**;DEC 1997;Build 8 3 ;External reference to ^PSDRUG supported by DBIA 221 4 ;External reference to ^PSXOPUTL supported by DBIA 2203 5 ;called from HD^PSOORUTL 6 REL ;removed order from hold 7 S ACT=1,ORS=0 8 I POERR("PSOFILNM")["S" S DA=+POERR("PSOFILNM") D G EXIT^PSOORUTL 9 .Q:'$D(^PS(52.41,DA,0)) Q:$P(^PS(52.41,DA,0),"^",3)="RF" 10 .S $P(^PS(52.41,DA,0),"^",3)="NW",POERR("STAT")="OR",POERR("FILLER")=DA_"^P" 11 .S:$G(POERR("COMM"))']"" POERR("COMM")="Order RELEASED from HOLD by OE/RR before finished." S $P(^PS(52.41,DA,4),"^")=POERR("COMM"),ORS=1 12 S DA=POERR("PSOFILNM") I $D(^PSRX(DA,0)) S ORS=1,PSDA=DA D G EXIT^PSOORUTL 13 .S POERR("FILLER")=DA_"^R",POERR("STAT")="OR" 14 .S:'$D(POERR("COMM")) POERR("COMM")="Prescription Released from HOLD by OE/RR" 15 .I DT>$P(^PSRX(DA,2),"^",6) D 16 ..S EXP=$P(^PSRX(DA,2),"^",6) S:$P(^PSRX(DA,"STA"),"^")<12 $P(^PSRX(DA,"STA"),"^")=11,PSOEXFLG=1 S POERR("STAT")="UR",POERR("COMM")="Medication Expired on "_$E(EXP,4,5)_"/"_$E(EXP,6,7)_"/"_$E(EXP,2,3)_".",POERR("PHARMST")="" D ECAN^PSOUTL(DA) Q 17 .I $P(^PSRX(DA,"STA"),"^")'=16 S POERR("STAT")="UR",POERR("COMM")="Unable to Release from Hold" Q 18 .S RXFL(DA)=0,FDT=$P(^PSRX(DA,2),"^",2) 19 .I $O(^PSRX(DA,1,0)) F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S FDT=$P(^PSRX(DA,1,I,0),"^"),RXFL(DA)=I 20 .I FDT>DT N PSOSITEZ,ZPSOPAR6 S PSOSITEZ=$S($P($G(^PSRX(DA,2)),"^",9):$P(^(2),"^",9),1:$O(^PS(59,0))),ZPSOPAR6=$P($G(^PS(59,PSOSITEZ,1)),"^",6) I ZPSOPAR6 D Q 21 ..S RXXDA=DA,DA=$O(^PS(52.5,"B",RXXDA,0)) I DA S DIK="^PS(52.5," D ^DIK K DIK 22 ..S DA=RXXDA 23 ..S DIC="^PS(52.5,",DIC(0)="L",DLAYGO=52.5,X=RXXDA,DIC("DR")=".02///"_FDT_";.03////"_$P(^PSRX(DA,0),"^",2)_";.04///M;.05///0;.06////"_PSOSITEZ_";2///0;9///"_RXFL(DA) K DD,DO D FILE^DICN K RXFL,DD,DO 24 ..S DA=RXXDA K RXXDA S $P(^PSRX(DA,"STA"),"^")=5,LFD=$E(FDT,4,5)_"-"_$E(FDT,6,7)_"-"_$E(FDT,2,3) D ACT1 25 ..S PSOSUSZ=1 26 .E S $P(^PSRX(DA,"STA"),"^")=0 27 .S RXF=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S RXF=I S:I>5 RXF=I+1 28 .D ACT^PSOORUTL 29 .I $$SUBMIT^PSOBPSUT(DA) D ECMESND^PSOBPSU1(DA,,$$RXFLDT^PSOBPSUT(DA),$S('$O(^PSRX(DA,1,0)):"OF",1:"RF")) 30 G EXIT^PSOORUTL 31 ACT1 I '$D(RXF) S RXF=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S RXF=I S:I>5 RXF=I+1 32 S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA S IR=FDA 33 S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR 34 D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^S^"_POERR("USER")_"^"_RXF_"^"_"RX Placed on Suspense until "_LFD 35 Q 36 SUS ; 37 I $P($G(^PSRX(+$G(FILLER),"STA")),"^")=5 N PSOMSORR,PLACERXX D EN^PSOHLSN1(+$G(FILLER),"SC","ZS","") 38 Q 39 BLD ;builds med profile for Listman 40 K ^TMP("PSOPF",$J),PSOLST S:$G(PSOOPT)'=3 PSOOPT=0 I '$G(PSOSD) S ^TMP("PSOPF",$J,1,0)="This patient has no prescriptions" S PSOCNT=0,PSOPF=1 Q 41 D EOJ,SHOW 42 EOJ ; 43 K PSOQFLG,PSODRG,PSODATA,PSOLF 44 Q 45 ;----------------------------------------------------------------- 46 SHOW ; 47 ; - ePharmacy modification to create a section for Rx with REJECTs 48 N PSOTMP,PSOSTS,PSODRNM,I,PSORX 49 S (PSOSTS,PSODRNM)="" 50 F S PSOSTS=$O(PSOSD(PSOSTS)) Q:PSOSTS="" D 51 . F S PSODRNM=$O(PSOSD(PSOSTS,PSODRNM)) Q:PSODRNM="" D 52 . . S PSORX=+$G(PSOSD(PSOSTS,PSODRNM)) 53 . . I PSOSTS="ACTIVE",$$FIND^PSOREJUT(PSORX) D Q 54 . . . S PSOTMP(" REJECT",PSODRNM)=PSOSTS 55 . . S PSOTMP(PSOSTS,PSODRNM)=PSOSTS 56 ; 57 S (PSOSTS,PSODRG)="",(PSOCNT,PSOQFLG,IEN)=0 58 K RN,DL S $P(RN," ",12)=" ",$P(DL," ",40)=" " 59 F PSCNT=0:0 S PSOSTS=$O(PSOTMP(PSOSTS)) Q:PSOSTS="" D 60 . D STA 61 . F PSOCT=0:0 S PSODRG=$O(PSOTMP(PSOSTS,PSODRG)) Q:PSODRG="" Q:PSOCNT>1000!PSOQFLG D 62 . . S PSOSTA=PSOTMP(PSOSTS,PSODRG) 63 . . S PSODATA=PSOSD(PSOSTA,PSODRG) I PSOSTA="ZNONVA" D NVA Q 64 . . S PSOCNT=PSOCNT+1 I PSOSTA="PENDING" D PEN Q 65 . . S:'$D(^PSRX(+PSODATA,0)) PSOCNT=PSOCNT-1 D:$D(^(0)) DISPL 66 S (VALMCNT,PSOPF)=IEN 67 SHOWX K DIRUT,DTOUT,DUOUT,DIROUT,PSODRG 68 Q 69 ; 70 DISPL S IEN=IEN+1 N PSOID,PSOCMOP,STATLTH,ECME 71 K PSOLNT,PSOQTL,PSOLSP S PSOLRX=$S($G(^PSRX(+PSODATA,"IB")):13,1:14)-$L($P(^PSRX(+PSODATA,0),"^")),$P(PSOLNT," ",PSOLRX)=" ",PSODQL=$L($P(PSODRG,"^"))+$L($P(^PSRX(+PSODATA,0),"^",7)) 72 I PSODQL<39 S $P(PSOQTL," ",(40-PSODQL))=" " 73 E S $P(PSOQTL," ",(52-$L($P(^PSRX(+PSODATA,0),"^",7))))=" ",$P(PSOLSP," ",(41-$L($P(PSODRG,"^"))))=" " 74 S ECME=$$ECME^PSOBPSUT(+PSODATA) I ECME'="" S PSOLNT=$E(PSOLNT,1,$L(PSOLNT)-1) 75 S ^TMP("PSOPF",$J,IEN,0)=$J(PSOCNT,2)_$S($L(PSOCNT)<3:" ",1:"")_$P(^PSRX(+PSODATA,0),"^")_$S($G(^PSRX(+PSODATA,"IB")):"$",1:"")_ECME_PSOLNT_$P(PSODRG,"^")_$S(PSODQL<39:PSOQTL_$P(^PSRX(+PSODATA,0),"^",7)_" ",1:$G(PSOLSP)) 76 S STA="A^N^R^H^N^S^^^^^^E^DC^^DC^DE^H^P^" 77 S PSOCMOP="" 78 I $D(^PSDRUG("AQ",$P(^PSRX(+PSODATA,0),"^",6))) S PSOCMOP=">" 79 N X S X="PSXOPUTL" X ^%ZOSF("TEST") K X I $T D 80 .N DA S DA=+PSODATA D ^PSXOPUTL K DA 81 .I $G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2) S PSOCMOP="T" 82 .K PSXZ 83 N PSOBADR 84 S PSOBADR=$O(^PSRX(+PSODATA,"L",9999),-1) 85 I PSOBADR'="" S PSOBADR=$G(^PSRX(+PSODATA,"L",PSOBADR,0)) I PSOBADR["(BAD ADDRESS)" S PSOBADR="B" 86 I PSOBADR'="B" S PSOBADR="" 87 S STAPRT=$P(STA,"^",$P(PSODATA,"^",2)+1)_PSOCMOP_PSOBADR 88 S STATLTH=$L(STAPRT) 89 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_STAPRT_$S(STATLTH=0:" ",STATLTH=1:" ",STATLTH=2:" ",1:"") 90 S PSOID=$P(^PSRX(+PSODATA,0),"^",13),PSOLF=+$G(^(3)),^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$E(PSOID,4,5)_"-"_$E(PSOID,6,7)_" " 91 F PSOX=0:0 S PSOX=$O(^PSRX(+PSODATA,1,PSOX)) Q:'PSOX D 92 . I +$G(^PSRX(+PSODATA,1,PSOX,0))=PSOLF,$P($G(^PSRX(+PSODATA,1,PSOX,0)),"^",16) S PSOLF=PSOLF_"^R" 93 K PSOX 94 I '$O(^PSRX(+PSODATA,1,0)),$P(^PSRX(+PSODATA,2),"^",15) S PSOLF=PSOLF_"^R" 95 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$S($G(PSOLF):$E(PSOLF,4,5),1:" ")_"-"_$S($G(PSOLF):$E(PSOLF,6,7),1:" ")_$S($P(PSOLF,"^",2)="R":"R ",1:" ") 96 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$J($P(PSODATA,"^",6),2)_" "_$J($P(PSODATA,"^",8),3) 97 I PSODQL>38 S IEN=IEN+1 S ^TMP("PSOPF",$J,IEN,0)=PSOQTL_"Qty: "_$P(^PSRX(+PSODATA,0),"^",7) 98 K PSOLNT,PSOQTL,PSOLSP,PSOLRX,PSODQL 99 S PSOLST(PSOCNT)="52^"_+PSODATA_"^"_PSOSTA 100 K PSODATA,PSOLF S PSOPF=IEN 101 Q 102 ; 103 STA N LABEL,LINE,POS 104 S LABEL=PSOSTS,IEN=IEN+1 105 I PSOSTS="ZNONVA" S LABEL="Non-VA MEDS (Not dispensed by VA)" 106 I PSOSTS=" REJECT" S LABEL="REFILL TOO SOON/DUR REJECTS (Third Party)" 107 S POS=80-$L(LABEL)/2,$P(LINE,"-",81)="",$E(LINE,POS+1,POS+$L(LABEL))=LABEL 108 S ^TMP("PSOPF",$J,IEN,0)=LINE 109 Q 110 PENX S PSOLST(PSOCNT)="52.41^"_$P(PSODATA,"^",10)_"^"_PSOSTA 111 K PSODATA,PSOLF,RN,PSOLSP,PSOQTL,PSOLNT 112 Q 113 PEN ; 114 N PSOQTL,PSOLNT,PSOLNTZ,PSOQTLX,PSCMOPF,SPACEZ 115 Q:'$D(^PS(52.41,$P(PSODATA,"^",10),0)) 116 S PSCMOPF=0 I $P($G(PSODATA),"^",11),$D(^PSDRUG("AQ",$P(PSODATA,"^",11))) S PSCMOPF=1 117 S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=$J(PSOCNT,2)_$S($L(PSOCNT)<3:" ",1:"")_$P(PSODRG,"^") 118 S PSOLNT=$L($P(PSODRG,"^")),PSOLNTZ=$L($P(PSODATA,"^",8)) 119 S $P(PSOQTLX," ",(11-PSOLNTZ))=" " 120 S:PSOLNT<37 $P(PSOQTL," ",(37-PSOLNT))=" " 121 I PSOLNT<38 D G PENX 122 .I PSOLNT=37 S PSOQTL="" 123 .I $P(^PS(52.41,$P(PSODATA,"^",10),0),"^",3)="RF" S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$G(PSOQTL)_" Refill Request Rx #: "_$P(^PSRX($P(^PS(52.41,$P(PSODATA,"^",10),0),"^",19),0),"^") Q 124 .S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$G(PSOQTL)_" "_"QTY: "_$P(PSODATA,"^",8)_$G(PSOQTLX)_" ISDT: "_$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_$S($G(PSCMOPF):"> ",1:" ") 125 .S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_"REF: "_$S($L($P(PSODATA,"^",6))>1:"",1:" ")_$P(PSODATA,"^",6) 126 S IEN=IEN+1,$P(SPACEZ," ",42)=" " 127 I $P(^PS(52.41,$P(PSODATA,"^",10),0),"^",3)="RF" S ^TMP("PSOPF",$J,IEN,0)=SPACEZ_"Refill Request Rx #: "_$P(^PSRX($P(^PS(52.41,$P(PSODATA,"^",10),0),"^",19),0),"^") G PENX 128 S ^TMP("PSOPF",$J,IEN,0)=SPACEZ_"QTY: "_$P(PSODATA,"^",8)_$G(PSOQTLX)_" ISDT: "_$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_$S($G(PSCMOPF):"> ",1:" ")_"REF: "_$S($L($P(PSODATA,"^",6))>1:"",1:" ") 129 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",6) 130 G PENX 131 ; 132 NVA ; Setting the Non-VA Meds on the Medication Profile Screen (ListMan) 133 S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" "_$P(PSODRG,"^")_" " 134 I ($L(^TMP("PSOPF",$J,IEN,0))+$L($P(PSODATA,"^",6))>70) S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" " 135 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",6)_" " 136 I ($L(^TMP("PSOPF",$J,IEN,0))+$L($P(PSODATA,"^",8))>70) S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" " 137 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",8) 138 I ($L(^TMP("PSOPF",$J,IEN,0))+20)>70 D Q 139 . S IEN=IEN+1,$P(^TMP("PSOPF",$J,IEN,0)," ",51)="Date Documented: "_$E($P(PSODATA,"^",9),4,5)_"/"_$E($P(PSODATA,"^",9),6,7)_"/"_$E($P(PSODATA,"^",9),2,3) 140 F I=0:0 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_" " Q:$L(^TMP("PSOPF",$J,IEN,0))>49 141 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_"Date Documented: "_$E($P(PSODATA,"^",9),4,5)_"/"_$E($P(PSODATA,"^",9),6,7)_"/"_$E($P(PSODATA,"^",9),2,3) 142 Q
Note:
See TracChangeset
for help on using the changeset viewer.
