- 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/PSOORNEW.m
r613 r623 1 PSOORNEW ;BIR/SAB - display orders from oerr ;4/25/07 8:50am2 ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,55,46,71,90,94,106,131,133,143,237,222,258,206,225**;DEC 1997;Build 293 ;^PS(50.7 -2223 4 ;^PSDRUG -221 5 ;^PS(50.606 -2174 6 ;^PS(55 -2228 7 ;EN1^ORCFLAG -3620 8 ; 9 ;PSO*237 quit Finish if Today > Issue date + 365 10 11 DSPL I $G(PSODSPL) S VALMBCK="Q" K PSODSPL,PSOANSQD Q 12 Q:'$D(PSOLMC) K ^TMP("PSOPO",$J) S PSOLMC=PSOLMC+113 I $D(CLOZPAT) S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),1:7) G OI 14 S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3))&('$G(PSONEW("DAYS SUPPLY"))):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30) 15 OI I '$G(PSODRUG("OI")) D 16 .S (OI,PSODRUG("OI"))=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^"),OID=$P(OR0,"^",9) 17 .I $P($G(OR0),"^",9) S POERR=1,DREN=$P(OR0,"^",9) D DRG^PSOORDRG K POERR 18 I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A",$G(PSODRUG("DEA"))'["B"!($G(PSODRUG("DEA"))["F")!($G(PSODRUG("DEA"))[1)!($G(PSODRUG("DEA"))[2) S PSONEW("# OF REFILLS")=0 19 I $D(CLOZPAT) S PSONEW("# OF REFILLS")=$S($D(PSONEW("# OF REFILLS")):PSONEW("# OF REFILLS"),$G(CLOZPAT)=2&($P(OR0,"^",11)>2):3,$G(CLOZPAT)&($P(OR0,"^",11)>1):1,1:0)20 S IEN=0 D OBX^PSOORFI1,LMDISP^PSOORFI5(ORD),DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) 21 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="*(1) Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO 22 S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) 23 K LST I $G(PSODRUG("NAME"))]"" D G PT 24 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID 25 .S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)26 .I $P($G(^PSDRUG(PSODRUG("IEN"),0)),"^",10)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Drug Message:" D DRGMSG 27 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Drug: No Dispense Drug Selected" 28 PT D DOSE2^PSOORFI4 29 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Pat Instruct:" D:$O(PSONEW("SIG",0)) INST^PSOORFI4 30 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider Comments:" S TY=3 D INST^PSOORFI1 31 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Instructions:" S TY=2 D INST^PSOORFI1 32 K PSOELSE S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:"33 F I=0:0 S I=$O(SIG(I)) Q:'I S SIG=SIG(I) D 34 .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG) 35 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Patient Status: "_$P($G(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^") 36 K PSOELSE I $G(PSONEW("ISSUE DATE"))']"" S PSOELSE=1 S IEN=IEN+1,(PSOID,Y)=$E($P(OR0,"^",6),1,7) X ^DD("DD") S PSONEW("ISSUE DATE")=Y,^TMP("PSOPO",$J,IEN,0)=" (4) Issue Date: "_Y 37 I '$G(PSOELSE) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE") 38 K PSOELSE I $G(PSORX("FILL DATE"))']"" S PSOELSE=1D39 .S (Y,PSORX("FILL DATE"))=$S($E($P(OR0,"^",6),1,7)<DT:DT,1:$E($P(OR0,"^",6),1,7)) X ^DD("DD") S PSONEW("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (5) Fill Date: "_Y 40 I '$G(PSOELSE) S Y=PSORX("FILL DATE") X ^DD("DD") S PSORX("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (7) Fill Date: "_PSORX("FILL DATE")41 I $P(OR0,"^",18) S IEN=IEN+1,Y=$P(OR0,"^",18) X ^DD("DD") S $P(^TMP("PSOPO",$J,IEN,0)," ",39)="Effective Date: "_Y42 I $D(CLOZPAT) D ELIG^PSOORFI2 S:'$D(PSONEW("QTY")) PSONEW("QTY")=0 43 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Days Supply: "_PSONEW("DAYS SUPPLY") 44 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (9) QTY"_$S($P($G(^PSDRUG(+$G(PSODRUG("IEN")),660)),"^",8)]"":" ("_$P($G(^PSDRUG(+PSODRUG("IEN"),660)),"^",8)_")",1:" ( )") 45 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_": "_$S($G(PSONEW("QTY"))]"":PSONEW("QTY"),1:$P(OR0,"^",10))46 I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),5)),"^")]"" D 47 .S $P(RN," ",79)=" ",IEN=IEN+1 48 .S ^TMP("PSOPO",$J,IEN,0)=$E(RN,$L("QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^") K RN 49 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider ordered "_+$P(OR0,"^",11)_" refills" 50 D:$D(CLOZPAT) PQTY^PSOORFI4 51 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(10) # of Refills: "_$S($G(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),1:$P(OR0,"^",11))_" (11) Routing: "_$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",1:"WINDOW") 52 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(12) Clinic: "_PSORX("CLINIC") 53 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME") 54 I $P($G(^VA(200,$S($G(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$P(OR0,"^",5)),"PS")),"^",7)&($P($G(^("PS")),"^",8)) D 55 .S IEN=IEN+1,PSONEW("COSIGNING PROVIDER")=$S($G(PSONEW("COSIGNING PROVIDER")):PSONEW("COSIGNING PROVIDER"),1:$P(^("PS"),"^",8)) 56 .S ^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")57 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(14) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1)58 S PSONEW("REMARKS")=$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),$P(OR0,"^",17)="C":"Administered in Clinic.",1:"")59 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(15) Remarks:" 60 I $G(PSONEW("REMARKS"))]"" D 61 .F SG=1:1:$L(PSONEW("REMARKS")) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(PSONEW("REMARKS")," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D 62 ..S:$P(PSONEW("REMARKS")," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("REMARKS")," ",SG)63 I $G(PSOSIGFL)!(PSODRUG("OI")'=$P(OR0,"^",8)) S PSONEW("CLERK CODE")=DUZ,PSORX("CLERK CODE")=$P(^VA(200,DUZ,0),"^"),VALMSG="This change will create a new prescription!" 64 S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,PSONEW("CLERK CODE"),0),"^")_$E(RN,$L($P(^VA(200,PSONEW("CLERK CODE"),0),"^"))+1,35) 65 S Y=$P(OR0,"^",12) X ^DD("DD") S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$E($P(OR0,"^",12),4,5)_"/"_$E($P(OR0,"^",12),6,7)_"/"_$E($P(OR0,"^",12),2,3)_" "_$P(Y,"@",2) K RN 66 I PSOLMC<2 D ^PSOLMPO1 S VALMBCK="Q",PSOLMC=0 67 S:PSOLMC>1 VALMBCK="R" 68 Q 69 ORCHK D PROVCOM^PSOORFI4,ORCHK^PSOORFI4 70 Q 71 EDT D KV S DIR("A",1)="* Indicates which fields will create an new Order",DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:15" D ^DIR Q:$D(DTOUT)!($D(DUOUT)) 72 EDTSEL N LST,FLD,OUT D KV S OUT=0 73 I +Y S LST=Y D FULL^VALM1 N PSODOSE M PSODOSE=PSONEW D G DSPL 74 .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']""!(OUT) D @(+$P(LST,",",FLD)) D:$P(LST,",",FLD)=8 REF D KV 75 E S VALMBCK="" Q 76 77 ACP ; 78 I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 D Q:$D(DIRUT)!'Y D EN1^ORCFLAG(+$P($G(^PS(52.41,ORD,0)),"^")) H 1 79 . D FULL^VALM1 D KV 80 . S DIR("A",1)="This Order is flagged. In order to finish it" 81 . S DIR("A",2)="you must unflag it first." 82 . S DIR("A",3)="" 83 . S DIR(0)="Y",DIR("A")="Unflag Order",DIR("B")="NO" 84 . W ! D ^DIR I $D(DIRUT)!'Y S VALMBCK="Q" 85 I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 Q 86 ; 87 I $D(CLOZPAT),+$G(PSONEW("QTY"))=0 S VALMSG="Unable to calculate the quantity, enter a quantity" G DSPL 88 S (PSODIR("DFLG"),PSORX("DFLG"),PSODIR("QFLD"))=0,ACP=1 D ORCHK 89 G:$G(PSONEW("QFLG"))DSPL90 I $G(PSODIR("DFLG"))!$G(PSORX("DFLG")) Q 91 I $G(PSONEW("FLD"))!($G(PSODRUG("NAME"))']"")!('$O(SIG(0))) G DSPL 92 I $G(PSODRUG("NAME"))]"",'$G(ORCHK)!($G(ORDRG)'=PSODRUG("NAME")) D I $G(PSORX("DFLG")) D CLEAN^PSOVER1 G DSPL 93 .D POST^PSODRG S:'$G(PSORX("DFLG")) ORCHK=1,ORDRG=PSODRUG("NAME") 94 I '$D(PSONEW("RX #")) S PSOFROM="NEW",RTN=$S($P($G(PSOPAR),"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN") D @RTN Q:PSONEW("QFLG") I '$P($G(PSOPAR),"^",7) S PSOX=PSONEW("RX #") D CHECK^PSONRXN 95 D RXNCHK^PSOORNE1 I $G(PSONEW("QFLG")) S PSONEW("DFLG")=1 Q 96 I DT>$$FMADD^XLFDT($P(OR0,"^",6),365) D EXPR^PSONEW2 G DSPL 97 D STOP^PSONEW2,DISPLAY^PSONEW2,^PSONEWF 98 I $G(PSOCPZ("DFLG")) W !!,"No action taken!",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR,KV K PSOCPZ("DFLG"),DRET,PSOANSQD S VALMBCK="Q" Q 99 ; 100 K PSOCPZ("DFLG") D KV S DIR(0)="Y",DIR("A")="Are you sure you want to Accept this Order",DIR("B")="NO" D ^DIR I $D(DIRUT) D KV K DRET,PSOANSQ,PSOANSQD S VALMBCK="Q" Q 101 D KV I 'Y K PSOANSQ G DSPL 102 I $G(PSONEW("MAIL/WINDOW"))["W" D:$P($G(PSOPAR),"^",12) S BINGCRT="Y",BINGRTE="W",PSORX("MAIL/WINDOW")="WINDOW" K RTN 103 .W ! K DIR,DIRUT S DIR(0)="52,35O" 104 .S:$G(PSORX("METHOD OF PICK-UP"))]"" DIR("B")=PSORX("METHOD OF PICK-UP") D ^DIR I $D(DIRUT) K DIR,DIRUT Q 105 .S (PSONEW("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y K X,Y 106 S PSONEW("POE")=1 D EN^PSON52(.PSONEW) G:$G(PSONEW("DFLG")) ABORT D DCORD^PSONEW2 107 D NPSOSD^PSOUTIL(.PSONEW),FULL^VALM1 K PSORX("MAIL/WINDOW") 108 D EOJ^PSONEW 109 ABORT S VALMBCK="Q",DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR,CLEAN^PSOVER1,KV 110 Q 111 KV K DIRUT,DUOUT,DTOUT,DIR 112 Q 113 REF D REF^PSOORFI4 114 Q 115 1 N PSOBDR,PSOBDRG S PSOBDRG=1 D 1^PSOORNW2 Q ;oi 116 ; 117 4 D INS^PSOORNW2 Q 118 ; 119 3 D DOSE^PSOORED4(.PSONEW) Q 120 ; 121 6 D 4^PSOORNW2 Q ;idt 122 ; 123 7 D 5^PSOORNW2 Q ;fdt 124 ; 125 5 D 3^PSOORNW2 Q ;pstat 126 ; 127 13 D 12^PSOORNW2 Q ;doc 128 ; 129 12 D 11^PSOORNW2 Q ;cli 130 ; 131 2 N PSOCSIG I '$G(PSOBDRG) N PSOBDR,PSOBDRG S PSOBDRG=1 132 D 2^PSOORNW1 Q:$G(PSOQFLG) D EN^PSODIAG ;drg/ICD 133 I $G(PSOCSIG) K PSOCSIG G 3 134 Q 135 ; 136 9 D 8^PSOORNW2 Q ;qty 137 ; 138 8 D 7^PSOORNW2 Q ;ds 139 ; 140 10 D 9^PSOORNW2 Q ;#rfs 141 ; 142 14 D 13^PSOORNW2 Q ;cop 143 ; 144 11 D 10^PSOORNW2 Q ;m/w 145 ; 146 15 D 14^PSOORNW2 Q ;rem 147 ; 148 DRGMSG;149 F SG=1:1:$L($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D 150 .S:$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG) 151 K SG Q 1 PSOORNEW ;BIR/SAB - display orders from oerr ;1/27/07 13:29 2 ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,55,46,71,90,94,106,131,133,143,237,222,258,208**;DEC 1997;Build 39 3 ; Modified from FOIA VISTA, 4 ; Copyright (C) 2007 WorldVistA 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 ;^PS(50.7 -2223 12 ;^PSDRUG -221 13 ;^PS(50.606 -2174 14 ;^PS(55 -2228 15 ;PSO*237 quit Finish if Today > Issue date + 365 16 DSPL I $G(PSODSPL) S VALMBCK="Q" K PSODSPL,PSOANSQD Q 17 Q:'$D(PSOLMC) K ^TMP("PSOPO",$J) S PSOLMC=PSOLMC+1 18 I $D(CLOZPAT) S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),1:7) G OI 19 S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3))&('$G(PSONEW("DAYS SUPPLY"))):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30) 20 OI I '$G(PSODRUG("OI")) D 21 .S (OI,PSODRUG("OI"))=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^"),OID=$P(OR0,"^",9) 22 .I $P($G(OR0),"^",9) S POERR=1,DREN=$P(OR0,"^",9) D DRG^PSOORDRG K POERR 23 I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A",$G(PSODRUG("DEA"))'["B"!($G(PSODRUG("DEA"))["F") S PSONEW("# OF REFILLS")=0 24 I $D(CLOZPAT) S PSONEW("# OF REFILLS")=$S($D(PSONEW("# OF REFILLS")):PSONEW("# OF REFILLS"),$G(CLOZPAT)=2&($P(OR0,"^",11)>2):3,$G(CLOZPAT)&($P(OR0,"^",11)>1):1,1:0) 25 S IEN=0 D OBX^PSOORFI1,DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) 26 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="*(1) Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO 27 S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) 28 K LST I $G(PSODRUG("NAME"))]"" D G PT 29 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID 30 .S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) 31 .I $P($G(^PSDRUG(PSODRUG("IEN"),0)),"^",10)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Drug Message:" D DRGMSG 32 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Drug: No Dispense Drug Selected" 33 PT D DOSE2^PSOORFI4 34 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Pat Instruct:" D:$O(PSONEW("SIG",0)) INST^PSOORFI4 35 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider Comments:" S TY=3 D INST^PSOORFI1 36 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Instructions:" S TY=2 D INST^PSOORFI1 37 K PSOELSE S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:" 38 F I=0:0 S I=$O(SIG(I)) Q:'I S SIG=SIG(I) D 39 .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG) 40 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Patient Status: "_$P($G(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^") 41 K PSOELSE I $G(PSONEW("ISSUE DATE"))']"" S PSOELSE=1 S IEN=IEN+1,(PSOID,Y)=$E($P(OR0,"^",6),1,7) X ^DD("DD") S PSONEW("ISSUE DATE")=Y,^TMP("PSOPO",$J,IEN,0)=" (4) Issue Date: "_Y 42 I '$G(PSOELSE) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE") 43 K PSOELSE I $G(PSORX("FILL DATE"))']"" S PSOELSE=1 D 44 .S (Y,PSORX("FILL DATE"))=$S($E($P(OR0,"^",6),1,7)<DT:DT,1:$E($P(OR0,"^",6),1,7)) X ^DD("DD") S PSONEW("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (5) Fill Date: "_Y 45 I '$G(PSOELSE) S Y=PSORX("FILL DATE") X ^DD("DD") S PSORX("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (7) Fill Date: "_PSORX("FILL DATE") 46 I $P(OR0,"^",18) S IEN=IEN+1,Y=$P(OR0,"^",18) X ^DD("DD") S $P(^TMP("PSOPO",$J,IEN,0)," ",39)="Effective Date: "_Y 47 I $D(CLOZPAT) D ELIG^PSOORFI2 S:'$D(PSONEW("QTY")) PSONEW("QTY")=0 48 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Days Supply: "_PSONEW("DAYS SUPPLY") 49 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (9) QTY"_$S($P($G(^PSDRUG(+$G(PSODRUG("IEN")),660)),"^",8)]"":" ("_$P($G(^PSDRUG(+PSODRUG("IEN"),660)),"^",8)_")",1:" ( )") 50 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_": "_$S($G(PSONEW("QTY"))]"":PSONEW("QTY"),1:$P(OR0,"^",10)) 51 I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),5)),"^")]"" D 52 .S $P(RN," ",79)=" ",IEN=IEN+1 53 .S ^TMP("PSOPO",$J,IEN,0)=$E(RN,$L("QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^") K RN 54 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider ordered "_+$P(OR0,"^",11)_" refills" 55 D:$D(CLOZPAT) PQTY^PSOORFI4 56 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(10) # of Refills: "_$S($G(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),1:$P(OR0,"^",11))_" (11) Routing: "_$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",1:"WINDOW") 57 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(12) Clinic: "_PSORX("CLINIC") 58 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME") 59 I $P($G(^VA(200,$S($G(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$P(OR0,"^",5)),"PS")),"^",7)&($P($G(^("PS")),"^",8)) D 60 .S IEN=IEN+1,PSONEW("COSIGNING PROVIDER")=$S($G(PSONEW("COSIGNING PROVIDER")):PSONEW("COSIGNING PROVIDER"),1:$P(^("PS"),"^",8)) 61 .S ^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^") 62 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(14) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1) 63 S PSONEW("REMARKS")=$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),$P(OR0,"^",17)="C":"Administered in Clinic.",1:"") 64 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(15) Remarks:" 65 I $G(PSONEW("REMARKS"))]"" D 66 .F SG=1:1:$L(PSONEW("REMARKS")) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(PSONEW("REMARKS")," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D 67 ..S:$P(PSONEW("REMARKS")," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("REMARKS")," ",SG) 68 I $G(PSOSIGFL)!(PSODRUG("OI")'=$P(OR0,"^",8)) S PSONEW("CLERK CODE")=DUZ,PSORX("CLERK CODE")=$P(^VA(200,DUZ,0),"^"),VALMSG="This change will create a new prescription!" 69 S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,PSONEW("CLERK CODE"),0),"^")_$E(RN,$L($P(^VA(200,PSONEW("CLERK CODE"),0),"^"))+1,35) 70 S Y=$P(OR0,"^",12) X ^DD("DD") S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$E($P(OR0,"^",12),4,5)_"/"_$E($P(OR0,"^",12),6,7)_"/"_$E($P(OR0,"^",12),2,3)_" "_$P(Y,"@",2) K RN 71 I PSOLMC<2 D ^PSOLMPO1 S VALMBCK="Q",PSOLMC=0 72 S:PSOLMC>1 VALMBCK="R" 73 Q 74 ORCHK D PROVCOM^PSOORFI4 75 I $G(PSOAFYN)'="Y" D ORCHK^PSOORFI4 76 Q 77 EDT D KV S DIR("A",1)="* Indicates which fields will create an new Order",DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:15" D ^DIR Q:$D(DTOUT)!($D(DUOUT)) 78 EDTSEL N LST,FLD,OUT D KV S OUT=0 79 I +Y S LST=Y D FULL^VALM1 N PSODOSE M PSODOSE=PSONEW D G DSPL 80 .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']""!(OUT) D @(+$P(LST,",",FLD)) D:$P(LST,",",FLD)=8 REF D KV 81 E S VALMBCK="" Q 82 Q 83 ACP ; 84 I $D(CLOZPAT),+$G(PSONEW("QTY"))=0 S VALMSG="Unable to calculate the quantity, enter a quantity" G DSPL 85 S (PSODIR("DFLG"),PSORX("DFLG"),PSODIR("QFLD"))=0,ACP=1 D ORCHK 86 G:$G(PSONEW("QFLG")) DSPL 87 I $G(PSODIR("DFLG"))!$G(PSORX("DFLG")) Q 88 I $G(PSONEW("FLD"))!($G(PSODRUG("NAME"))']"")!('$O(SIG(0))) G DSPL 89 I $G(PSODRUG("NAME"))]"",'$G(ORCHK)!($G(ORDRG)'=PSODRUG("NAME")) D I $G(PSORX("DFLG")) D CLEAN^PSOVER1 G DSPL 90 .D POST^PSODRG S:'$G(PSORX("DFLG")) ORCHK=1,ORDRG=PSODRUG("NAME") 91 I '$D(PSONEW("RX #")) S PSOFROM="NEW",RTN=$S($P($G(PSOPAR),"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN") D @RTN Q:PSONEW("QFLG") I '$P($G(PSOPAR),"^",7) S PSOX=PSONEW("RX #") D CHECK^PSONRXN 92 D RXNCHK^PSOORNE1 I $G(PSONEW("QFLG")) S PSONEW("DFLG")=1 Q 93 I DT>$$FMADD^XLFDT($P(OR0,"^",6),365) D EXPR^PSONEW2 G DSPL 94 I $G(PSOAFYN)'="Y" D STOP^PSONEW2,DISPLAY^PSONEW2,^PSONEWF 95 I $G(PSOAFYN)="Y" D STOP^PSONEW2 96 I $G(PSOCPZ("DFLG")) W !!,"No action taken!",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR,KV K PSOCPZ("DFLG"),DRET,PSOANSQD S VALMBCK="Q" Q 97 I $G(PSOAFYN)'="Y" K PSOCPZ("DFLG") D KV S DIR(0)="Y",DIR("A")="Are you sure you want to Accept this Order",DIR("B")="NO" D ^DIR I $D(DIRUT) D KV K DRET,PSOANSQ,PSOANSQD S VALMBCK="Q" Q 98 I $G(PSOAFYN)="Y" S Y="1" 99 D KV I 'Y K PSOANSQ G DSPL 100 I $G(PSONEW("MAIL/WINDOW"))["W" D:$P($G(PSOPAR),"^",12) S BINGCRT="Y",BINGRTE="W",PSORX("MAIL/WINDOW")="WINDOW" K RTN 101 .I $G(PSOAFYN)'="Y" W ! K DIR,DIRUT S DIR(0)="52,35O" 102 .I $G(PSOAFYN)'="Y" S:$G(PSORX("METHOD OF PICK-UP"))]"" DIR("B")=PSORX("METHOD OF PICK-UP") D ^DIR I $D(DIRUT) K DIR,DIRUT Q 103 .I $G(PSOAFYN)'="Y" S (PSONEW("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y K X,Y 104 .I $G(PSOAFYN)="Y" S (PSONEW("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))="AutoFinished for Rx Printing" 105 S PSONEW("POE")=1 D EN^PSON52(.PSONEW) G:$G(PSONEW("DFLG")) ABORT D DCORD^PSONEW2 106 D NPSOSD^PSOUTIL(.PSONEW),FULL^VALM1 K PSORX("MAIL/WINDOW") 107 D EOJ^PSONEW 108 ABORT ; 109 I $G(PSOAFYN)'="Y" S VALMBCK="Q",DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR,CLEAN^PSOVER1,KV ;vfah 110 I $G(PSOAFYN)="Y" D CLEAN^PSOVER1,KV ;vfah 111 Q 112 KV K DIRUT,DUOUT,DTOUT,DIR 113 Q 114 REF D REF^PSOORFI4 115 Q 116 1 N PSOBDR,PSOBDRG S PSOBDRG=1 D 1^PSOORNW2 Q ;oi 117 ; 118 4 D INS^PSOORNW2 Q 119 ; 120 3 D DOSE^PSOORED4(.PSONEW) Q 121 ; 122 6 D 4^PSOORNW2 Q ;idt 123 ; 124 7 D 5^PSOORNW2 Q ;fdt 125 ; 126 5 D 3^PSOORNW2 Q ;pstat 127 ; 128 13 D 12^PSOORNW2 Q ;doc 129 ; 130 12 D 11^PSOORNW2 Q ;cli 131 ; 132 2 N PSOCSIG I '$G(PSOBDRG) N PSOBDR,PSOBDRG S PSOBDRG=1 133 D 2^PSOORNW1 Q:$G(PSOQFLG) D EN^PSODIAG ;drg/ICD 134 I $G(PSOCSIG) K PSOCSIG G 3 135 Q 136 ; 137 9 D 8^PSOORNW2 Q ;qty 138 ; 139 8 D 7^PSOORNW2 Q ;ds 140 ; 141 10 D 9^PSOORNW2 Q ;#rfs 142 ; 143 14 D 13^PSOORNW2 Q ;cop 144 ; 145 11 D 10^PSOORNW2 Q ;m/w 146 ; 147 15 D 14^PSOORNW2 Q ;rem 148 ; 149 DRGMSG ; 150 D DRGMSG^PSOORNW2 Q ;vfam 151 ;
Note:
See TracChangeset
for help on using the changeset viewer.
