- 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/PSOCAN4.m
r613 r623 1 PSOCAN4 ;BIR/SAB-rx speed dc listman ;10/23/06 11:50am 2 ;;7.0;OUTPATIENT PHARMACY;**20,24,27,63,88,117,131,259,268,225**;DEC 1997;Build 29 3 ;External reference to File #200 supported by DBIA 224 4 ;External reference NA^ORX1 supported by DBIA 2186 5 ;External references to L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789 6 ;External reference to PSDRUG supported by DBIA 221 7 ;External reference to PS(50.7 supported by DBIA 2223 8 ;External reference to PS(50.606 supported by DBIA 2174 9 SEL I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Unauthorized Action Selection.",VALMBCK="" Q 10 N VALMCNT I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q 11 S DFNHLD=PSODFN 12 S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q 13 K PSOPLCK S RXCNT=0 K PSOFDR,DIR,DUOUT,DIRUT S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR S LST=Y I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" D ULP Q 14 K DIR,DIRUT,DTOUT,PSOOELSE,DTOUT I +LST S (SPEED,PSOOELSE)=1 D D KCAN^PSOCAN3 15 .S PSOCANRA=1 D RQTEST 16 .D FULL^VALM1,COM^PSOCAN1 I '$D(INCOM)!($D(DIRUT)) K SPEED S VALMBCK="R" Q 17 .D FULL^VALM1 F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']"" S ORN=$P(LST,",",ORD) D @$S(+PSOLST(ORN)=52:"RX",1:"PEN") 18 .S VALMBCK="R" 19 I '$G(PSOOELSE) S VALMBCK="" 20 D ^PSOBUILD,BLD^PSOORUT1,RV^PSOORFL K PSOMSG,RXCNT,DIR,DIRUT,DTOUT,DUOUT,LST,ORD,IEN,ORN,RPH,ST,REFL,REF,PSOACT,ORSV,PSORNW,PSORENW,PSONO,PSOCO,PSOCU,PSODIR,DSMSG,SAVORD,SAVORN,SPEED,DIRUT,PSONOOR 21 D INVALD^PSOCAN1 K PSINV,PSOOELSE,INCOM,COM S PSODFN=DFNHLD K DFNHLD D ULP 22 Q 23 ULP D UL^PSSLOCK(+$G(PSODFN)) Q 24 ; 25 RX Q:'$D(^XUSEC("PSORPH",DUZ)) 26 D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D D PAUSE^VALM1 K PSOMSG Q 27 .I $P($G(PSOMSG),"^",2)'="" W $C(7),!!,$P($G(PSOMSG),"^",2),!,"Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),! Q 28 .W $C(7),!!,"Another person is editing Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),! 29 S RXSP=1 K PSCAN S (EN,X)=$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^") S Y=$P(PSOLST(ORN),"^",2)_"^"_X,Y(0,0)=X,Y(0)=$G(^PSRX($P(PSOLST(ORN),"^",2),0)) D 30 .I $P(^PSRX(+Y,"STA"),"^")=1!($P(^("STA"),"^")=4) D Q 31 ..I $P($G(^PSRX(+Y,"PKI")),"^") N PKI,PKI1,PKIR,PKIE,DA S DA=+Y D CER^PSOPKIV1 32 ..S:$G(PSONOOR)'="" PSONOORA=$G(PSONOOR) D DEL S:$G(PSONOORA)'="" PSONOOR=$G(PSONOORA) K PSONOORA Q 33 .S YY=Y,YY(0,0)=Y(0,0),(PSODFN,DFN)=$P(Y(0),"^",2) D:$G(DFN) CHK^PSOCAN I DEAD!($P(^PSRX(+YY,"STA"),"^")>11),$P(^("STA"),"^")<16 S PSINV(EN)="" Q 34 .S DA=+YY I $P($G(^PSRX(DA,"STA")),"^")=11!($P($G(^(2)),"^",6)<DT) D EXP^PSOCAN 35 .S RX=YY(0,0) D:$D(^PSRX(DA,0)) SPEED1^PSOCAN1 36 K YY I '$D(PSCAN) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) Q 37 S RX="",RXCNT=0 F S RX=$O(PSCAN(RX)) Q:RX="" S DA=+PSCAN(RX),REA=$P(PSCAN(RX),"^",2),RXCNT=RXCNT+1 D SHOW^PSOCAN1 38 S RX="" F S RX=$O(PSCAN(RX)) Q:RX="" D ACT 39 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) 40 Q 41 ACT S DA=+PSCAN(RX),REA=$P(PSCAN(RX),"^",2),II=RX,PSODFN=$P(^PSRX(DA,0),"^",2) I REA="R" D REINS^PSOCAN2 Q 42 D CAN1^PSOCAN3 Q 43 PEN ;discontinue pending orders 44 S SAVORD=ORD,SAVORN=ORN 45 S ORD=$P(PSOLST(ORN),"^",2) D PSOL^PSSLOCK(+ORD_"S") I '$G(PSOMSG) D D MEDDIS K PSOMSG G OK 46 .I $P($G(PSOMSG),"^",2)'="" W $C(7),!!,$P($G(PSOMSG),"^",2)_" (Pending order)",! Q 47 .W $C(7),!!,"Another person is editing this Pending order.",! 48 I $P(^PS(52.41,ORD,0),"^",3)="RF" S DA=ORD,DIK="^PS(52.41," D ^DIK K DA,DIK D PSOUL^PSSLOCK(ORD_"S") Q 49 K ^PS(52.41,"AOR",$P(^PS(52.41,ORD,0),"^",2),+$P($G(^PS(52.41,ORD,"INI")),"^"),ORD) S $P(^PS(52.41,ORD,0),"^",3)="DC" 50 D EN^PSOHLSN(+^PS(52.41,ORD,0),"OC",INCOM,PSONOOR) 51 D PSOUL^PSSLOCK(ORD_"S") 52 OK S ORD=SAVORD,ORN=SAVORN Q 53 NOOR ;ask nature of order 54 D FULL^VALM1 55 K DIR,DTOUT,DTOUT,DIRUT I $T(NA^ORX1)]"" D Q:$D(DIRUT) G NOORXP 56 .S PSONOOR=$$NA^ORX1("S",0,"B","Nature of Order",0,"WPSDIVR"_$S(+$G(^VA(200,DUZ,"PS")):"E",1:"")) 57 .I +PSONOOR S PSONOOR=$P(PSONOOR,"^",3) Q 58 .S DIRUT=1 K PSONOOR 59 S DIR("A")="Nature of Order: ",DIR("B")=$S($G(DODR):"SERVICE CORRECTED",1:"WRITTEN") 60 S DIR(0)="SA^W:WRITTEN;V:VERBAL;P:TELEPHONE;S:SERVICE CORRECTED;D:DUPLICATE;I:POLICY;R:SERVICE REJECTED"_$S(+$G(^VA(200,DUZ,"PS")):";E:PROVIDER ENTERED",1:"") 61 D ^DIR K DIR,DTOUT,DTOUT Q:$D(DIRUT) S PSONOOR=Y 62 NOORXP I $G(PSOCANRA),'$G(PSOCANRZ) D REQ 63 NOORX S:$D(DIRUT)&($G(SPEED)) VALMBCK="Q" 64 Q 65 DEL ;deletes non-verified Rxs 66 D FULL^VALM1 67 W ! K DIR,DIRUT,DUOUT S DIR(0)="Y",DIR("B")="No",DIR("A",1)="Rx # "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^")_" is in a Non-Verified Status.",DIR("A")="Are sure you want to mark the Rx as deleted" D ^DIR I 'Y!($D(DIRUT)) S VALMBCK="R" G EX 68 I '$G(SPEED) D I $D(DIRUT) G EX 69 .D NOOR^PSOCAN4 I $D(DIRUT) S VALMSG="No Action Taken!",VALMBCK="R" Q 70 .K DIR S DIR("A")="Comments",DIR("B")="Per Pharmacy Request",DIR(0)="F^5:100" D ^DIR K DIR I $D(DIRUT) S VALMSG="No Action Taken!" Q 71 K PSDEL,PSORX("INTERVENE") S PSOZVER=1,DA=$P(PSOLST(ORN),"^",2) 72 I $G(PKI1) N INCOM S INCOM=Y D DCV^PSOPKIV1 Q 73 D ENQ^PSORXDL 74 EX Q 75 REQ ;prompt for requesting provider 76 I '$G(PSOCANRD),$G(PSOCANRP),$G(ORD),$D(^PS(52.41,ORD,0)) S PSOCANRD=+$P($G(^PS(52.41,ORD,0)),"^",5) 77 I $G(PSOCANRD) D 78 .I $D(^VA(200,PSOCANRD,"PS")),$P($G(^("PS")),"^"),$S('$P(^("PS"),"^",4):1,1:$P(^("PS"),"^",4)'<DT) Q 79 .K PSOCANRD 80 W ! K DIC S DIC=200,DIC(0)="AEQMZ",DIC("A")="Requesting PROVIDER: ",DIC("S")="I $D(^(""PS"")),$P(^(""PS""),""^""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)'<DT)" I $G(PSOCANRD) S DIC("B")=PSOCANRD 81 D ^DIC K DIC S:$G(Y)<0!($D(DTOUT))!($D(DUOUT)) DIRUT=1 I $G(Y) S PSOCANRC=+$G(Y),PSOCANRN=$P($G(Y),"^",2),PSOCANRZ=1 82 Q 83 RQTEST ; 84 N PMIN,PMINZ,PMINFLAG 85 S PMINFLAG=0 F PMIN=1:1:$L(LST,",") Q:$P(LST,",",PMIN)']"" S PMINZ=$P(LST,",",PMIN) D 86 .I $P($G(PSOLST(PMINZ)),"^")=52 I $P($G(^PSRX(+$P($G(PSOLST(PMINZ)),"^",2),"STA")),"^")'=12,'$G(PMINFLAG) S PSOCANRD=+$P($G(^PSRX(+$P($G(PSOLST(PMINZ)),"^",2),0)),"^",4) S PMINFLAG=1 87 .I $P($G(PSOLST(PMINZ)),"^")=52.41,'$G(PMINFLAG) S PSOCANRD=$P($G(^PS(52.41,+$P($G(PSOLST(PMINZ)),"^",2),0)),"^",5) S PMINFLAG=1 88 I '$G(PMINFLAG) S PSOCANRZ=1 89 Q 90 MEDDIS ; 91 N PSOFMMD 92 Q:'$G(ORD) 93 Q:'$D(^PS(52.41,ORD,0)) 94 I $P(^PS(52.41,ORD,0),"^",9) W "Drug: "_$P($G(^PSDRUG(+$P(^PS(52.41,ORD,0),"^",9),0)),"^") D PAUSE^VALM1 Q 95 I $P(^PS(52.41,ORD,0),"^",8) S PSOFMMD=$P(^(0),"^",8) W "Orderable Item: "_$P($G(^PS(50.7,PSOFMMD,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^PS(50.7,PSOFMMD,0)),"^",2),0)),"^") D PAUSE^VALM1 96 Q 97 ; 98 REF ;CONT. FROM REF^PSOCAN2; PSO*7*259 99 N PSOSIEN S PSOSIEN=0 100 F S PSOSIEN=$O(^PS(52.5,"B",DA,PSOSIEN)) Q:'PSOSIEN D Q:PSONODEL 101 .I $P($G(^PS(52.5,PSOSIEN,0)),"^",13)'=IFN Q ;NOT SAME REFILL 102 .I '$P($G(^PS(52.5,PSOSIEN,"P")),"^") Q ;SUSPENSE LABEL PRINT 103 .S PSONODEL=1 ;REFILL NODE SHOULD NOT BE DELETED 104 Q 1 PSOCAN4 ;BIR/SAB-rx speed dc listman ; 11/3/06 9:50pm 2 ;;7.0;OUTPATIENT PHARMACY;**20,24,27,63,88,117,131,259,268,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 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU General Public License 17 ; along with this program; if not, write to the Free Software 18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 19 ;External reference to File #200 supported by DBIA 224 20 ;External reference NA^ORX1 supported by DBIA 2186 21 ;External references to L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789 22 ;External reference to PSDRUG supported by DBIA 221 23 ;External reference to PS(50.7 supported by DBIA 2223 24 ;External reference to PS(50.606 supported by DBIA 2174 25 SEL I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Unauthorized Action Selection.",VALMBCK="" Q 26 N VALMCNT I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q 27 S DFNHLD=PSODFN 28 S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q 29 K PSOPLCK S RXCNT=0 K PSOFDR,DIR,DUOUT,DIRUT S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR S LST=Y I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" D ULP Q 30 K DIR,DIRUT,DTOUT,PSOOELSE,DTOUT I +LST S (SPEED,PSOOELSE)=1 D D KCAN^PSOCAN3 31 .S PSOCANRA=1 D RQTEST 32 .D FULL^VALM1,COM^PSOCAN1 I '$D(INCOM)!($D(DIRUT)) K SPEED S VALMBCK="R" Q 33 .D FULL^VALM1 F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']"" S ORN=$P(LST,",",ORD) D @$S(+PSOLST(ORN)=52:"RX",1:"PEN") 34 .S VALMBCK="R" 35 I '$G(PSOOELSE) S VALMBCK="" 36 D ^PSOBUILD,BLD^PSOORUT1 K PSOMSG,RXCNT,DIR,DIRUT,DTOUT,DUOUT,LST,ORD,IEN,ORN,RPH,ST,REFL,REF,PSOACT,ORSV,PSORNW,PSORENW,PSONO,PSOCO,PSOCU,PSODIR,DSMSG,SAVORD,SAVORN,SPEED,DIRUT,PSONOOR 37 D INVALD^PSOCAN1 K PSINV,PSOOELSE,INCOM,COM S PSODFN=DFNHLD K DFNHLD D ULP 38 Q 39 ULP D UL^PSSLOCK(+$G(PSODFN)) Q 40 ; 41 RX Q:'$D(^XUSEC("PSORPH",DUZ)) 42 D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D D PAUSE^VALM1 K PSOMSG Q 43 .I $P($G(PSOMSG),"^",2)'="" W $C(7),!!,$P($G(PSOMSG),"^",2),!,"Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),! Q 44 .W $C(7),!!,"Another person is editing Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),! 45 S RXSP=1 K PSCAN S (EN,X)=$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^") S Y=$P(PSOLST(ORN),"^",2)_"^"_X,Y(0,0)=X,Y(0)=$G(^PSRX($P(PSOLST(ORN),"^",2),0)) D 46 .I $P(^PSRX(+Y,"STA"),"^")=1!($P(^("STA"),"^")=4) D Q 47 ..I $P($G(^PSRX(+Y,"PKI")),"^") N PKI,PKI1,PKIR,PKIE,DA S DA=+Y D CER^PSOPKIV1 48 ..S:$G(PSONOOR)'="" PSONOORA=$G(PSONOOR) D DEL S:$G(PSONOORA)'="" PSONOOR=$G(PSONOORA) K PSONOORA Q 49 .S YY=Y,YY(0,0)=Y(0,0),(PSODFN,DFN)=$P(Y(0),"^",2) D:$G(DFN) CHK^PSOCAN I DEAD!($P(^PSRX(+YY,"STA"),"^")>11),$P(^("STA"),"^")<16 S PSINV(EN)="" Q 50 .S DA=+YY I $P($G(^PSRX(DA,"STA")),"^")=11!($P($G(^(2)),"^",6)<DT) D EXP^PSOCAN 51 .S RX=YY(0,0) D:$D(^PSRX(DA,0)) SPEED1^PSOCAN1 52 K YY I '$D(PSCAN) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) Q 53 S RX="",RXCNT=0 F S RX=$O(PSCAN(RX)) Q:RX="" S DA=+PSCAN(RX),REA=$P(PSCAN(RX),"^",2),RXCNT=RXCNT+1 D SHOW^PSOCAN1 54 S RX="" F S RX=$O(PSCAN(RX)) Q:RX="" D ACT 55 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) 56 Q 57 ACT S DA=+PSCAN(RX),REA=$P(PSCAN(RX),"^",2),II=RX,PSODFN=$P(^PSRX(DA,0),"^",2) I REA="R" D REINS^PSOCAN2 Q 58 D CAN1^PSOCAN3 Q 59 PEN ;discontinue pending orders 60 S SAVORD=ORD,SAVORN=ORN 61 S ORD=$P(PSOLST(ORN),"^",2) D PSOL^PSSLOCK(+ORD_"S") I '$G(PSOMSG) D D MEDDIS K PSOMSG G OK 62 .I $P($G(PSOMSG),"^",2)'="" W $C(7),!!,$P($G(PSOMSG),"^",2)_" (Pending order)",! Q 63 .W $C(7),!!,"Another person is editing this Pending order.",! 64 I $P(^PS(52.41,ORD,0),"^",3)="RF" S DA=ORD,DIK="^PS(52.41," D ^DIK K DA,DIK D PSOUL^PSSLOCK(ORD_"S") Q 65 K ^PS(52.41,"AOR",$P(^PS(52.41,ORD,0),"^",2),+$P($G(^PS(52.41,ORD,"INI")),"^"),ORD) S $P(^PS(52.41,ORD,0),"^",3)="DC" 66 D EN^PSOHLSN(+^PS(52.41,ORD,0),"OC",INCOM,PSONOOR) 67 D PSOUL^PSSLOCK(ORD_"S") 68 OK S ORD=SAVORD,ORN=SAVORN Q 69 NOOR ;ask nature of order 70 ;vfah set nature of order automatically for autofinish,rx 71 I $G(PSOAFYN)'="Y" D FULL^VALM1 ;vfah 72 I $G(PSOAFYN)'="Y" K DIR,DTOUT,DTOUT,DIRUT I $T(NA^ORX1)]"" D Q:$D(DIRUT) G NOORXP ;vfah 73 .I $G(PSOAFYN)'="Y" S PSONOOR=$$NA^ORX1("S",0,"B","Nature of Order",0,"WPSDIVX"_$S(+$G(^VA(200,DUZ,"PS")):"E",1:"")) ;vfah 74 .I $G(PSOAFYN)'="Y" I +PSONOOR S PSONOOR=$P(PSONOOR,"^",3) Q ;vfah 75 .I $G(PSOAFYN)'="Y" S DIRUT=1 K PSONOOR ;vfah 76 I $G(PSOAFYN)'="Y" S DIR("A")="Nature of Order: ",DIR("B")=$S($G(DODR):"SERVICE CORRECTED",1:"WRITTEN") ;vfah 77 I $G(PSOAFYN)'="Y" S DIR(0)="SA^W:WRITTEN;V:VERBAL;P:TELEPHONE;S:SERVICE CORRECTED;D:DUPLICATE;I:POLICY;X:REJECTED"_$S(+$G(^VA(200,DUZ,"PS")):";E:PROVIDER ENTERED",1:"") 78 I $G(PSOAFYN)'="Y" D ^DIR K DIR,DTOUT,DTOUT Q:$D(DIRUT) S PSONOOR=Y ;vfah 79 I $G(PSOAFYN)="Y" S PSONOOR="S" ;vfah sets nature of order to service correction for autofinish,rx 80 ;vfah end of set nature of order 81 NOORXP I $G(PSOCANRA),'$G(PSOCANRZ) D REQ 82 NOORX S:$D(DIRUT)&($G(SPEED)) VALMBCK="Q" 83 Q 84 DEL ;deletes non-verified Rxs 85 D FULL^VALM1 86 W ! K DIR,DIRUT,DUOUT S DIR(0)="Y",DIR("B")="No",DIR("A",1)="Rx # "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^")_" is in a Non-Verified Status.",DIR("A")="Are sure you want to mark the Rx as deleted" D ^DIR I 'Y!($D(DIRUT)) S VALMBCK="R" G EX 87 I '$G(SPEED) D I $D(DIRUT) G EX 88 .D NOOR^PSOCAN4 I $D(DIRUT) S VALMSG="No Action Taken!",VALMBCK="R" Q 89 .K DIR S DIR("A")="Comments",DIR("B")="Per Pharmacy Request",DIR(0)="F^5:100" D ^DIR K DIR I $D(DIRUT) S VALMSG="No Action Taken!" Q 90 K PSDEL,PSORX("INTERVENE") S PSOZVER=1,DA=$P(PSOLST(ORN),"^",2) 91 I $G(PKI1) N INCOM S INCOM=Y D DCV^PSOPKIV1 Q 92 D ENQ^PSORXDL 93 EX Q 94 REQ ;prompt for requesting provider 95 I '$G(PSOCANRD),$G(PSOCANRP),$G(ORD),$D(^PS(52.41,ORD,0)) S PSOCANRD=+$P($G(^PS(52.41,ORD,0)),"^",5) 96 I $G(PSOCANRD) D 97 .I $D(^VA(200,PSOCANRD,"PS")),$P($G(^("PS")),"^"),$S('$P(^("PS"),"^",4):1,1:$P(^("PS"),"^",4)'<DT) Q 98 .K PSOCANRD 99 W ! K DIC S DIC=200,DIC(0)="AEQMZ",DIC("A")="Requesting PROVIDER: ",DIC("S")="I $D(^(""PS"")),$P(^(""PS""),""^""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)'<DT)" I $G(PSOCANRD) S DIC("B")=PSOCANRD 100 D ^DIC K DIC S:$G(Y)<0!($D(DTOUT))!($D(DUOUT)) DIRUT=1 I $G(Y) S PSOCANRC=+$G(Y),PSOCANRN=$P($G(Y),"^",2),PSOCANRZ=1 101 Q 102 RQTEST ; 103 N PMIN,PMINZ,PMINFLAG 104 S PMINFLAG=0 F PMIN=1:1:$L(LST,",") Q:$P(LST,",",PMIN)']"" S PMINZ=$P(LST,",",PMIN) D 105 .I $P($G(PSOLST(PMINZ)),"^")=52 I $P($G(^PSRX(+$P($G(PSOLST(PMINZ)),"^",2),"STA")),"^")'=12,'$G(PMINFLAG) S PSOCANRD=+$P($G(^PSRX(+$P($G(PSOLST(PMINZ)),"^",2),0)),"^",4) S PMINFLAG=1 106 .I $P($G(PSOLST(PMINZ)),"^")=52.41,'$G(PMINFLAG) S PSOCANRD=$P($G(^PS(52.41,+$P($G(PSOLST(PMINZ)),"^",2),0)),"^",5) S PMINFLAG=1 107 I '$G(PMINFLAG) S PSOCANRZ=1 108 Q 109 MEDDIS ; 110 N PSOFMMD 111 Q:'$G(ORD) 112 Q:'$D(^PS(52.41,ORD,0)) 113 I $P(^PS(52.41,ORD,0),"^",9) W "Drug: "_$P($G(^PSDRUG(+$P(^PS(52.41,ORD,0),"^",9),0)),"^") D PAUSE^VALM1 Q 114 I $P(^PS(52.41,ORD,0),"^",8) S PSOFMMD=$P(^(0),"^",8) W "Orderable Item: "_$P($G(^PS(50.7,PSOFMMD,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^PS(50.7,PSOFMMD,0)),"^",2),0)),"^") D PAUSE^VALM1 115 Q 116 ; 117 REF ;CONT. FROM REF^PSOCAN2; PSO*7*259 118 N PSOSIEN S PSOSIEN=0 119 F S PSOSIEN=$O(^PS(52.5,"B",DA,PSOSIEN)) Q:'PSOSIEN D Q:PSONODEL 120 .I $P($G(^PS(52.5,PSOSIEN,0)),"^",13)'=IFN Q ;NOT SAME REFILL 121 .I '$P($G(^PS(52.5,PSOSIEN,"P")),"^") Q ;SUSPENSE LABEL PRINT 122 .S PSONODEL=1 ;REFILL NODE SHOULD NOT BE DELETED 123 Q
Note:
See TracChangeset
for help on using the changeset viewer.