- 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/PSOORFI1.m
r613 r623 1 PSOORFI1 ;BIR/SAB - finish OP orders from OE/RR continued ;5/23/05 2:11pm2 ;;7.0;OUTPATIENT PHARMACY;**7,15,23,27,32,44,51,46,71,90,108,131,152,186,210,222,258,260,225**;DEC 1997;Build 293 ;Ref. ^PS(50.7 supp. DBIA 2223 4 ;Ref. ^PSDRUG( supp. DBIA 221 5 ;Ref. L^PSSLOCK supp. DBIA 2789 6 ;Ref. ^PS(50.606 supp. DBIA 2174 7 ;Ref. ^PS(55 supp. DBIA 2228 8 ;Ref. ULK^ORX2 supp. DBIA 867 9 ; 10 ;PSO*186 add call to function $$DEACHK 11 ;PSO*210 add call to WORDWRAP api 12 ; 13 S SIGOK=1 14 DSPL K ^TMP("PSOPO",$J),CLOZPAT,PSOPRC,PSODSPL 15 S (OI,PSODRUG("OI"))=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^"),OID=$P(OR0,"^",9) 16 I $P($G(OR0),"^",9) S POERR=1,DREN=$P(OR0,"^",9) D DRG^PSOORDRG K POERR G DRG 17 I '$P(OR0,"^",9) D DREN^PSOORNW2 18 DRG I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),"CLOZ1")),"^")="PSOCLO1" D CLOZ^PSOORFI2 19 ;PSO*186 modify If/Else below to use DEACHK 20 I $G(PSODRUG("DEA"))]"" D 21 .S PSOCS=0 K DIR,DIC,PSOX 22 .N PSDEA,PSDAYS S PSDEA=PSODRUG("DEA"),PSDAYS=+$P(OR0,"^",22) 23 .I $$DEACHK^PSOUTLA1("*",PSDEA,PSDAYS,$G(CLOZPAT),.PSOCS,.PSOMAX) 24 E D 25 .S PSOMAX=$S($G(CLOZPAT)=2:3,$G(CLOZPAT)=1:1,1:$P(OR0,"^",11))26 ISSDT S (PSOID,Y,PSONEW("ISSUE DATE"))=$S($G(PSONEW("ISSUE DATE")):PSONEW("ISSUE DATE"),$P($G(OR0),"^",6):$E($P(OR0,"^",6),1,7),1:DT)27 X ^DD("DD") S PSONEW("ISSUE DATE")=Y 28 D USER^PSOORFI2($P(OR0,"^",4)) S PSONEW("CLERK CODE")=$P(OR0,"^",4),PSORX("CLERK CODE")=USER1 29 S (PSONEW("DFLG"),PSONEW("QFLG"))=0,PSODFN=$P(OR0,"^",2),PSONEW("QTY")=$P(OR0,"^",10),PSONEW("MAIL/WINDOW")=$S($P(OR0,"^",17)="M":"M",1:"W")30 S:$G(PSONEW("CLINIC"))']"" PSONEW("CLINIC")=+$P(OR0,"^",13),PSORX("CLINIC")=$S($D(^SC(PSONEW("CLINIC"),0)):$P(^SC(PSONEW("CLINIC"),0),"^"),1:"") 31 S:$G(PSORX("CLINIC"))']"" PSORX("CLINIC")=$S($D(^SC(+$P(OR0,"^",13),0)):$P(^SC($P(OR0,"^",13),0),"^"),1:"") 32 D USER^PSOORFI2($P(OR0,"^",5))33 S PSONEW("CLERK CODE")=$P(OR0,"^",4),PSONEW("PROVIDER")=$P(OR0,"^",5),PSONEW("PROVIDER NAME")=USER1 34 S PSONEW("PATIENT STATUS")=$S(+$G(^PS(55,PSODFN,"PS")):+$G(^PS(55,PSODFN,"PS")),1:"")35 S PSONEW("CHCS NUMBER")=$S($P($G(^PS(52.41,+$G(ORD),"EXT")),"^")'="":$P($G(^("EXT")),"^"),1:"")36 S PSONEW("EXTERNAL SYSTEM")=$S($P($G(^PS(52.41,+$G(ORD),"EXT")),"^",3)'="":$P($G(^("EXT")),"^",3),1:"") 37 I $P(OR0,"^",22)>0 S PSONEW("DAYS SUPPLY")=$P(OR0,"^",22) G DS 38 S PSONEW("DAYS SUPPLY")=$S(+$G(^PS(55,PSODFN,"PS"))&($P($G(^PS(53,+$G(^PS(55,PSODFN,"PS")),0)),"^",3)):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30)39 DS S:$D(CLOZPAT) PSONEW("DAYS SUPPLY")=$S(CLOZPAT=2&(PSONEW("DAYS SUPPLY")>28):28,CLOZPAT=1&(PSONEW("DAYS SUPPLY")>14):14,'CLOZPAT&(PSONEW("DAYS SUPPLY")>7):7,1:PSONEW("DAYS SUPPLY"))40 S IEN=0 D OBX ; Display Order Checks Information 41 D LMDISP^PSOORFI5(+$G(ORD)) ; Display Flag/Unflag Information 42 D DIN^PSONFI(PSODRUG("OI"),$S($D(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) ;Setup for N/F & DIN indicator 43 I $G(PKI1)!($G(PKI)=1) D L1^PSOPKIV1 K:$G(PKI)=1 PKI 44 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 45 S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) 46 D FULL^VALM1 K LST I $G(PSODRUG("NAME"))]"" D G PST 47 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID 48 .S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) 49 .I $P(^PSDRUG(PSODRUG("IEN"),0),"^",10)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Drug Message:" D DRGMSG^PSOORNEW 50 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Drug: No Dispense Drug Selected" 51 PST D DOSE^PSOORFI4 K PSOINSFL 52 S PSOINSFL=$P($G(^PS(52.41,ORD,"INS")),"^",2) 53 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Pat Instruct:" D INST^PSOORFI4 54 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider Comments:" S TY=3 D INST 55 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Instructions:" S TY=2 D INST 56 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:" D SIG 57 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Patient Status: "_$P($G(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^") 58 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE") 59 S (Y,PSONEW("FILL DATE"))=$S($E($P(OR0,"^",6),1,7)<DT:DT,1:$E($P(OR0,"^",6),1,7)) X ^DD("DD") S PSORX("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (7) Fill Date: "_Y 60 I $P(OR0,"^",18) D 61 .S IEN=IEN+1,Y=$P(OR0,"^",18) X ^DD("DD") S $P(^TMP("PSOPO",$J,IEN,0)," ",39)="EffectiveDate: "_Y62 D:$D(CLOZPAT) ELIG^PSOORFI2,CLQTY^PSOORFI4 63 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) 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)):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:"") 64 I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D 65 .S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:+$P(OR0,"^",11)),PSOX=+$P(^PS(53,RXPT,0),"^",4)66 .S PSONEW("# OF REFILLS")=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS")) 67 .S PSOMAX=$S(PSOMAX>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:PSOMAX) K RXPT 68 .S MPSDY=PSONEW("DAYS SUPPLY")69 .;I PSOMAX=5 S MAXRF=$S(MPSDY<60:5,MPSDY'<60&(MPSDY'>89):2,1:1) I PSONEW("# OF REFILLS")>MAXRF S PSONEW("# OF REFILLS")=MAXRF K MAXRF,MPSDY Q 70 .S MAXRF=$S(MPSDY<60:11,MPSDY'<60&(MPSDY'>89):5,MPSDY=90:3,1:0)71 .I PSONEW("# OF REFILLS")>MAXRF S PSONEW("# OF REFILLS")=MAXRF K MAXRF,MPSDY 72 E D 73 . I $G(PSOMAX) S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11)) Q 74 .S PSONEW("# OF REFILLS")=+$P(OR0,"^",11) 75 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(+$G(PSODRUG("IEN")),660)),"^",8)_")",1:" ( )")_": " 76 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$S($D(CLOZPAT):+$G(PSONEW("QTY")),1:$P(OR0,"^",10))77 I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),5)),"^")]"" D 78 .S $P(RN," ",79)=" ",IEN=IEN+1 79 .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 80 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider ordered "_+$P(OR0,"^",11)_" refills" 81 D:$D(CLOZPAT) PQTY^PSOORFI4 82 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(10) # of Refills: "_PSONEW("# OF REFILLS")_$E(" ",$L(PSONEW("# OF REFILLS"))+1,2)_" (11) Routing: "_$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",1:"WINDOW") 83 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(12) Clinic: "_PSORX("CLINIC") 84 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME")85 I $P($G(^VA(200,$S($G(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$P(OR0,"^",5)),"PS")),"^",7)&($P($G(^("PS")),"^",8)) S PSONEW("COSIGNING PROVIDER")=$P(^("PS"),"^",8) D 86 .D USER^PSOORFI2(PSONEW("COSIGNING PROVIDER"))87 .S IEN=IEN+1 S ^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_USER1 88 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(14) Copies: 1" 89 S PSONEW("REMARKS")=$S($P(OR0,"^",17)="C":"Administered in Clinic.",1:"") 90 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(15) Remarks: "_$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"") 91 D USER^PSOORFI2($P(OR0,"^",4))92 S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_USER1_$E(RN,$L(USER1)+1,35)93 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 94 S PSOACT=$S($D(^XUSEC("PSORPH",DUZ)):"DEFX",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"")95 ; - PSOACTOV is used to force the Pending Order to be Read-Only (no updates) even if invoked by a Pharmacist 96 I $G(PSOACTOV) S PSOACT="" 97 98 99 POST 100 D POST^PSOORFI2 Q 101 SIG ;displays possible sig 102 D SIG^PSOORFI2 Q 103 INST ;displays provider comments and pharmacy instructions 104 S INST=0 F S INST=$O(^PS(52.41,ORD,TY,INST)) Q:'INST D ;PSO*210 105 . S (MIG,INST(INST))=^PS(52.41,ORD,TY,INST,0) 106 . D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOPO",$J)),20)107 K INST,TY,MIG,SG 108 Q 109 OBX ;formats obx section 110 D OBX^PSOORFI4 111 Q 112 ST ;sort by route or patient 113 W !!,"Enter 'PA' to process orders by patients",!," 'RT' to process orders by route (mail/window)",!," 'PR' to process orders by priority",!," 'CL' to process orders by clinic" 114 W !," 'FL' to process flagged orders",!," or 'E' or '^' to exit" W ! Q115 RT 116 117 PT 118 119 EP 120 121 LOCK 122 123 124 ULK 125 126 LOCK1 S PSOACT=$S($D(^XUSEC("PSORPH",DUZ)):"DEFX",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"")127 128 EX 129 130 131 132 133 134 1 PSOORFI1 ;BIR/SAB - finish OP orders from OE/RR continued ;1/27/07 13:24 2 ;;7.0;OUTPATIENT PHARMACY;**7,15,23,27,32,44,51,46,71,90,108,131,152,186,210,222,258,208**;DEC 1997;Build 39 3 ; Modified from FOIA VISTA, 4 ; GPL Copyright (C) 2007 WorldVistA 5 ;Ref. ^PS(50.7 supp. DBIA 2223 6 ;Ref. ^PSDRUG( supp. DBIA 221 7 ;Ref. L^PSSLOCK supp. DBIA 2789 8 ;Ref. ^PS(50.606 supp. DBIA 2174 9 ;Ref. ^PS(55 supp. DBIA 2228 10 ;Ref. ULK^ORX2 supp. DBIA 867 11 ; 12 ;PSO*186 add call to function $$DEACHK 13 ;PSO*210 add call to WORDWRAP api 14 ; 15 S SIGOK=1 16 DSPL K ^TMP("PSOPO",$J),CLOZPAT,PSOPRC,PSODSPL 17 S (OI,PSODRUG("OI"))=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^"),OID=$P(OR0,"^",9) 18 I $P($G(OR0),"^",9) S POERR=1,DREN=$P(OR0,"^",9) D DRG^PSOORDRG K POERR G DRG 19 I '$P(OR0,"^",9)&($G(PSOAFYN)="Y") D DISPD^PSOAFIN G DSPL ;vfah 060924 20 I '$P(OR0,"^",9) D DREN^PSOORNW2 21 DRG I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),"CLOZ1")),"^")="PSOCLO1" D CLOZ^PSOORFI2 22 ;PSO*186 modify If/Else below to use DEACHK 23 I $G(PSODRUG("DEA"))]"" D 24 .S PSOCS=0 K DIR,DIC,PSOX 25 .N PSDEA,PSDAYS S PSDEA=PSODRUG("DEA"),PSDAYS=+$P(OR0,"^",22) 26 .I $$DEACHK^PSOUTLA1("*",PSDEA,PSDAYS,$G(CLOZPAT),.PSOCS,.PSOMAX) 27 E D 28 .S PSOMAX=$S($G(CLOZPAT)=2:3,$G(CLOZPAT)=1:1,1:$P(OR0,"^",11)) 29 ISSDT S (PSOID,Y,PSONEW("ISSUE DATE"))=$S($G(PSONEW("ISSUE DATE")):PSONEW("ISSUE DATE"),$P($G(OR0),"^",6):$E($P(OR0,"^",6),1,7),1:DT) 30 X ^DD("DD") S PSONEW("ISSUE DATE")=Y 31 D USER^PSOORFI2($P(OR0,"^",4)) S PSONEW("CLERK CODE")=$P(OR0,"^",4),PSORX("CLERK CODE")=USER1 32 S (PSONEW("DFLG"),PSONEW("QFLG"))=0,PSODFN=$P(OR0,"^",2),PSONEW("QTY")=$P(OR0,"^",10),PSONEW("MAIL/WINDOW")=$S($P(OR0,"^",17)="M":"M",1:"W") 33 S:$G(PSONEW("CLINIC"))']"" PSONEW("CLINIC")=+$P(OR0,"^",13),PSORX("CLINIC")=$S($D(^SC(PSONEW("CLINIC"),0)):$P(^SC(PSONEW("CLINIC"),0),"^"),1:"") 34 S:$G(PSORX("CLINIC"))']"" PSORX("CLINIC")=$S($D(^SC(+$P(OR0,"^",13),0)):$P(^SC($P(OR0,"^",13),0),"^"),1:"") 35 D USER^PSOORFI2($P(OR0,"^",5)) 36 S PSONEW("CLERK CODE")=$P(OR0,"^",4),PSONEW("PROVIDER")=$P(OR0,"^",5),PSONEW("PROVIDER NAME")=USER1 37 S PSONEW("PATIENT STATUS")=$S(+$G(^PS(55,PSODFN,"PS")):+$G(^PS(55,PSODFN,"PS")),1:"") 38 S PSONEW("CHCS NUMBER")=$S($P($G(^PS(52.41,+$G(ORD),"EXT")),"^")'="":$P($G(^("EXT")),"^"),1:"") 39 S PSONEW("EXTERNAL SYSTEM")=$S($P($G(^PS(52.41,+$G(ORD),"EXT")),"^",3)'="":$P($G(^("EXT")),"^",3),1:"") 40 I $P(OR0,"^",22)>0 S PSONEW("DAYS SUPPLY")=$P(OR0,"^",22) G DS 41 S PSONEW("DAYS SUPPLY")=$S(+$G(^PS(55,PSODFN,"PS"))&($P($G(^PS(53,+$G(^PS(55,PSODFN,"PS")),0)),"^",3)):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30) 42 DS S:$D(CLOZPAT) PSONEW("DAYS SUPPLY")=$S(CLOZPAT=2&(PSONEW("DAYS SUPPLY")>28):28,CLOZPAT=1&(PSONEW("DAYS SUPPLY")>14):14,'CLOZPAT&(PSONEW("DAYS SUPPLY")>7):7,1:PSONEW("DAYS SUPPLY")) 43 S IEN=0 D OBX 44 D DIN^PSONFI(PSODRUG("OI"),$S($D(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) ;Setup for N/F & DIN indicator 45 I $G(PKI1)!($G(PKI)=1) D L1^PSOPKIV1 K:$G(PKI)=1 PKI 46 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 47 S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) 48 D FULL^VALM1 K LST I $G(PSODRUG("NAME"))]"" D G PST 49 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID 50 .S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) 51 .I $P(^PSDRUG(PSODRUG("IEN"),0),"^",10)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Drug Message:" D DRGMSG^PSOORNEW 52 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Drug: No Dispense Drug Selected" 53 PST D DOSE^PSOORFI4 K PSOINSFL 54 S PSOINSFL=$P($G(^PS(52.41,ORD,"INS")),"^",2) 55 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Pat Instruct:" D INST^PSOORFI4 56 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider Comments:" S TY=3 D INST 57 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Instructions:" S TY=2 D INST 58 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:" D SIG 59 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Patient Status: "_$P($G(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^") 60 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE") 61 S (Y,PSONEW("FILL DATE"))=$S($E($P(OR0,"^",6),1,7)<DT:DT,1:$E($P(OR0,"^",6),1,7)) X ^DD("DD") S PSORX("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (7) Fill Date: "_Y 62 I $P(OR0,"^",18) D 63 .S IEN=IEN+1,Y=$P(OR0,"^",18) X ^DD("DD") S $P(^TMP("PSOPO",$J,IEN,0)," ",39)="Effective Date: "_Y 64 D:$D(CLOZPAT) ELIG^PSOORFI2,CLQTY^PSOORFI4 65 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) 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)):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:"") 66 I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D 67 .S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:+$P(OR0,"^",11)),PSOX=+$P(^PS(53,RXPT,0),"^",4) 68 .S PSONEW("# OF REFILLS")=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS")) 69 .S PSOMAX=$S(PSOMAX>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:PSOMAX) K RXPT 70 .S MPSDY=PSONEW("DAYS SUPPLY") 71 .;I PSOMAX=5 S MAXRF=$S(MPSDY<60:5,MPSDY'<60&(MPSDY'>89):2,1:1) I PSONEW("# OF REFILLS")>MAXRF S PSONEW("# OF REFILLS")=MAXRF K MAXRF,MPSDY Q 72 .S MAXRF=$S(MPSDY<60:11,MPSDY'<60&(MPSDY'>89):5,MPSDY=90:3,1:0) 73 .I PSONEW("# OF REFILLS")>MAXRF S PSONEW("# OF REFILLS")=MAXRF K MAXRF,MPSDY 74 E D 75 . I $G(PSOMAX) S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11)) Q 76 .S PSONEW("# OF REFILLS")=+$P(OR0,"^",11) 77 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(+$G(PSODRUG("IEN")),660)),"^",8)_")",1:" ( )")_": "_$P(OR0,"^",10) 78 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$S($D(CLOZPAT):+$G(PSONEW("QTY")),1:$P(OR0,"^",10)) 79 I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),5)),"^")]"" D 80 .S $P(RN," ",79)=" ",IEN=IEN+1 81 .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 82 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider ordered "_+$P(OR0,"^",11)_" refills" 83 D:$D(CLOZPAT) PQTY^PSOORFI4 84 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(10) # of Refills: "_PSONEW("# OF REFILLS")_$E(" ",$L(PSONEW("# OF REFILLS"))+1,2)_" (11) Routing: "_$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",1:"WINDOW") 85 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(12) Clinic: "_PSORX("CLINIC") 86 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME") 87 I $P($G(^VA(200,$S($G(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$P(OR0,"^",5)),"PS")),"^",7)&($P($G(^("PS")),"^",8)) S PSONEW("COSIGNING PROVIDER")=$P(^("PS"),"^",8) D 88 .D USER^PSOORFI2(PSONEW("COSIGNING PROVIDER")) 89 .S IEN=IEN+1 S ^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_USER1 90 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(14) Copies: 1" 91 S PSONEW("REMARKS")=$S($P(OR0,"^",17)="C":"Administered in Clinic.",1:"") 92 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(15) Remarks: "_$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"") 93 D USER^PSOORFI2($P(OR0,"^",4)) 94 S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_USER1_$E(RN,$L(USER1)+1,35) 95 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 96 S PSOACT=$S($D(^XUSEC("PSORPH",DUZ)):"DEF",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"") 97 D:'$G(ACP) EN^PSOLMPO S:$G(ACP) VALMBCK="Q" D:$G(PKI1)=2 DCP^PSOPKIV1 98 Q 99 POST ;post patient selection 100 I $G(PSOAFYN)'="Y" D POST^PSOORFI2 Q ;vfah 101 I $G(PSOAFYN)="Y" Q ;vfah 102 SIG ;displays possible sig 103 D SIG^PSOORFI2 Q 104 INST ;displays provider comments and pharmacy instructions 105 S INST=0 F S INST=$O(^PS(52.41,ORD,TY,INST)) Q:'INST D ;PSO*210 106 . S (MIG,INST(INST))=^PS(52.41,ORD,TY,INST,0) 107 . D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOPO",$J)),20) 108 K INST,TY,MIG,SG 109 Q 110 OBX ;formats obx section 111 D OBX^PSOORFI4 112 Q 113 ST ;sort by route or patient 114 W !!,"Enter 'PA' to process orders by patients",!," 'RT' to process orders by route (mail/window)",!," 'PR' to process orders by priority",!," 'CL' to process orders by clinic",!," or 'E' or '^' to exit" W ! Q 115 RT ;which route to sort by 116 W !!,"Enter 'W' to process window orders first",!," 'M' to process mail orders first",!," 'C' to process orders administered in clinic first",!," or 'E' or '^' to exit" Q 117 PT ;process for all or one patient 118 W !!,"Enter 'A' to process all patient orders",!," 'S' to process orders for a patient",!," or 'E' or '^' to exit" Q 119 EP ;continue processing or not 120 W !,"If you want to continue processing orders Press RETURN or enter '^' to exit" Q 121 LOCK S PSOPLCK=$$L^PSSLOCK(PAT,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S POERR("QFLG")=1 122 K PSOPLCK 123 Q 124 ULK S X=PAT_";DPT(" D ULK^ORX2 S:$G(PSOQUIT) POERR("QFLG")=1 ; not called anymore 125 Q 126 LOCK1 S PSOACT=$S($D(^XUSEC("PSORPH",DUZ)):"DEF",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"") 127 Q 128 EX K DRET,SIG,PSODRUG,PRC,PHI 129 K DIR,DIRUT,DUOUT,DIRUT,X,Y,DIC,POERR,PSONEW,PSOSD,MAIL,CLI,WIN,OR0,OR1,OR2,ORD,SRT,PSRT,PSODFN,PSOFROM,T,OR3,PAT,%,%T,%Y,DI,DQ,DR,DRG,STA,I,T1,PSOSORT 130 K TO,TC,TZ,PSOCPAY,PSOBILL,PSOIBQS,GROUPCNT,AGROUP,AGROUP1,OBX,%,%I,%H,D0,DFN,PSORX,PSOPTPST,PSOQFLG,PT,RTN,TM,TM1,DIPGM,PSOID,PSOCNT,PSOLK,PSZFIN,PSZFZZ D KVA^VADPT 131 K PSOFDR,PSOQUIT,PSOFIN,^TMP("PSOAO",$J),^TMP("PSODA",$J),^TMP("PSOPO",$J),^TMP("PSOPF",$J),^TMP("PSOPI",$J),^TMP("PSOHDR",$J),MEDA,MEDP 132 K C,CC,CNT,CRIT,D,DGI,DGS,DREN,IT,JJ,LG,MM,NIEN,PSOD,PATA,PSDAYS,PSOACT,PSOBM,PSOCOU,PSOCOUU,PSOFLAG,PSON,PSONOOR,PSOOPT,PSOPF,PSOPI,PSRF,RXFL,SDA,SEG1,SER,SERS,SLPPL,STAT,Z,Z4,ZDA 133 D FULL^VALM1 134 Q
Note:
See TracChangeset
for help on using the changeset viewer.
