- PSOORED1 ;ISC-BHAM/SAB - edit orders from backdoor ;06-Dec-2012 20:28;PLS
- ;;7.0;OUTPATIENT PHARMACY;**5,23,46,78,114,117,131,146,1002,1003,1005,1008,223,148,244,249,268,206,1015**;DEC 1997;Build 62
- ;External reference ^PS(55 supported by DBIA 2228
- ;External reference ^PS(50.7 supported by DBIA 2223
- ;
- ;*244 call to remove DC'd Rx's from Rx ien strings
- ;
- ; Modified - IHS/CIA/PLS - 12/01/04 - Line RFN+22
- ; 08/29/06 - Line TRY+4 added
- ; 09/15/06 - Line TRY+3 added
- ; 03/23/09 - Line RF+1
- ; 12/06/12 - Line RF+10
- EN(PSORENW) ;
- N LST,ORD,ORN K VALMBCK,PSORX("FN") S PSOAC=1,(PSORX("QFLG"),PSORX("DFLG"))=0 ;D DREN^PSOORNW2,INIT
- D INIT
- D @$S($P(PSOPAR,"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN")
- I '$D(PSONEW("RX #")),'$P(PSOPAR,"^",7) D PAUSE^VALM1 K VALMSG,PSONEW("QFLG") S VALMBCK="Q" Q
- I '$D(PSONEW("RX #")) K VALMSG D DEL^PSONEW,PAUSE^VALM1 S VALMBCK="Q" Q
- S PSORENW("RX #")=PSONEW("RX #") I '$P(PSOPAR,"^",7) D Q:$G(PSONEW("DFLG"))!($G(PSONEW("QFLG")))
- .S PSOX=PSORENW("RX #") D CHECK^PSONRXN
- I $G(PSONEW("DFLG"))!$G(PSONEW("QFLG")) D DEL^PSONEW,PAUSE^VALM1 S VALMBCK="Q" K PSORENW Q
- D EN^PSOORNE1(.PSORENW) I '$G(PSORX("FN")) D:$P($G(PSOPAR),"^",7)=1 S VALMBCK="Q" Q
- .S DIE="^PS(59,",DA=PSOSITE,PSOY=$O(PSONEW("OLD LAST RX#","")),PSOX=PSONEW("OLD LAST RX#",PSOY)
- .L +^PS(59,+PSOSITE,PSOY):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- .S DR=$S(PSOY=8:"2003////"_PSOX,PSOY=3:"1002.1////"_PSOX,1:"2003////"_PSOX)
- .D:PSOX<$P(^PS(59,+PSOSITE,PSOY),"^",3) ^DIE K DIE,X,Y L -^PS(59,+PSOSITE,PSOY)
- .I $D(PSONEW("RX #")) L -^PSRX("B",PSONEW("RX #"))
- .K PSOX,PSOY Q
- Q:$G(COPY)
- TRY S $P(^PSRX(PSORENW("OIRXN"),"STA"),"^")=15,DA=PSORENW("OIRXN")
- S $P(^PSRX(DA,3),"^",5)=DT,$P(^PSRX(DA,3),"^",10)=$P(^PSRX(DA,3),"^")
- D REVERSE^PSOBPSU1(DA,,"DC",7),CAN^PSOTPCAN(DA)
- D RMP^PSOCAN3 ;*244
- ;cancel/discontinue action
- S PHARM="",STAT="RP",COMM="Prescription discontinued due to editing." D EN^PSOHLSN1(DA,STAT,PHARM,COMM,PSONOOR) K STAT,PHARM,COMM
- S ^TMP("APSPPOS",$J,PSORENW("OIRXN"))=1 ; IHS/MSC/PLS - 09/15/06 - Configuration for $$POS call
- I $$POS^APSPFUNC(DA) ;IHS/MSC/PLS - 08/29/06 - Prompt for POS action
- S ACOM="Discontinued due to editing. New Rx created "_$P(^PSRX(PSORENW("IRXN"),0),"^")_"."
- I $G(^PSRX(DA,"H"))]"" D
- .I $P(^PSRX(DA,"STA"),"^")=3!($P(^("STA"),"^")=16) D
- ..S DIE=52,DR="22///"_$P(^PSRX(DA,3),"^") D ^DIE S ACOM="Discontinued due to editing while on hold. " K:$P(^PSRX(DA,"H"),"^") ^PSRX("AH",$P(^PSRX(DA,"H"),"^"),DA)
- ..S ^PSRX(DA,"H")=""
- S RXDA=DA,(DA,SUSDA)=$O(^PS(52.5,"B",RXDA,0)) D:DA
- .S SUSD=$P($G(^PS(52.5,DA,0)),"^",2)
- .S:+$G(^PS(52.5,DA,"P"))'=1 ACOM="Discontinued due to editing while suspended."
- .I $O(^PSRX(RXDA,1,0)) S DA=RXDA D:'$G(^PS(52.5,+SUSDA,"P")) REF^PSOCAN2
- .S DA=SUSDA,DIK="^PS(52.5," D ^DIK K DIK
- K SUSD,SUSDA S DA=RXDA,RXREF=0,PSODFN=+$P(^PSRX(DA,0),"^",2) D
- .S ACNT=0 F SUB=0:0 S SUB=$O(^PSRX(DA,"A",SUB)) Q:'SUB S ACNT=SUB
- .S RFCNT=0 F RF=0:0 S RF=$O(^PSRX(DA,1,RF)) Q:'RF S RFCNT=RF S:RF>5 RFCNT=RF+1
- .D NOW^%DTC S ^PSRX(DA,"A",0)="^52.3DA^"_(ACNT+1)_"^"_(ACNT+1),^PSRX(DA,"A",ACNT+1,0)=%_"^C^"_DUZ_"^"_RFCNT_"^"_$G(ACOM)
- .I $G(PSOOIFLG),'$G(PSOMRFLG) S $P(^PSRX(DA,"A",ACNT+1,1),"^")="Pharmacy Orderable Item Edited."
- .I '$G(PSOOIFLG),$G(PSOMRFLG) S $P(^PSRX(DA,"A",ACNT+1,1),"^")="Medication Route/Schedule Edited."
- .I $G(PSOOIFLG),$G(PSOMRFLG) S $P(^PSRX(DA,"A",ACNT+1,1),"^")="Pharmacy Orderable Item and Medication Route/Schedule Edited."
- .S REA="C" D EXP^PSOHELP1
- I $G(^PS(52.4,DA,0))]"" S PSCDA=DA,DIK="^PS(52.4," D ^DIK S DA=PSCDA K DIK,PSCDA
- Q
- INS K X,QUIT,Y,DIR,DIRUT,DUOUT,DTOUT,DIC,INSDEL,UPMI,^TMP($J,"INS1")
- I '$O(^PSRX(PSORXED("IRXN"),6,0)),'$O(PSORXED("DOSE",0)) D UPMI Q:$G(QUIT) ;G INS1
- I $G(^PSRX(PSORXED("IRXN"),"INS"))]"" S PSORXED("FLD",114)=^PSRX(PSORXED("IRXN"),"INS") K UPMI G INS1
- K DD,GG F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),"INS1",I)) Q:'I S DD=$G(DD)+1
- I $G(DD)=1 S PSORXED("FLD",114)=^PSRX(PSORXED("IRXN"),"INS1",$O(^PSRX(PSORXED("IRXN"),"INS1",0)),0) K UPMI,DD G INS1
- I $O(^PSRX(PSORXED("IRXN"),"INS1",0)) D G INSX
- .F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),"INS1",I)) Q:'I S ^TMP($J,"INS1",I,0)=^PSRX(PSORXED("IRXN"),"INS1",I,0)
- .S ^TMP($J,"INS1",0)=^PSRX(PSORXED("IRXN"),"INS1",0)
- .S DIC="^TMP($J,""INS1"",",DWPK=2,DWLW=80 D EN^DIWE I $G(X)="^" K ^TMP($J,"INS1") Q
- .I '$O(^TMP($J,"INS1",0)) S INSDEL=1
- .S D=0 F S D=$O(^PSRX(PSORXED("IRXN"),"INS1",D)) Q:'D S PSORXED("SIG",D)=^PSRX(PSORXED("IRXN"),"INS1",D,0)
- INS1 K Y,DIR,DIRUT,DUOUT,DTOUT,DIC,X
- I $G(UPMI) K UPMI I $G(^PS(50.7,PSODRUG("OI"),"INS"))]"" S PSORXED("FLD",114)=^PS(50.7,PSODRUG("OI"),"INS")
- S:$G(PSORXED("FLD",114))]"" DIR("B")=PSORXED("FLD",114)
- S DIR("?")="Enter Quick codes or Free Text",DIR(0)="52,114" D ^DIR
- I $D(DTOUT)!($D(DUOUT))!($G(PSORXED("FLD",114))=X) K PSORXED("FLD",114) G INSX
- I X'="",X'="@" D SIG^PSOHELP G INS1:'$D(X)
- S PSORXED("FLD",114)=X
- I $G(INS1)]"" W " ("_$E(INS1,2,9999999)_")"
- G:(X']""!(X="@")) INSX
- S (PSORXED("INS"),PSORXED("SIG",1))=$E(INS1,2,9999999) D EN^PSOFSIG(.PSORXED)
- INSX I $P($G(^PS(55,PSODFN,"LAN")),"^") K DIR D
- .I $G(^PSRX(PSORXED("IRXN"),"INSS"))]"" S PSORXED("SINS")=^PSRX(PSORXED("IRXN"),"INSS")
- .D SINS^PSODIR(.PSORXED) I $G(PSORXED("SINS"))']"" K ^PSRX(PSORXED("IRXN"),"INSS") Q
- .S PSORXED("FLD",114.1)=PSORXED("SINS")
- K DIRUT,DUOUT,DTOUT,DIR,X,Y,DIC,DWPK
- Q
- INIT ;setup psorenw array
- S PSORENW("RX0")=^PSRX(PSORENW("IRXN"),0),PSORENW("RX2")=^(2),PSORENW("RX3")=^(3),PSORENW("STA")=^("STA"),PSORENW("TN")=$G(^("TN"))
- I $G(PSOSIGFL),$G(PSORX("SIG"))]"" S PSORENW("SIG")=PSORX("SIG"),SIGOK=0
- E D
- .I '$P($G(^PSRX(PSORENW("IRXN"),"SIG")),"^",2) S PSORENW("SIG")=$P($G(^("SIG")),"^")
- .E D
- ..S SIGOK=1 Q:$O(SIG(0))
- ..S D=0 F I=0:0 S D=D+1,I=$O(^PSRX(PSORENW("IRXN"),"SIG1",I)) Q:'I S SIG(D)=^PSRX(PSORENW("IRXN"),"SIG1",I,0)
- ..K PSOX1,D
- S PSORENW("OIRXN")=PSORENW("IRXN")
- S PSORENW("PROVIDER")=$S($G(PSORENW("PROVIDER")):PSORENW("PROVIDER"),1:$P(PSORENW("RX0"),"^",4))
- S (PSORENW("PROVIDER NAME"),PSORX("PROVIDER NAME"))=$P($G(^VA(200,PSORENW("PROVIDER"),0)),"^")
- I $P($G(^VA(200,PSORENW("PROVIDER"),"PS")),"^",7),$P($G(^("PS")),"^",8) S PSORENW("COSIGNING PROVIDER")=$P($G(^("PS")),"^",8)
- S PSORENW("CLINIC")=$S($G(PSORENW("CLINIC")):PSORENW("CLINIC"),1:$P(PSORENW("RX0"),"^",5))
- S PSORENW("REMARKS")="New Order Created by "_$S($G(COPY)&('$G(PSOEDIT)):"copying",1:"editing")_" Rx # "_$P(PSORENW("RX0"),"^")_"."
- S PSORENW("COSIGNER")=$S($G(PSORENW("COSIGNER")):PSORENW("COSIGNER"),$P(PSORENW("RX3"),"^",3):$P(PSORENW("RX3"),"^",3),1:"")
- K:PSORENW("COSIGNER")="" PSORENW("COSIGNER")
- S PSORENW("PSODFN")=$P(PSORENW("RX0"),"^",2)
- S PSORENW("ORX #")=$P(PSORENW("RX0"),"^")
- S:$G(PSODRUG("IEN")) PSORENW("DRUG IEN")=PSODRUG("IEN")
- I $G(PSORENW("DAYS SUPPLY")) G QTY
- S PSORENW("DAYS SUPPLY")=$S($D(CLOZPAT):7,1:$P(PSORENW("RX0"),"^",8))
- QTY S PSORENW("QTY")=$S($G(PSORENW("QTY")):PSORENW("QTY"),1:$P(PSORENW("RX0"),"^",7))
- RFN S PSORENW("# OF REFILLS")=$S($D(CLOZPAT):0,$G(PSORENW("# OF REFILLS")):PSORENW("# OF REFILLS"),1:$P(PSORENW("RX0"),"^",9))
- S (PSOID,Y,PSORENW("FILL DATE"),PSORENW("ISSUE DATE"))=DT
- S:PSORENW("CLINIC") PSORX("CLINIC")=$P(^SC(+PSORENW("CLINIC"),0),"^")
- S PSORENW("PATIENT STATUS")=$S($G(PSORENW("PATIENT STATUS")):PSORENW("PATIENT STATUS"),'$P(PSORENW("RX0"),"^",3):$G(^PS(55,PSORENW("PSODFN"),"PS")),1:$P(PSORENW("RX0"),"^",3))
- S PSORENW("PTST NODE")=$G(^PS(53,PSORENW("PATIENT STATUS"),0))
- S PSDAYS=$S($G(PSORENW("DAYS SUPPLY")):PSORENW("DAYS SUPPLY"),'$P(PSORENW("RX0"),"^",8):$P(PSORENW("PTST NODE"),"^",3),1:$P(PSORENW("RX0"),"^",8))
- I $G(PSODRUG("IEN")) S DREN=PSODRUG("IEN"),POERR=1 D DRG^PSOORDRG K POERR
- D:$G(PSORENW("# OF REFILLS"))']"" RF
- S PSORENW("MAIL/WINDOW")=$S($G(PSORENW("MAIL/WINDOW"))]"":PSORENW("MAIL/WINDOW"),1:$P(PSORENW("RX0"),"^",11))
- S PSORX("MAIL/WINDOW")=$S(PSORENW("MAIL/WINDOW")="W":"WINDOW",1:"MAIL")
- S PSORENW("COPIES")=$S($G(PSORENW("COPIES")):PSORENW("COPIES"),$P(PSORENW("RX0"),"^",18):$P(PSORENW("RX0"),"^",18),1:1)
- S PSORENW("CLERK CODE")=DUZ
- S:$G(PSORX("CLERK CODE"))']"" PSORX("CLERK CODE")=$P($G(^VA(200,DUZ,0)),"^")
- Q:$D(COPY) S PSORENW("ENT")=0 ;Q:$G(PSOSIGFL)!($D(COPY))
- K PSORENW("ENT") F I=0:0 S I=$O(PSORENW("DOSE",I)) Q:'I S PSORENW("ENT")=$G(PSORENW("ENT"))+1
- I $O(^TMP($J,"INS1",0)) D
- .K PSORXED("SIG"),DD
- .F I=0:0 S I=$O(^TMP($J,"INS1",I)) Q:'I S PSORENW("SIG",I)=^TMP($J,"INS1",I,0)
- .K ^TMP($J,"INS1")
- I $G(^PSRX(PSORENW("IRXN"),"INS"))]"" S PSORENW("INS")=^PSRX(PSORENW("IRXN"),"INS")
- I $G(^PSRX(PSORENW("IRXN"),"INSS"))]"" S PSORENW("SINS")=^PSRX(PSORENW("IRXN"),"INSS")
- I '$G(PSORENW("ENT")),'$G(PSOSIGFL) D DOLST1^PSOORED3(.PSORENW) S PSORENW("ENT")=+$G(OLENT)
- ; IHS/CIA/PLS - 12/01/04 - Added IHS fields to array for copy/new prescription
- N TALK
- I $D(^PSRX(PSORENW("IRXN"),9999999)) D
- .S PSORENW("AWP")=$$AWP^APSQDAWP($P($G(PSORENW("RX2")),U,7),$G(PSODRUG("IEN")),.TALK)
- .S PSORENW("BST")=$P($G(^PSRX(PSORENW("IRXN"),9999999)),U,7)
- .S PSORENW("CM")=$P($G(^PSRX(PSORENW("IRXN"),9999999)),U,2)
- Q
- RF ;# of refills
- ; Changed default refill from 11 to 15
- ;S PTRF=$S($P(PSORENW("PTST NODE"),"^",4)]"":$P(PSORENW("PTST NODE"),"^",4),1:11)
- S PTRF=$S($P(PSORENW("PTST NODE"),"^",4)]"":$P(PSORENW("PTST NODE"),"^",4),1:15)
- S CS=0 F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S CS=1
- I CS D
- .S PSOX1=$S(PTRF>5:5,1:PTRF),PSOX=$S(PSOX1=5:5,1:PSOX1)
- .S PSOX=$S('PSOX:0,PSDAYS=90:1,1:PSOX),PSDY1=$S(PSDAYS<60:5,PSDAYS'<60&(PSDAYS'>89):2,PSDAYS=90:1,1:0) S PSORENW("# OF REFILLS")=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- E D
- .S PSOX1=PTRF,PSOX=$S(PSOX1=11:11,1:PSOX1),PSOX=$S('PSOX:0,PSDAYS=90:3,1:PSOX)
- .;IHS/MSC/PLS - 12/06/2012
- .;S PSDY1=$S(PSDAYS<60:11,PSDAYS'<60&(PSDAYS'>89):5,PSDAYS=90:3,1:0) S PSORENW("# OF REFILLS")=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- .S PSDY1=$S(PSDAYS<60:15,PSDAYS<90:5,PSDAYS=90:3,PSDAYS<168:2,PSDAYS<365:1,1:0) S PSORENW("# OF REFILLS")=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2) S PSORENW("# OF REFILLS")=0
- K PSDY,PSDY1,PTRF,PSOX,PSOX1,PSDAYS,CS
- Q
- UPMI ;add dosing data for pre-poe rxs
- W !! K PSONEW("DFLG"),DIR,DIRUT,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="No",DIR("A")="Dosing Instructions Are Missing!! Do You Want to Add Them"
- D ^DIR I 'Y!($D(DIRUT)) S QUIT=1 K DIR,DIRUT,DUOT,DUOUT Q
- S UPMI=1,EDTHLD=$G(PSORX("EDIT")) K PSORX("EDIT")
- D DOSE1^PSOORED5(.PSORXED) S (PSORXED,PSORX("EDIT"))=EDTHLD K EDTHLD I $G(PSONEW("DFLG")) S QUIT=1
- Q
- PSOORED1 ;ISC-BHAM/SAB - edit orders from backdoor ;06-Dec-2012 20:28;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**5,23,46,78,114,117,131,146,1002,1003,1005,1008,223,148,244,249,268,206,1015**;DEC 1997;Build 62
- +2 ;External reference ^PS(55 supported by DBIA 2228
- +3 ;External reference ^PS(50.7 supported by DBIA 2223
- +4 ;
- +5 ;*244 call to remove DC'd Rx's from Rx ien strings
- +6 ;
- +7 ; Modified - IHS/CIA/PLS - 12/01/04 - Line RFN+22
- +8 ; 08/29/06 - Line TRY+4 added
- +9 ; 09/15/06 - Line TRY+3 added
- +10 ; 03/23/09 - Line RF+1
- +11 ; 12/06/12 - Line RF+10
- EN(PSORENW) ;
- +1 ;D DREN^PSOORNW2,INIT
- NEW LST,ORD,ORN
- KILL VALMBCK,PSORX("FN")
- SET PSOAC=1
- SET (PSORX("QFLG"),PSORX("DFLG"))=0
- +2 DO INIT
- +3 DO @$SELECT($PIECE(PSOPAR,"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN")
- +4 IF '$DATA(PSONEW("RX #"))
- IF '$PIECE(PSOPAR,"^",7)
- DO PAUSE^VALM1
- KILL VALMSG,PSONEW("QFLG")
- SET VALMBCK="Q"
- QUIT
- +5 IF '$DATA(PSONEW("RX #"))
- KILL VALMSG
- DO DEL^PSONEW
- DO PAUSE^VALM1
- SET VALMBCK="Q"
- QUIT
- +6 SET PSORENW("RX #")=PSONEW("RX #")
- IF '$PIECE(PSOPAR,"^",7)
- Begin DoDot:1
- +7 SET PSOX=PSORENW("RX #")
- DO CHECK^PSONRXN
- End DoDot:1
- IF $GET(PSONEW("DFLG"))!($GET(PSONEW("QFLG")))
- QUIT
- +8 IF $GET(PSONEW("DFLG"))!$GET(PSONEW("QFLG"))
- DO DEL^PSONEW
- DO PAUSE^VALM1
- SET VALMBCK="Q"
- KILL PSORENW
- QUIT
- +9 DO EN^PSOORNE1(.PSORENW)
- IF '$GET(PSORX("FN"))
- IF $PIECE($GET(PSOPAR),"^",7)=1
- Begin DoDot:1
- +10 SET DIE="^PS(59,"
- SET DA=PSOSITE
- SET PSOY=$ORDER(PSONEW("OLD LAST RX#",""))
- SET PSOX=PSONEW("OLD LAST RX#",PSOY)
- +11 LOCK +^PS(59,+PSOSITE,PSOY):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- +12 SET DR=$SELECT(PSOY=8:"2003////"_PSOX,PSOY=3:"1002.1////"_PSOX,1:"2003////"_PSOX)
- +13 IF PSOX<$PIECE(^PS(59,+PSOSITE,PSOY),"^",3)
- DO ^DIE
- KILL DIE,X,Y
- LOCK -^PS(59,+PSOSITE,PSOY)
- +14 IF $DATA(PSONEW("RX #"))
- LOCK -^PSRX("B",PSONEW("RX #"))
- +15 KILL PSOX,PSOY
- QUIT
- End DoDot:1
- SET VALMBCK="Q"
- QUIT
- +16 IF $GET(COPY)
- QUIT
- TRY SET $PIECE(^PSRX(PSORENW("OIRXN"),"STA"),"^")=15
- SET DA=PSORENW("OIRXN")
- +1 SET $PIECE(^PSRX(DA,3),"^",5)=DT
- SET $PIECE(^PSRX(DA,3),"^",10)=$PIECE(^PSRX(DA,3),"^")
- +2 DO REVERSE^PSOBPSU1(DA,,"DC",7)
- DO CAN^PSOTPCAN(DA)
- +3 ;*244
- DO RMP^PSOCAN3
- +4 ;cancel/discontinue action
- +5 SET PHARM=""
- SET STAT="RP"
- SET COMM="Prescription discontinued due to editing."
- DO EN^PSOHLSN1(DA,STAT,PHARM,COMM,PSONOOR)
- KILL STAT,PHARM,COMM
- +6 ; IHS/MSC/PLS - 09/15/06 - Configuration for $$POS call
- SET ^TMP("APSPPOS",$JOB,PSORENW("OIRXN"))=1
- +7 ;IHS/MSC/PLS - 08/29/06 - Prompt for POS action
- IF $$POS^APSPFUNC(DA)
- +8 SET ACOM="Discontinued due to editing. New Rx created "_$PIECE(^PSRX(PSORENW("IRXN"),0),"^")_"."
- +9 IF $GET(^PSRX(DA,"H"))]""
- Begin DoDot:1
- +10 IF $PIECE(^PSRX(DA,"STA"),"^")=3!($PIECE(^("STA"),"^")=16)
- Begin DoDot:2
- +11 SET DIE=52
- SET DR="22///"_$PIECE(^PSRX(DA,3),"^")
- DO ^DIE
- SET ACOM="Discontinued due to editing while on hold. "
- IF $PIECE(^PSRX(DA,"H"),"^")
- KILL ^PSRX("AH",$PIECE(^PSRX(DA,"H"),"^"),DA)
- +12 SET ^PSRX(DA,"H")=""
- End DoDot:2
- End DoDot:1
- +13 SET RXDA=DA
- SET (DA,SUSDA)=$ORDER(^PS(52.5,"B",RXDA,0))
- IF DA
- Begin DoDot:1
- +14 SET SUSD=$PIECE($GET(^PS(52.5,DA,0)),"^",2)
- +15 IF +$GET(^PS(52.5,DA,"P"))'=1
- SET ACOM="Discontinued due to editing while suspended."
- +16 IF $ORDER(^PSRX(RXDA,1,0))
- SET DA=RXDA
- IF '$GET(^PS(52.5,+SUSDA,"P"))
- DO REF^PSOCAN2
- +17 SET DA=SUSDA
- SET DIK="^PS(52.5,"
- DO ^DIK
- KILL DIK
- End DoDot:1
- +18 KILL SUSD,SUSDA
- SET DA=RXDA
- SET RXREF=0
- SET PSODFN=+$PIECE(^PSRX(DA,0),"^",2)
- Begin DoDot:1
- +19 SET ACNT=0
- FOR SUB=0:0
- SET SUB=$ORDER(^PSRX(DA,"A",SUB))
- IF 'SUB
- QUIT
- SET ACNT=SUB
- +20 SET RFCNT=0
- FOR RF=0:0
- SET RF=$ORDER(^PSRX(DA,1,RF))
- IF 'RF
- QUIT
- SET RFCNT=RF
- IF RF>5
- SET RFCNT=RF+1
- +21 DO NOW^%DTC
- SET ^PSRX(DA,"A",0)="^52.3DA^"_(ACNT+1)_"^"_(ACNT+1)
- SET ^PSRX(DA,"A",ACNT+1,0)=%_"^C^"_DUZ_"^"_RFCNT_"^"_$GET(ACOM)
- +22 IF $GET(PSOOIFLG)
- IF '$GET(PSOMRFLG)
- SET $PIECE(^PSRX(DA,"A",ACNT+1,1),"^")="Pharmacy Orderable Item Edited."
- +23 IF '$GET(PSOOIFLG)
- IF $GET(PSOMRFLG)
- SET $PIECE(^PSRX(DA,"A",ACNT+1,1),"^")="Medication Route/Schedule Edited."
- +24 IF $GET(PSOOIFLG)
- IF $GET(PSOMRFLG)
- SET $PIECE(^PSRX(DA,"A",ACNT+1,1),"^")="Pharmacy Orderable Item and Medication Route/Schedule Edited."
- +25 SET REA="C"
- DO EXP^PSOHELP1
- End DoDot:1
- +26 IF $GET(^PS(52.4,DA,0))]""
- SET PSCDA=DA
- SET DIK="^PS(52.4,"
- DO ^DIK
- SET DA=PSCDA
- KILL DIK,PSCDA
- +27 QUIT
- INS KILL X,QUIT,Y,DIR,DIRUT,DUOUT,DTOUT,DIC,INSDEL,UPMI,^TMP($JOB,"INS1")
- +1 ;G INS1
- IF '$ORDER(^PSRX(PSORXED("IRXN"),6,0))
- IF '$ORDER(PSORXED("DOSE",0))
- DO UPMI
- IF $GET(QUIT)
- QUIT
- +2 IF $GET(^PSRX(PSORXED("IRXN"),"INS"))]""
- SET PSORXED("FLD",114)=^PSRX(PSORXED("IRXN"),"INS")
- KILL UPMI
- GOTO INS1
- +3 KILL DD,GG
- FOR I=0:0
- SET I=$ORDER(^PSRX(PSORXED("IRXN"),"INS1",I))
- IF 'I
- QUIT
- SET DD=$GET(DD)+1
- +4 IF $GET(DD)=1
- SET PSORXED("FLD",114)=^PSRX(PSORXED("IRXN"),"INS1",$ORDER(^PSRX(PSORXED("IRXN"),"INS1",0)),0)
- KILL UPMI,DD
- GOTO INS1
- +5 IF $ORDER(^PSRX(PSORXED("IRXN"),"INS1",0))
- Begin DoDot:1
- +6 FOR I=0:0
- SET I=$ORDER(^PSRX(PSORXED("IRXN"),"INS1",I))
- IF 'I
- QUIT
- SET ^TMP($JOB,"INS1",I,0)=^PSRX(PSORXED("IRXN"),"INS1",I,0)
- +7 SET ^TMP($JOB,"INS1",0)=^PSRX(PSORXED("IRXN"),"INS1",0)
- +8 SET DIC="^TMP($J,""INS1"","
- SET DWPK=2
- SET DWLW=80
- DO EN^DIWE
- IF $GET(X)="^"
- KILL ^TMP($JOB,"INS1")
- QUIT
- +9 IF '$ORDER(^TMP($JOB,"INS1",0))
- SET INSDEL=1
- +10 SET D=0
- FOR
- SET D=$ORDER(^PSRX(PSORXED("IRXN"),"INS1",D))
- IF 'D
- QUIT
- SET PSORXED("SIG",D)=^PSRX(PSORXED("IRXN"),"INS1",D,0)
- End DoDot:1
- GOTO INSX
- INS1 KILL Y,DIR,DIRUT,DUOUT,DTOUT,DIC,X
- +1 IF $GET(UPMI)
- KILL UPMI
- IF $GET(^PS(50.7,PSODRUG("OI"),"INS"))]""
- SET PSORXED("FLD",114)=^PS(50.7,PSODRUG("OI"),"INS")
- +2 IF $GET(PSORXED("FLD",114))]""
- SET DIR("B")=PSORXED("FLD",114)
- +3 SET DIR("?")="Enter Quick codes or Free Text"
- SET DIR(0)="52,114"
- DO ^DIR
- +4 IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(PSORXED("FLD",114))=X)
- KILL PSORXED("FLD",114)
- GOTO INSX
- +5 IF X'=""
- IF X'="@"
- DO SIG^PSOHELP
- IF '$DATA(X)
- GOTO INS1
- +6 SET PSORXED("FLD",114)=X
- +7 IF $GET(INS1)]""
- WRITE " ("_$EXTRACT(INS1,2,9999999)_")"
- +8 IF (X']""!(X="@"))
- GOTO INSX
- +9 SET (PSORXED("INS"),PSORXED("SIG",1))=$EXTRACT(INS1,2,9999999)
- DO EN^PSOFSIG(.PSORXED)
- INSX IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
- KILL DIR
- Begin DoDot:1
- +1 IF $GET(^PSRX(PSORXED("IRXN"),"INSS"))]""
- SET PSORXED("SINS")=^PSRX(PSORXED("IRXN"),"INSS")
- +2 DO SINS^PSODIR(.PSORXED)
- IF $GET(PSORXED("SINS"))']""
- KILL ^PSRX(PSORXED("IRXN"),"INSS")
- QUIT
- +3 SET PSORXED("FLD",114.1)=PSORXED("SINS")
- End DoDot:1
- +4 KILL DIRUT,DUOUT,DTOUT,DIR,X,Y,DIC,DWPK
- +5 QUIT
- INIT ;setup psorenw array
- +1 SET PSORENW("RX0")=^PSRX(PSORENW("IRXN"),0)
- SET PSORENW("RX2")=^(2)
- SET PSORENW("RX3")=^(3)
- SET PSORENW("STA")=^("STA")
- SET PSORENW("TN")=$GET(^("TN"))
- +2 IF $GET(PSOSIGFL)
- IF $GET(PSORX("SIG"))]""
- SET PSORENW("SIG")=PSORX("SIG")
- SET SIGOK=0
- +3 IF '$TEST
- Begin DoDot:1
- +4 IF '$PIECE($GET(^PSRX(PSORENW("IRXN"),"SIG")),"^",2)
- SET PSORENW("SIG")=$PIECE($GET(^("SIG")),"^")
- +5 IF '$TEST
- Begin DoDot:2
- +6 SET SIGOK=1
- IF $ORDER(SIG(0))
- QUIT
- +7 SET D=0
- FOR I=0:0
- SET D=D+1
- SET I=$ORDER(^PSRX(PSORENW("IRXN"),"SIG1",I))
- IF 'I
- QUIT
- SET SIG(D)=^PSRX(PSORENW("IRXN"),"SIG1",I,0)
- +8 KILL PSOX1,D
- End DoDot:2
- End DoDot:1
- +9 SET PSORENW("OIRXN")=PSORENW("IRXN")
- +10 SET PSORENW("PROVIDER")=$SELECT($GET(PSORENW("PROVIDER")):PSORENW("PROVIDER"),1:$PIECE(PSORENW("RX0"),"^",4))
- +11 SET (PSORENW("PROVIDER NAME"),PSORX("PROVIDER NAME"))=$PIECE($GET(^VA(200,PSORENW("PROVIDER"),0)),"^")
- +12 IF $PIECE($GET(^VA(200,PSORENW("PROVIDER"),"PS")),"^",7)
- IF $PIECE($GET(^("PS")),"^",8)
- SET PSORENW("COSIGNING PROVIDER")=$PIECE($GET(^("PS")),"^",8)
- +13 SET PSORENW("CLINIC")=$SELECT($GET(PSORENW("CLINIC")):PSORENW("CLINIC"),1:$PIECE(PSORENW("RX0"),"^",5))
- +14 SET PSORENW("REMARKS")="New Order Created by "_$SELECT($GET(COPY)&('$GET(PSOEDIT)):"copying",1:"editing")_" Rx # "_$PIECE(PSORENW("RX0"),"^")_"."
- +15 SET PSORENW("COSIGNER")=$SELECT($GET(PSORENW("COSIGNER")):PSORENW("COSIGNER"),$PIECE(PSORENW("RX3"),"^",3):$PIECE(PSORENW("RX3"),"^",3),1:"")
- +16 IF PSORENW("COSIGNER")=""
- KILL PSORENW("COSIGNER")
- +17 SET PSORENW("PSODFN")=$PIECE(PSORENW("RX0"),"^",2)
- +18 SET PSORENW("ORX #")=$PIECE(PSORENW("RX0"),"^")
- +19 IF $GET(PSODRUG("IEN"))
- SET PSORENW("DRUG IEN")=PSODRUG("IEN")
- +20 IF $GET(PSORENW("DAYS SUPPLY"))
- GOTO QTY
- +21 SET PSORENW("DAYS SUPPLY")=$SELECT($DATA(CLOZPAT):7,1:$PIECE(PSORENW("RX0"),"^",8))
- QTY SET PSORENW("QTY")=$SELECT($GET(PSORENW("QTY")):PSORENW("QTY"),1:$PIECE(PSORENW("RX0"),"^",7))
- RFN SET PSORENW("# OF REFILLS")=$SELECT($DATA(CLOZPAT):0,$GET(PSORENW("# OF REFILLS")):PSORENW("# OF REFILLS"),1:$PIECE(PSORENW("RX0"),"^",9))
- +1 SET (PSOID,Y,PSORENW("FILL DATE"),PSORENW("ISSUE DATE"))=DT
- +2 IF PSORENW("CLINIC")
- SET PSORX("CLINIC")=$PIECE(^SC(+PSORENW("CLINIC"),0),"^")
- +3 SET PSORENW("PATIENT STATUS")=$SELECT($GET(PSORENW("PATIENT STATUS")):PSORENW("PATIENT STATUS"),'$PIECE(PSORENW("RX0"),"^",3):$GET(^PS(55,PSORENW("PSODFN"),"PS")),1:$PIECE(PSORENW("RX0"),"^",3))
- +4 SET PSORENW("PTST NODE")=$GET(^PS(53,PSORENW("PATIENT STATUS"),0))
- +5 SET PSDAYS=$SELECT($GET(PSORENW("DAYS SUPPLY")):PSORENW("DAYS SUPPLY"),'$PIECE(PSORENW("RX0"),"^",8):$PIECE(PSORENW("PTST NODE"),"^",3),1:$PIECE(PSORENW("RX0"),"^",8))
- +6 IF $GET(PSODRUG("IEN"))
- SET DREN=PSODRUG("IEN")
- SET POERR=1
- DO DRG^PSOORDRG
- KILL POERR
- +7 IF $GET(PSORENW("# OF REFILLS"))']""
- DO RF
- +8 SET PSORENW("MAIL/WINDOW")=$SELECT($GET(PSORENW("MAIL/WINDOW"))]"":PSORENW("MAIL/WINDOW"),1:$PIECE(PSORENW("RX0"),"^",11))
- +9 SET PSORX("MAIL/WINDOW")=$SELECT(PSORENW("MAIL/WINDOW")="W":"WINDOW",1:"MAIL")
- +10 SET PSORENW("COPIES")=$SELECT($GET(PSORENW("COPIES")):PSORENW("COPIES"),$PIECE(PSORENW("RX0"),"^",18):$PIECE(PSORENW("RX0"),"^",18),1:1)
- +11 SET PSORENW("CLERK CODE")=DUZ
- +12 IF $GET(PSORX("CLERK CODE"))']""
- SET PSORX("CLERK CODE")=$PIECE($GET(^VA(200,DUZ,0)),"^")
- +13 ;Q:$G(PSOSIGFL)!($D(COPY))
- IF $DATA(COPY)
- QUIT
- SET PSORENW("ENT")=0
- +14 KILL PSORENW("ENT")
- FOR I=0:0
- SET I=$ORDER(PSORENW("DOSE",I))
- IF 'I
- QUIT
- SET PSORENW("ENT")=$GET(PSORENW("ENT"))+1
- +15 IF $ORDER(^TMP($JOB,"INS1",0))
- Begin DoDot:1
- +16 KILL PSORXED("SIG"),DD
- +17 FOR I=0:0
- SET I=$ORDER(^TMP($JOB,"INS1",I))
- IF 'I
- QUIT
- SET PSORENW("SIG",I)=^TMP($JOB,"INS1",I,0)
- +18 KILL ^TMP($JOB,"INS1")
- End DoDot:1
- +19 IF $GET(^PSRX(PSORENW("IRXN"),"INS"))]""
- SET PSORENW("INS")=^PSRX(PSORENW("IRXN"),"INS")
- +20 IF $GET(^PSRX(PSORENW("IRXN"),"INSS"))]""
- SET PSORENW("SINS")=^PSRX(PSORENW("IRXN"),"INSS")
- +21 IF '$GET(PSORENW("ENT"))
- IF '$GET(PSOSIGFL)
- DO DOLST1^PSOORED3(.PSORENW)
- SET PSORENW("ENT")=+$GET(OLENT)
- +22 ; IHS/CIA/PLS - 12/01/04 - Added IHS fields to array for copy/new prescription
- +23 NEW TALK
- +24 IF $DATA(^PSRX(PSORENW("IRXN"),9999999))
- Begin DoDot:1
- +25 SET PSORENW("AWP")=$$AWP^APSQDAWP($PIECE($GET(PSORENW("RX2")),U,7),$GET(PSODRUG("IEN")),.TALK)
- +26 SET PSORENW("BST")=$PIECE($GET(^PSRX(PSORENW("IRXN"),9999999)),U,7)
- +27 SET PSORENW("CM")=$PIECE($GET(^PSRX(PSORENW("IRXN"),9999999)),U,2)
- End DoDot:1
- +28 QUIT
- RF ;# of refills
- +1 ; Changed default refill from 11 to 15
- +2 ;S PTRF=$S($P(PSORENW("PTST NODE"),"^",4)]"":$P(PSORENW("PTST NODE"),"^",4),1:11)
- +3 SET PTRF=$SELECT($PIECE(PSORENW("PTST NODE"),"^",4)]"":$PIECE(PSORENW("PTST NODE"),"^",4),1:15)
- +4 SET CS=0
- FOR DEA=1:1
- IF $EXTRACT(PSODRUG("DEA"),DEA)=""
- QUIT
- IF $EXTRACT(+PSODRUG("DEA"),DEA)>1
- IF $EXTRACT(+PSODRUG("DEA"),DEA)<6
- SET CS=1
- +5 IF CS
- Begin DoDot:1
- +6 SET PSOX1=$SELECT(PTRF>5:5,1:PTRF)
- SET PSOX=$SELECT(PSOX1=5:5,1:PSOX1)
- +7 SET PSOX=$SELECT('PSOX:0,PSDAYS=90:1,1:PSOX)
- SET PSDY1=$SELECT(PSDAYS<60:5,PSDAYS'<60&(PSDAYS'>89):2,PSDAYS=90:1,1:0)
- SET PSORENW("# OF REFILLS")=$SELECT(PSOX'>PSDY1:PSOX,1:PSDY1)
- End DoDot:1
- +8 IF '$TEST
- Begin DoDot:1
- +9 SET PSOX1=PTRF
- SET PSOX=$SELECT(PSOX1=11:11,1:PSOX1)
- SET PSOX=$SELECT('PSOX:0,PSDAYS=90:3,1:PSOX)
- +10 ;IHS/MSC/PLS - 12/06/2012
- +11 ;S PSDY1=$S(PSDAYS<60:11,PSDAYS'<60&(PSDAYS'>89):5,PSDAYS=90:3,1:0) S PSORENW("# OF REFILLS")=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- +12 SET PSDY1=$SELECT(PSDAYS<60:15,PSDAYS<90:5,PSDAYS=90:3,PSDAYS<168:2,PSDAYS<365:1,1:0)
- SET PSORENW("# OF REFILLS")=$SELECT(PSOX'>PSDY1:PSOX,1:PSDY1)
- End DoDot:1
- +13 IF PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2)
- SET PSORENW("# OF REFILLS")=0
- +14 KILL PSDY,PSDY1,PTRF,PSOX,PSOX1,PSDAYS,CS
- +15 QUIT
- UPMI ;add dosing data for pre-poe rxs
- +1 WRITE !!
- KILL PSONEW("DFLG"),DIR,DIRUT,DTOUT,DUOUT
- SET DIR(0)="Y"
- SET DIR("B")="No"
- SET DIR("A")="Dosing Instructions Are Missing!! Do You Want to Add Them"
- +2 DO ^DIR
- IF 'Y!($DATA(DIRUT))
- SET QUIT=1
- KILL DIR,DIRUT,DUOT,DUOUT
- QUIT
- +3 SET UPMI=1
- SET EDTHLD=$GET(PSORX("EDIT"))
- KILL PSORX("EDIT")
- +4 DO DOSE1^PSOORED5(.PSORXED)
- SET (PSORXED,PSORX("EDIT"))=EDTHLD
- KILL EDTHLD
- IF $GET(PSONEW("DFLG"))
- SET QUIT=1
- +5 QUIT