- 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/PSOORNE2.m
r613 r623 1 PSOORNE2 2 ;;7.0;OUTPATIENT PHARMACY;**11,21,23,27,32,37,46,84,103,117,131,146,156,210,148,222,238,264,281**;DEC 1997;Build 41 3 4 5 6 7 8 9 10 SEL 11 12 NEWSEL 13 14 15 16 17 18 19 ACT 20 21 22 23 24 25 26 27 28 29 30 31 32 33 .S PSOACT=$S('ST&($G(INDT)]"")&(DT>$G(INDT)):"DHPLATC",ST=1:"DVE",ST=4:"DV",ST=3:"DU",ST=5:"ELTD",ST=11:"ETDPCL",ST=12&EXDT:"EDCL",ST=12&'EXDT:"ECL",ST>12&(ST'=16):"L",ST=16:"DL",1:"DHPEATCL")34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 PTST 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 UL1 114 115 116 1 PSOORNE2 ;BIR/SAB-display finished orders from backdoor ; 9/11/06 10:24am 2 ;;7.0;OUTPATIENT PHARMACY;**11,21,23,27,32,37,46,84,103,117,131,146,156,210,148,222,238,264**;DEC 1997;Build 19 3 ;^PSDRUG( - 221 4 ;^YSCL(603.01 - 2697 5 ;^PS(50.606 - 2174 6 ;^PS(50.7 - 2223 7 ;PSO*210 add call to WORDWRAP api 8 ;$$DAWEXT^PSSDAWUT - 4708 9 ; 10 SEL N ORN,ORD I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q 11 D K1^PSOORNE6 S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR I $D(DIRUT) D KV^PSOVER1 S VALMBCK="" Q 12 NEWSEL N ORN,ORD D K2^PSOORNE6 13 I +Y S PSOOELSE=1,PSLST=Y K PSOREEDT D 14 .F ORD=1:1:$L(PSLST,",") Q:$P(PSLST,",",ORD)']"" S ORN=+$P(PSLST,",",ORD) D @$S(+PSOLST(ORN)=52:"ACT",1:"PEN^PSOORNE5") K PSOREEDT,PSOSIGFL,PSONACT,SIGOK,PSOFDR,DRET,SIG,INS1 D UL1 I $G(PSOQUIT) K PSOQUIT Q 15 K PRC,PHI,RTE I '$G(PSOOELSE) S VALMBCK="" 16 K PSONACT,PSOOELSE,CLOZPAT D ^PSOBUILD,BLD^PSOORUT1,K3^PSOORNE6 17 Q 18 ; 19 ACT N REF K ^TMP("PSOAO",$J),PCOMX,PDA,PHI,PRC,ACOM,ANS,PSOFDR,CLOZPAT,ANQREM,DUR,DRET 20 S RXN=$P(PSOLST(ORN),"^",2),RX0=^PSRX(RXN,0),RX2=$G(^(2)),RX3=$G(^(3)),ST=+$G(^("STA")),RXOR=$G(^("OR1")),POE=$G(^("POE")),EXDT=$S($P($G(^(2)),"^",6)>DT:1,1:0) 21 I 'RX3 S RX3=$P(RX2,"^",2),$P(^PSRX(RXN,3),"^")=$P(RX2,"^",2) 22 S PSODRG=+$P(RX0,"^",6),PSODRUG0=^PSDRUG(PSODRG,0),INDT=$G(^("I")) 23 ;PSO*7*238;SET PSODRUG ARRAY ; PSOY KILLED AT END OF SET^PSODRG 24 K PSODRUG 25 S PSOY=PSODRG,PSOY(0)=PSODRUG0 D SET^PSODRG 26 I 'RXOR,$P(^PSDRUG(PSODRG,2),"^") S $P(^PSRX(RXN,"OR1"),"^")=$P(^PSDRUG(PSODRG,2),"^"),RXOR=$P(^PSDRUG(PSODRG,2),"^") 27 I $P($G(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1" D 28 .S CLOZPAT=$O(^YSCL(603.01,"C",PSODFN,0)) Q:'CLOZPAT 29 .;S CLOZPAT=$S($P(^YSCL(603.01,CLOZPAT,0),"^",3)="B":1,1:0) 30 .S CLOZPAT=$P(^YSCL(603.01,CLOZPAT,0),"^",3) 31 .S CLOZPAT=$S(CLOZPAT="M":2,CLOZPAT="B":1,1:0) 32 I $D(^XUSEC("PSORPH",DUZ)) S RPH=1 D 33 .S PSOACT=$S('ST&($G(INDT)]"")&(DT>$G(INDT)):"DHPLATC",ST=1:"DVE",ST=4:"DV",ST=3:"DU",ST=5:"ELTD",ST=11:"TDPCL",ST=12&EXDT:"DCL",ST=12&'EXDT:"CL",ST>12&(ST'=16):"L",ST=16:"DL",1:"DHPEATCL") 34 .D GET^PSOORNE5 S PSOACT=PSOACT_$S(ACTREN:"N",1:""),PSOACT=PSOACT_$S(ACTREF:"R",1:"") 35 .I ST=5 S SURX=$O(^PS(52.5,"B",RXN,0)) I SURX,$P($G(^PS(52.5,SURX,0)),"^",7)="L" S PSOACT="TL" K SURX Q 36 .S:ST'=12&('$D(^PS(50.7,+$P(RXOR,"^"),0))) PSOACT="DL",VALMSG="No Pharmacy Orderable Item !",PSONACT=1 37 .S:ST=12&('$D(^PS(50.7,+$P(RXOR,"^"),0))) PSOACT="L",VALMSG="No Pharmacy Orderable Item !",PSONACT=1 38 .I ST=14!(ST=15) S VALMSG="Rx Discontinued By "_$S(ST=14:"Provider",1:"Edit")_". Cannot be Reinstated." 39 .S:ST=16 VALMSG="Rx Placed on HOLD by Provider." 40 E D 41 .I ST=5 S SURX=$O(^PS(52.5,"B",RXN,0)) I SURX,$P($G(^PS(52.5,SURX,0)),"^",7)="L" S PSOACT="TL" Q 42 .S PSOACT=$S(ST'<1&(ST'>4)!(ST>12):"",ST=12&EXDT&($P($G(PSOPAR),"^",2)):"CDPLT",1:"CPLT") 43 .D GET^PSOORNE5 S PSOACT=PSOACT_$S(ACTREN:"N",1:""),PSOACT=PSOACT_$S(ACTREF:"R",1:"") 44 .S:'$D(^PS(50.7,+$P(RXOR,"^"),0)) PSOACT="L",PSONACT=1,VALMSG="No Pharmacy Orderable Item !" 45 ;K PSOLKFL D PSOL^PSSLOCK(RXN) I '$G(PSOMSG) K PSOMSG S PSOLKFL=1 S PSOACT="",VALMSG="This Order is being edited by another user." 46 K PSOMSG S IEN=0,$P(RN," ",12)=" " 47 I $G(RPH),ST=1,$P($G(^PSRX(RXN,"PKI")),"^") N PKI,PKI1,PKIR,PKIE,DA S DA=RXN D CER^PSOPKIV1 K DA D:$G(PKI1) L1^PSOPKIV1 48 D DIN^PSONFI(+RXOR,$P(RX0,"^",6)) 49 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=$S($P($G(^PSRX(RXN,"TPB")),"^"):" TPB Rx #: ",1:" Rx #: ") 50 S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_$P(RX0,"^")_$S($G(^PSRX(RXN,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXN)_$E(RN,$L($P(RX0,"^")_$S($G(^PSRX(RXN,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXN))+1,12) 51 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" ("_$S($P(PSOPAR,"^",3):1,1:"#")_")"_" *Orderable Item: "_$S($D(^PS(50.7,$P(+RXOR,"^"),0)):$P(^PS(50.7,$P(+RXOR,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:"")_NFIO 52 S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOAO",$J,IEN,0))-4) 53 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" ("_$S($P(PSOPAR,"^",3):2,1:"#")_")"_$S($D(^PSDRUG("AQ",$P(RX0,"^",6))):" CMOP ",1:" ")_"Drug: "_$P(^PSDRUG($P(RX0,"^",6),0),"^")_NFID 54 S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOAO",$J,IEN,0))-4) 55 I $$STATUS^PSOBPSUT(RXN,0)'="",$$RXRLDT^PSOBPSUT(RXN,0) D 56 . S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" "_$S('$P(PSOPAR,"^",3):"(2)",1:" ")_" NDC: "_$$GETNDC^PSONDCUT(RXN,0) 57 S:$G(^PSRX(RXN,"TN"))]"" IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Trade Name: "_$G(^PSRX(RXN,"TN")) 58 D DOSE^PSOORNE5 59 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" (4)Pat Instructions:" D INS^PSOORNE5 60 D PC^PSOORNE5 61 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" SIG:" 62 I '$P($G(^PSRX(RXN,"SIG")),"^",2) S SIGOK=0 D G PTST 63 .S X=$P($G(^PSRX(RXN,"SIG")),"^") D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250) 64 .F SG=1:1:$L(SIG) S:$L(^TMP("PSOAO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAO",$J,IEN,0)," ",21)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOAO",$J,IEN,0)=$G(^TMP("PSOAO",$J,IEN,0))_" "_$P(SIG," ",SG) 65 S SIGOK=1 66 F I=0:0 S I=$O(^PSRX(RXN,"SIG1",I)) Q:'I D ;PSO*210 67 . S MIG=$P(^PSRX(RXN,"SIG1",I,0),"^") 68 . D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAO",$J)),21) 69 S SIGOK=1 K MIG,SG 70 PTST S $P(RN," ",25)=" ",PTST=$S($G(^PS(53,+$P(RX0,"^",3),0))]"":$P($G(^PS(53,+$P(RX0,"^",3),0)),"^"),1:""),IEN=IEN+1 71 S ^TMP("PSOAO",$J,IEN,0)=" (5) Patient Status: "_PTST_$E(RN,$L(PTST)+1,25) 72 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" (6) Issue Date: "_$E($P(RX0,"^",13),4,5)_"/"_$E($P(RX0,"^",13),6,7)_"/"_$E($P(RX0,"^",13),2,3) 73 S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" (7) Fill Date: "_$E($P(RX2,"^",2),4,5)_"/"_$E($P(RX2,"^",2),6,7)_"/"_$E($P(RX2,"^",2),2,3) 74 S ROU=$S($P(RX0,"^",11)="W":"Window",1:"Mail") 75 S REFL=$P(RX0,"^",9),I=0 F S I=$O(^PSRX(RXN,1,I)) Q:'I S REFL=REFL-1,ROU=$S($P(^PSRX(RXN,1,I,0),"^",2)="W":"Window",1:"Mail") 76 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Last Fill Date: "_$E($P(RX3,"^"),4,5)_"/"_$E($P(RX3,"^"),6,7)_"/"_$E($P(RX3,"^"),2,3) 77 D CMOP^PSOORNE3 78 S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" ("_ROU_$S($G(PSOCMOP)]"":", "_PSOCMOP,1:"")_")" K ROU,PSOCMOP 79 S IEN=IEN+1 I $P(RX2,"^",15) S ^TMP("PSOAO",$J,IEN,0)=" Returned to Stock: "_$E($P(RX2,"^",15),4,5)_"/"_$E($P(RX2,"^",15),6,7)_"/"_$E($P(RX2,"^",15),2,3)_$S($P(RX2,"^",14):" (Reprinted)",1:"") 80 E S ^TMP("PSOAO",$J,IEN,0)=" Last Release Date: " D 81 .S RLD=$S($P(RX2,"^",13):$E($P(RX2,"^",13),4,5)_"/"_$E($P(RX2,"^",13),6,7)_"/"_$E($P(RX2,"^",13),2,3),1:"") 82 .I $O(^PSRX(RXN,1,0)) F I=0:0 S I=$O(^PSRX(RXN,1,I)) Q:'I D 83 ..I $P(^PSRX(RXN,1,I,0),"^",18) S RLD=$E($P(^(0),"^",18),4,5)_"/"_$E($P(^(0),"^",18),6,7)_"/"_$E($P(^(0),"^",18),2,3) 84 .S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_$S($G(RLD)]"":RLD,1:" ") 85 S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" (8) Lot #: "_$P($G(RX2),"^",4) 86 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Expires: "_$E($P(RX2,"^",6),4,5)_"/"_$E($P(RX2,"^",6),6,7)_"/"_$E($P(RX2,"^",6),2,3) 87 S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" MFG: "_$P($G(RX2),"^",8) 88 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(9) Days Supply: "_$P(RX0,"^",8)_$S($L($P(RX0,"^",8))=1:" ",1:"") 89 S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" (10) QTY"_$S($P($G(^PSDRUG($P(RX0,"^",6),660)),"^",8)]"":" ("_$P($G(^PSDRUG($P(RX0,"^",6),660)),"^",8)_")",1:" ( )")_": "_$P(RX0,"^",7) 90 I $P($G(^PSDRUG($P(RX0,"^",6),5)),"^")]"" D 91 .S $P(RN," ",79)=" ",IEN=IEN+1 92 .S ^TMP("PSOAO",$J,IEN,0)=$E(RN,$L("QTY DSP MSG: "_$P(^PSDRUG($P(RX0,"^",6),5),"^"))+1,79)_"QTY DSP MSG: "_$P(^PSDRUG($P(RX0,"^",6),5),"^") K RN 93 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(11) # of Refills: "_$P(RX0,"^",9)_$S($L($P(RX0,"^",9))=1:" ",1:"")_" Remaining: "_REFL 94 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(12) Provider: "_$S($D(^VA(200,$P(RX0,"^",4),0)):$P(^VA(200,$P(RX0,"^",4),0),"^"),1:"UNKNOWN") 95 I $P(RX3,"^",3) S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,$S($G(PSORX("COSIGNING PROVIDER")):PSORX("COSIGNING PROVIDER"),1:$P(RX3,"^",3)),0),"^") 96 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(13) Routing: "_$S($P(RX0,"^",11)="M":"MAIL",1:"WINDOW")_" (14) Copies: "_$S($P(RX0,"^",18):$P(RX0,"^",18),1:1) 97 S:$P(RX0,"^",11)="W"&($P(PSOPAR,"^",12)) IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Method of Pickup: "_$G(^PSRX(RXN,"MP")) 98 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(15) Clinic: "_$S($D(^SC(+$P(RX0,"^",5),0)):$P(^SC($P(RX0,"^",5),0),"^"),1:"Not on File") 99 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(16) Division: "_$S($G(^PS(59,+$P(RX2,"^",9),0))]"":$P(^PS(59,$P(RX2,"^",9),0),"^")_" ("_$P(^(0),"^",6)_")",1:"UNKNOWN") 100 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(17) Pharmacist: "_$S($P(RX2,"^",3):$P(^VA(200,$P(RX2,"^",3),0),"^"),1:"") 101 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(18) Remarks:" D RMK^PSOORNE3 102 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(19) Counseling: "_$S($P($G(^PSRX(RXN,"PC")),"^"):"YES",1:"NO")_" "_$S($P($G(^PSRX(RXN,"PC")),"^"):"Was Counseling Understood: "_$S($P($G(^PSRX(RXN,"PC")),"^",2):"YES",1:"NO"),1:"") 103 S:$O(^PSRX(RXN,1,0)) REF=1,IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(20) Refill Data" 104 I $$STATUS^PSOBPSUT(RXN,0)'="" D 105 . N DAW S IEN=IEN+1,DAW=$$GETDAW^PSODAWUT(RXN,0) 106 . S ^TMP("PSOAO",$J,IEN,0)="(21) DAW Code: "_DAW_" - "_$$DAWEXT^PSSDAWUT(DAW) 107 D DISP^PSOORNE6 108 I $G(PSOBEDT),PSOACT["E" S PSOACT="E" 109 I $G(PSOBEDT),PSOACT'["E" S PSOACT="" 110 Q:$G(PSORXED)!($G(COPY))!($G(UPMI)) S:$G(PSOBEDT) (PSOEDIT,PSORXED)=1 D ^PSOLMLST ; I '$G(PSOLKFL) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) 111 K DRET,SIG 112 Q 113 UL1 ; 114 ;I +PSOLST(ORN)=52 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) Q 115 ;I $D(^PS(52.41,$P(PSOLST(ORN),"^",2),0)) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)_"S") 116 Q
Note:
See TracChangeset
for help on using the changeset viewer.
