- 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/PSORXED.m
r613 r623 1 PSORXED ;IHS/DSD/JCM-edit rx utility ; 5/18/07 2:53pm2 ;;7.0;OUTPATIENT PHARMACY;**2,16,21,26,56,71,125,201,246**;DEC 1997;Build 12 3 4 5 6 7 START 8 9 END 10 11 INIT 12 LKUP 13 14 15 PARSE 16 17 PROCESS 18 19 20 21 22 23 24 L1 25 PROCESSX 26 CHECK Q L +^PSRX(PSORXED("IRXN")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)I '$T W $C(7),!!,"Rx Number is Locked by Another User!",! S PSORXED("DFLG")=1 H 5 Q27 28 29 30 31 32 33 CHECKX 34 LOG 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 E I $G(PSORX("PSOL",PSOX2+1))'[PSORXED("IRXN")_"," S PSORX("PSOL",PSOX2+1)=PSORXED("IRXN")_"," D SETRP ;;PSO*7*246 57 LOGX 58 59 POST 60 61 62 COPAY 63 64 RXST 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 COPAYX 82 83 CPCK 84 85 86 87 88 89 90 CPCK1 91 92 NEXT 93 94 95 EOJ 96 97 98 FILL 99 100 101 102 103 104 FILLX 105 106 LBL 107 108 109 110 111 112 113 114 115 116 117 ASKL 118 119 120 121 122 123 SETRP 124 1 PSORXED ;IHS/DSD/JCM-edit rx utility ;02/18/98 3:14 PM 2 ;;7.0;OUTPATIENT PHARMACY;**2,16,21,26,56,71,125,201**;DEC 1997 3 ;External reference to ^PSXEDIT supported by DBIA 2209 4 ;External reference to ^DD(52 supported by DBIA 999 5 ;External reference to ^PSDRUG supported by DBIA 221 6 ;External reference to ^PS(55 supported by DBIA 2228 7 START ;this entry point is no longer used. 8 ;D INIT,LKUP G:PSORXED("QFLG") END D PARSE,EOJ G START 9 END D EOJ 10 Q 11 INIT S PSORXED("QFLG")=0 Q 12 LKUP ; this line of code is no longer used S PSONUM="RX",PSONUM("A")="EDIT",PSOQFLG=0 D EN1^PSONUM I PSOQFLG!($Q(PSOLIST)']"") S PSORXED("QFLG")=1 13 K PSOQFLG Q 14 ; 15 PARSE F PSORXED("LIST")=1:1 Q:'$D(PSOLIST(PSORXED("LIST")))!PSORXED("QFLG") F PSORXED("I")=1:1:$L(PSOLIST(PSORXED("LIST"))) S PSORXED("IRXN")=$P(PSOLIST(PSORXED("LIST")),",",PSORXED("I")) D:+PSORXED("IRXN") PROCESS 16 Q 17 PROCESS S PSORXED("DFLG")=0 G:$G(^PSRX(PSORXED("IRXN"),0))']"" PROCESSX 18 S PSORXED("RX0")=^PSRX(PSORXED("IRXN"),0),PSORXED("RX2")=^(2),PSORXED("RX3")=^(3),PSOSIG=$G(^PSRX(PSORXED("IRXN"),"SIG")),PSODAYS=$P(PSORXED("RX0"),"^",8) 19 S (I,RFED,RFDT)=0 F S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I S RFED=I,PSORXED("RX1")=^PSRX(PSORXED("IRXN"),1,I,0),RFDT=$P(^(0),"^"),PSODAYS=$P(^(0),"^",10) S:$P(^(0),"^",17) PSONEW("PROVIDER NAME")=$P(^VA(200,$P(^(0),"^",17),0),"^") 20 S PSORXST=+$P($G(^PS(53,+$P(PSORXED("RX0"),"^",3),0)),"^",7) N DA S DA=PSORXED("IRXN") D EN^PSORXPR 21 D CHECK G:PSORXED("DFLG") PROCESSX 22 N X S X="PSXEDIT" X ^%ZOSF("TEST") K X I $T D ^PSXEDIT I $G(PSXOUT) K PSXOUT G L1 23 D DIE^PSORXED1 24 L1 D LOG,POST 25 PROCESSX Q 26 CHECK Q L +^PSRX(PSORXED("IRXN")):0 I '$T W $C(7),!!,"Rx Number is Locked by Another User!",! S PSORXED("DFLG")=1 H 5 Q 27 I $G(^PSDRUG($P(PSORXED("RX0"),"^",6),"I"))]"",^("I")<DT D G CHECKX 28 . W !,$C(7),"This drug has been inactivated. ",! S PSORXED("DFLG")=1 Q 29 K PSPOP I $G(PSODIV),$P(PSORXED("RX2"),"^",9)'=PSOSITE S PSPRXN=PSORXED("IRXN") D CHK1^PSOUTLA I $G(PSPOP)=1 S PSORXED("DFLG")=1 G CHECKX 30 ; 31 I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=14!($P(^("STA"),"^")=15) S PSORXED("DFLG")=1 W !!,$C(7),"Discontinued prescriptions cannot be edited.",! G CHECKX 32 I $D(^PS(52.4,"B",PSORXED("IRXN"))) S PSORXED("DFLG")=1 W !!,$C(7),"Non-verified prescriptions cannot be edited.",! 33 CHECKX K PSPOP,DIR,DTOUT,DUOUT,Y,X Q 34 LOG K PSFROM S DA=PSORXED("IRXN"),(PSRX0,RX0)=PSORXED("RX0"),QTY=$P(RX0,"^",7),QTY=QTY-$P(^PSRX(DA,0),"^",7) K ZD(DA) S:'$O(^PSRX(DA,1,0)) ZD(DA)=$P(^PSRX(DA,2),"^",2) 35 S COM="" F I=3,4,5:1:13,17 I $P(PSRX0,"^",I)'=$P(^PSRX(DA,0),"^",I) S PSI=$S(I=13:1,1:I),COM=COM_$P(^DD(52,PSI,0),"^")_" ("_$P(PSRX0,"^",I)_")," 36 I $P(PSORXED("RX2"),"^",2)'=$P(^PSRX(DA,2),"^",2) S COM=COM_$P(^DD(52,22,0),"^")_" ("_$P(PSORXED("RX2"),"^",2)_")," 37 I $P(PSORXED("RX3"),"^",7)'=$P(^PSRX(DA,3),"^",7) S COM=COM_$P(^DD(52,12,0),"^")_" ("_$P(PSORXED("RX3"),"^",7)_")," 38 I PSOSIG'=$P($G(^PSRX(DA,"SIG")),"^") S COM=COM_$P(^DD(52,10,0),"^")_" ("_PSOSIG_")," 39 I PSOTRN'=$G(^PSRX(DA,"TN")) S COM=COM_$P(^DD(52,6.5,0),"^")_" ("_PSOTRN_")," 40 G:COM="" LOGX K PSRX0 S X=$S($D(PSOCLC):PSOCLC,1:DUZ) 41 D FILL,LBL D:$G(PSOEDITL)=2&($P($G(^PSRX(DA,"STA")),"^")'=5)&('$G(RXRP(DA)))&('$G(PSOSIGFL)) ASKL 42 S K=1,D1=0 F Z=0:0 S Z=$O(^PSRX(DA,"A",Z)) Q:'Z S D1=Z,K=K+1 43 S D1=D1+1 S:'($D(^PSRX(DA,"A",0))#2) ^(0)="^52.3DA^^^" S ^(0)=$P(^(0),"^",1,2)_"^"_D1_"^"_K 44 S ^PSRX(DA,"A",D1,0)=DT_"^E^"_$G(DUZ)_"^0^"_COM 45 I QTY,$P(^PSRX(DA,2),"^",13) S ^PSDRUG($P(^PSRX(DA,0),"^",6),660.1)=$S($D(^PSDRUG(+$P(^PSRX(DA,0),"^",6),660.1)):^(660.1)+QTY,1:QTY) 46 S:$P(RX0,"^",6)'=$P(^PSRX(DA,0),"^",6) ^PSDRUG(+$P(^PSRX(DA,0),"^",6),660.1)=$S($D(^PSDRUG(+$P(RX0,"^",6),660.1)):^(660.1)+$P(RX0,"^",7),1:$P(RX0,"^",7)) 47 S RX0=^PSRX(DA,0),RX2=^(2),J=DA,OEXDT=+$P(RX2,"^",6) D ^PSOEXDT S NEXDT=+$P(RX2,"^",6) I OEXDT'=NEXDT D 48 .K ^PSRX("AG",OEXDT,DA) S ^PSRX("AG",NEXDT,DA)="" 49 .S D=+$P(RX0,"^",2) K ^PS(55,D,"P","A",OEXDT,DA) S ^PS(55,D,"P","A",NEXDT,DA)="" 50 K D,OEXDT,NEXDT 51 G:+$P(^PSRX(J,"STA"),"^")!($G(PSOEDITL)=1) LOGX S RXFL(PSORXED("IRXN"))=$S($G(PSOEDITF):$G(PSOEDITF),1:0) I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSORXED("IRXN")_"," D SETRP G LOGX 52 G:$G(PSOEDITL)=1 LOGX 53 F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 54 I $L(PSORX("PSOL",PSOX2))+$L(PSORXED("IRXN"))<220 D G LOGX 55 .I PSORX("PSOL",PSOX2)'[PSORXED("IRXN")_"," S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSORXED("IRXN")_"," D SETRP 56 E I PSORX("PSOL",PSOX2+1)'[PSORXED("IRXN")_"," S PSORX("PSOL",PSOX2+1)=PSORXED("IRXN")_"," D SETRP 57 LOGX K PSOEDITF,PSOEDITR,PSOEDITL D:$G(RFED) ^PSORXED1 58 Q 59 POST ; D NEXT D:$G(^PSRX(PSORXED("IRXN"),"IB"))]"" COPAY K PSODAYS,PSORXST 60 D NEXT D COPAY K PSODAYS,PSORXST 61 Q 62 COPAY S DA=PSORXED("IRXN") I 'RFD,PSODAYS'=+$P(^PSRX(DA,0),"^",8) I +$G(^PSRX(DA,"IB"))!($P($G(^PSRX(DA,"PFS")),"^",2)) D CPCK G RXST 63 I RFD,+$G(^PSRX(DA,1,RFD,0)),PSODAYS'=$P($G(^PSRX(DA,1,RFD,0)),"^",10) I +$G(^PSRX(DA,"IB"))!($P($G(^PSRX(DA,1,RFD,"PFS")),"^",2)) D CPCK 64 RXST G:PSORXST=+$P($G(^PS(53,+$P(^PSRX(DA,0),"^",3),0)),"^",7) COPAYX 65 W !,$C(7),"Patient Status field for this Rx has been changed from a ",$S(PSORXST=0:"COPAYMENT ELIGIBLE",PSORXST=1:"COPAYMENT EXEMPT",1:"") 66 W !,"patient status." 67 W " The copay status for this Rx will be automatically adjusted." 68 W !,"If action needs to be taken to adjust charges you MUST use the" 69 W !,"Reset Copay Status/Cancel Charges option." 70 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR 71 I +$P($G(^PS(53,+$P(^PSRX(DA,0),"^",3),0)),"^",7)=1 D ; SET TO NO COPAY AND AUDIT CHANGE 72 . I '$D(^PSRX(DA,"IB")) S ^PSRX(DA,"IB")="" 73 . S $P(^PSRX(DA,"IB"),"^",1)="" 74 . S PSODA=DA 75 . S PSOREF=RFD 76 . S PSOCOMM="Rx Patient Status Change" 77 . S PSOOLD="Copay" 78 . S PSONW="No Copay" 79 . S PREA="R" 80 . D ACTLOG^PSOCPA 81 COPAYX K DA,PSODAYS,PSO,PSODA,PSOFLAG,PSORXST,RFD,PSOREF,PSOCOMM,PSOOLD,PSONW 82 Q 83 CPCK ;update COPAY 84 I 'RFD,'$D(^PSRX(DA,"PFS")) G CPCK1 85 I RFD,'$D(^PSRX(DA,1,RFD,"PFS")) G CPCK1 86 N PSOPFS S PSOPFS=$P($S('RFD:^PSRX(DA,"PFS"),1:^PSRX(DA,1,RFD,"PFS")),"^",1,2) 87 I +$G(PSOPFS)>0&('$P($G(PSOPFS),"^",2)) K PSOPFS Q 88 I +$G(PSOPFS)<1 K PSOPFS 89 E S PSOPFS="1^"_PSOPFS 90 CPCK1 N TYPE S PSO=2,PSODA=DA,PSOFLAG=1,PSOPAR7=$G(^PS(59,PSOSITE,"IB")),TYPE=RFD D RXED^PSOCPA K TYPE 91 Q 92 NEXT D NEXT^PSOUTIL(.PSORXED) K DIE,DR,DA S DIE="^PSRX(",DA=PSORXED("IRXN") 93 S DR="101///"_$P(PSORXED("RX3"),"^")_";102///"_$P(PSORXED("RX3"),"^",2) D ^DIE K DIE,DR,DA,X,Y 94 Q 95 EOJ K PSOSIG,PSORXED,PSOLIST,END,PSRX0 96 D EX^PSORXED1 97 Q 98 FILL ; 99 K PSOEDITF,PSOEDITR,PSOERF 100 F PSOEZ=0:0 S PSOEZ=$O(^PSRX(DA,1,PSOEZ)) Q:'PSOEZ S:$D(^PSRX(DA,1,PSOEZ,0)) PSOERF=PSOEZ 101 S PSOEDITF=$S($G(PSOERF):+$G(PSOERF),1:0) 102 I PSOEDITF S PSOEDITR=$S($P($G(^PSRX(DA,1,PSOEDITF,0)),"^",18):1,1:0) G FILLX 103 S PSOEDITR=$S($P($G(^PSRX(DA,2)),"^",13):1,1:0) 104 FILLX K PSOERF,PSOEZ 105 Q 106 LBL ; 107 S PSOEDITL=0 108 I COM["PROV"!(COM["QTY")!(COM["DAYS")!(COM["MAIL")!(COM["UNIT")!(COM["FILL DATE")!(COM["REMARKS") I COM'["STATUS",COM'["CLINIC",COM'["DRUG",COM'["REFILLS",COM'["ISSUE",COM'["SIG",COM'["TRADE" D Q 109 .I $G(PSOEDITF) S PSOEDITL=1 Q 110 .I '$G(PSOEDITF),$G(PSOEDITR) S PSOEDITL=2 111 I '$G(PSOEDITF),$G(PSOEDITR) S PSOEDITL=2 Q 112 I '$G(PSOEDITF),'$G(PSOEDITR) S PSOEDITL=0 Q 113 I $G(RXRP(DA)) S PSOEDITL=1 Q 114 I '$G(RXRP(DA)),$G(PSOEDITR) S PSOEDITL=2 Q 115 S PSOEDITL=0 116 Q 117 ASKL ; 118 W ! K DIR S DIR("?",1)="You have edited a fill that has already been released. Do you want to",DIR("?",2)="include this prescription as one of the prescriptions to be acted upon",DIR("?",3)="at the label prompt." 119 S DIR("?")="Enter 'Yes' to generate a reprint label request." 120 S DIR(0)="Y",DIR("A")="The last fill has been released, do you want a reprint label",DIR("B")="Y" D ^DIR K DIR I Y=1 S PSOEDITL=0 Q 121 S PSOEDITL=1 122 Q 123 SETRP I $P($G(^PSRX(PSORXED("IRXN"),"STA")),"^")'=5,$G(PSOEDITL)=0 S RXRP(PSORXED("IRXN"))="1^^^1",VALMSG="Label will reprint due to Edit" 124 Q
Note:
See TracChangeset
for help on using the changeset viewer.
