- PSOORNEW ;BIR/SAB - display orders from oerr ;Dec 13, 2021@08:01:18
- ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,55,46,71,90,94,106,131,133,143,237,222,258,206,225,251,386,390,391,372,416,431,313,408,436,411,444,486,446,505,517,508,457,581,617,441,651,700,746,769**;DEC 1997;Build 26
- ;External reference to ^PS(50.7 supported by DBIA 2223
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to ^PS(50.606 supported by DBIA 2174
- ;External reference to ^PS(55 supported by DBIA 2228
- ;External reference to EN1^ORCFLAG supported by DBIA 3620
- ;
- ;PSO*237 quit Finish if Today > Issue date + 365
- ;
- DSPL I $G(PSODSPL) S VALMBCK="Q" K PSODSPL,PSOANSQD Q
- Q:'$D(PSOLMC) K ^TMP("PSOPO",$J) S PSOLMC=PSOLMC+1
- I $D(CLOZPAT) S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),1:7) G OI
- S PSONEW("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))&('$G(PSONEW("DAYS SUPPLY"))):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30)
- OI I '$G(PSODRUG("OI")) D
- .N OI,OID S (OI,PSODRUG("OI"))=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^"),OID=$P(OR0,"^",9)
- .I $P($G(OR0),"^",9) S POERR=1,DREN=$P(OR0,"^",9) D DRG^PSOORDRG K POERR
- I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A",$G(PSODRUG("DEA"))'["B"!($G(PSODRUG("DEA"))["F") S PSONEW("# OF REFILLS")=0
- I $D(CLOZPAT) S PSONEW("# OF REFILLS")=$S($D(PSONEW("# OF REFILLS")):PSONEW("# OF REFILLS"),$G(CLOZPAT)=2&($P(OR0,"^",11)>2):3,$G(CLOZPAT)&($P(OR0,"^",11)>1):1,1:0)
- S IEN=0 D OBX^PSOORFI1,DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
- D LMDISP^PSOORFI5(+$G(ORD)) ; Display Flag/Unflag Information
- 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
- S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
- K LST I $G(PSODRUG("NAME"))]"" D G PT
- .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
- .S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
- .I $P($G(^PSDRUG(PSODRUG("IEN"),0)),"^",10)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Drug Message:" D DRGMSG
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Drug: No Dispense Drug Selected"
- PT D DOSE2^PSOORFI4
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Pat Instruct:" D:$O(PSONEW("SIG",0)) INST^PSOORFI4
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider Comments:" S TY=3 D INST^PSOORFI1
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Indications: "_$G(PSONEW("IND")) ;*441-IND
- I $P($G(^PS(55,PSODFN,"LAN")),"^"),$G(PSONEW("INDO"))]"" D
- . S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Other Indications: "_PSONEW("INDO")
- I $$ERXIEN^PSOERXUT(ORD_"P") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" eRx Drug: "_$$GET1^DIQ(52.49,$$ERXIEN^PSOERXUT(ORD_"P"),3.1)
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" "_$S($$ERXIEN^PSOERXUT(ORD_"P"):"eRx",1:" ")_" Instructions: " S TY=2 D INST^PSOORFI1
- K PSOELSE S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:"
- F I=0:0 S I=$O(SIG(I)) Q:'I S SIG=SIG(I) D
- .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG)
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Patient Status: "_$P($G(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^")
- K PSOELSE I $G(PSONEW("ISSUE DATE"))']"" S PSOELSE=1 S IEN=IEN+1,(PSOID,Y)=$E($P(OR0,"^",6),1,7) X ^DD("DD") S PSONEW("ISSUE DATE")=Y,^TMP("PSOPO",$J,IEN,0)=" (4) Issue Date: "_Y
- I '$G(PSOELSE) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE")
- K PSOELSE I $G(PSORX("FILL DATE"))']"" S PSOELSE=1 D
- .S (Y,PSORX("FILL DATE"))=$S($E($P(OR0,"^",6),1,7)<DT:DT,1:$E($P(OR0,"^",6),1,7)) X ^DD("DD") S PSONEW("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (5) Fill Date: "_Y
- I '$G(PSOELSE) S Y=PSORX("FILL DATE") X ^DD("DD") S PSORX("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (7) Fill Date: "_PSORX("FILL DATE")
- I $P(OR0,"^",18) S IEN=IEN+1,Y=$P(OR0,"^",18) X ^DD("DD") S $P(^TMP("PSOPO",$J,IEN,0)," ",39)="Effective Date: "_Y
- I $D(CLOZPAT) D ELIG^PSOORFI2 S:'$D(PSONEW("QTY")) PSONEW("QTY")=0
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Days Supply: "_PSONEW("DAYS SUPPLY")
- 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(+PSODRUG("IEN"),660)),"^",8)_")",1:" ( )")
- S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_": "_$S($G(PSONEW("QTY"))]"":PSONEW("QTY"),1:$P(OR0,"^",10))
- I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),5)),"^")]"" D
- .S $P(RN," ",79)=" ",IEN=IEN+1
- .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
- S IEN=IEN+1
- I $P(OR0,"^",24) S ^TMP("PSOPO",$J,IEN,0)=" Provider ordered: days supply "_+$P(OR0,"^",22)_", quantity "_+$P(OR0,"^",10)_" & refills "_+$P(OR0,"^",11)
- E S ^TMP("PSOPO",$J,IEN,0)=" Provider ordered "_+$P(OR0,"^",11)_" refills"
- D:$D(CLOZPAT) PQTY^PSOORFI4
- N PSOMWP S PSOMWP=$G(PSONEW("MAIL/WINDOW")) ;PAPI 441
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(10) # of Refills: "_$S($G(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),1:$P(OR0,"^",11))_" (11) Routing: "_$S(PSOMWP="M":"MAIL",PSOMWP="P":"PARK",1:"WINDOW") ;PAPI 441
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(12) Clinic: "_PSORX("CLINIC")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME")
- D:$P(OR0,"^",24)!((+$G(PSODRUG("DEA"))>1)&(+$G(PSODRUG("DEA"))<6)) PRV^PSOORFI5($G(PSONEW("PROVIDER")),$G(PSODRUG("IEN")),$P(OR0,"^"))
- I $P($G(^VA(200,$S($G(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$P(OR0,"^",5)),"PS")),"^",7)&($P($G(^("PS")),"^",8)) D
- .S IEN=IEN+1,PSONEW("COSIGNING PROVIDER")=$S($G(PSONEW("COSIGNING PROVIDER")):PSONEW("COSIGNING PROVIDER"),1:$P(^("PS"),"^",8))
- .S ^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(14) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
- S PSONEW("REMARKS")=$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),$P(OR0,"^",17)="C":"Administered in Clinic.",1:"")
- K PSONEW("ADMINCLINIC") S:$P(OR0,"^",17)="C" PSONEW("ADMINCLINIC")=1
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(15) Remarks:"
- I $G(PSONEW("REMARKS"))]"" D
- .F SG=1:1:$L(PSONEW("REMARKS")) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(PSONEW("REMARKS")," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D
- ..S:$P(PSONEW("REMARKS")," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("REMARKS")," ",SG)
- I $G(PSOSIGFL)!(PSODRUG("OI")'=$P(OR0,"^",8)) S PSONEW("CLERK CODE")=DUZ,PSORX("CLERK CODE")=$P(^VA(200,DUZ,0),"^"),VALMSG="This change will create a new prescription!"
- S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,PSONEW("CLERK CODE"),0),"^")_$E(RN,$L($P(^VA(200,PSONEW("CLERK CODE"),0),"^"))+1,35)
- 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
- ; eRx Pending Order (Side-By-Side) Interface (Replaces conventional interface above)
- S ERXIEN=$$ERXIEN^PSOERXUT($G(ORD)_"P")
- I ERXIEN D
- . N SUGFLDT,LASTRX,Y
- . I $D(VALMEVL) F I=1:1:99 D RESTORE^VALM10(I)
- . S SUGFLDT=$$SUGFLDT^PSOERUT(ORD),LASTRX=0
- . I $D(^XUSEC("PSO ERX P746 TEMP KEY",DUZ)),'$G(FDEDITED),SUGFLDT>DT D
- . . S (PSONEW("FILL DATE"),Y)=$P(SUGFLDT,"^"),LASTRX=+$P(SUGFLDT,"^",2) X ^DD("DD") S PSORX("FILL DATE")=Y
- . S (IEN,LINE)=0 K ^TMP("PSOPO",$J)
- . D SETPEN^PSOERUT5("PSOPO",ERXIEN,+ORD,.PSONEW,.PSODRUG,.SIG,0,LASTRX) S (VALMCNT,IEN)=LINE-1
- . D RV^PSONFI
- I PSOLMC<2 D ^PSOLMPO1 S VALMBCK="Q",PSOLMC=0
- S:PSOLMC>1 VALMBCK="R"
- Q
- ORCHK D PROVCOM^PSOORFI4,IND^PSOORFI4,ORCHK^PSOORFI4
- Q
- EDT ; Entry point for ED Action in the OP Pending Queue
- D KV
- S DIR("A",1)="* Indicates which fields will create an new Order"
- S DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:15"
- D ^DIR Q:$D(DTOUT)!($D(DUOUT))
- ;
- EDTSEL ; Entry point for individual field editing
- K PSOVLMBG I $$ERXIEN^PSOERXUT(ORD_"P") S PSOVLMBG=VALMBG
- ; Only 'Routing' Field can be edited for CS eRx Pending Orders
- I +$G(Y)'=11,$$CSERX^PSOERUT6(ORD) Q ; Not allowed to edit CS eRx orders
- N LST,FLD,OUT,CHECK,CSDRG D KV S (OUT,CSDRG)=0
- I '$D(PSODRG) S PSODRG=$G(PSODRUG("IEN"))
- I PSODRG,$$NDF(PSODRG)!($$CSDRG^PSOERUT6(PSODRG)) S CSDRG=1
- I +Y S LST=Y D FULL^VALM1 N PSODOSE M PSODOSE=PSONEW D G DSPL
- .I CSDRG,(","_LST[",1,")!(","_LST[",3,")!(","_LST[",10,")!(","_LST[",13,") D
- ..W !!,"The selection includes field(s) that are not editable"
- ..W !,"for controlled substances. These field(s) will be skipped.",!
- ..S DIR(0)="E" D ^DIR K DIR
- .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']""!(OUT) D
- ..S CHECK=","_+$P(LST,",",FLD)_"," I CSDRG,",1,3,10,13,"[CHECK Q
- ..D @(+$P(LST,",",FLD)) D:$P(LST,",",FLD)=8 REF D KV
- E S VALMBCK="" Q
- ACP ;
- D FULL^VALM1
- N PSOORNEW,DIR,Y S Y=0,PSOORNEW=1
- I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 D Q:$D(DIRUT)!'Y D EN1^ORCFLAG(+$P($G(^PS(52.41,ORD,0)),"^")) H 1
- . I '$D(^XUSEC("PSORPH",DUZ)) D S Y=0 Q
- . . S DIR("A",1)="Order must be unflagged by a pharmacist before it can be finished."
- . . S DIR("A",2)=""
- . . S DIR(0)="E",DIR("A")="Enter RETURN to continue" W !,$C(7) D ^DIR
- . . S VALMBCK="R"
- . D KV
- . S DIR("A",1)="This Order is flagged. In order to finish it"
- . S DIR("A",2)="you must unflag it first."
- . S DIR("A",3)=""
- . S DIR(0)="Y",DIR("A")="Unflag Order",DIR("B")="NO"
- . W ! D ^DIR I $D(DIRUT)!'Y S VALMBCK="Q"
- I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 Q
- ;
- ;/MZR edited next line in case QTY not defined *457
- I $D(CLOZPAT),+$G(PSONEW("QTY"))=0 S PSONEW("QTY")=$P(OR0,"^",10)
- S (PSODIR("DFLG"),PSORX("DFLG"),PSODIR("QFLD"))=0,ACP=1 D ORCHK
- G:$G(PSONEW("QFLG")) DSPL
- I $G(PSODIR("DFLG"))!$G(PSORX("DFLG")) Q
- I $G(PSONEW("FLD"))!($G(PSODRUG("NAME"))']"")!('$O(SIG(0))) G DSPL
- ;PATCH PSO*7*517 - Blocking action FN if issuing a controlled substance to a patient without a zipcode
- S DRGIEN=$G(PSODRUG("IEN"))
- I $$CSBLOCK(PSODFN,DRGIEN) D S DIR(0)="E" W ! D ^DIR K DIR K Y Q
- .W !,"Controlled substance prescriptions require a patient address. Please update"
- .W !,"patient address information. This action will also invalidate a digitally"
- .W !,"signed prescription and require the provider to re-enter the order."
- ;PSO*7*517 - END
- I $G(PSODRUG("NAME"))]"",'$G(ORCHK)!($G(ORDRG)'=PSODRUG("NAME")) D I $G(PSORX("DFLG")) Q ; *457 fixed wrong flow D CLEAN^PSOVER1 G DSPL
- . D POST^PSODRG S:'$G(PSORX("DFLG")) ORCHK=1,ORDRG=PSODRUG("NAME")
- D:'$G(PSORX("DFLG")) DOSCK^PSODOSUT("N") I $G(PSORX("DFLG")) G DSPL
- I '$D(PSONEW("RX #")) S PSOFROM="NEW",RTN=$S($P($G(PSOPAR),"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN") D @RTN Q:PSONEW("QFLG") I '$P($G(PSOPAR),"^",7) S PSOX=PSONEW("RX #") D CHECK^PSONRXN
- D RXNCHK^PSOORNE1 I $G(PSONEW("QFLG")) S PSONEW("DFLG")=1 Q
- I DT>$$FMADD^XLFDT($P(OR0,"^",6),365) D EXPR^PSONEW2 G DSPL
- D STOP^PSONEW2,DISPLAY^PSONEW2,^PSONEWF
- I $G(PSOCPZ("DFLG")) W !!,"No action taken!",! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR,KV K PSOCPZ("DFLG"),DRET,PSOANSQD S VALMBCK="Q" Q
- ;
- K PSOCPZ("DFLG") D KV S DIR(0)="Y",DIR("A")="Are you sure you want to Accept this Order",DIR("B")="NO" D ^DIR I $D(DIRUT) D KV K DRET,PSOANSQ,PSOANSQD S VALMBCK="Q" Q
- D KV I 'Y K PSOANSQ G DSPL
- I $G(PSONEW("MAIL/WINDOW"))["W" D:$P($G(PSOPAR),"^",12) S BINGCRT="Y",BINGRTE="W",PSORX("MAIL/WINDOW")="WINDOW" K RTN
- .W ! K DIR,DIRUT S DIR(0)="52,35O"
- .S:$G(PSORX("METHOD OF PICK-UP"))]"" DIR("B")=PSORX("METHOD OF PICK-UP") D ^DIR I $D(DIRUT) K DIR,DIRUT Q
- .S (PSONEW("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y K X,Y
- S PSONEW("POE")=1 K PSORX("DFLG"),PSONEW("DFLG") D EN^PSON52(.PSONEW) G:$G(PSONEW("DFLG")) ABORT D DCORD^PSONEW2 D:$G(PKI)=89802020 ALERT^PSOPKIV1
- ; - Possible Titration Rx?
- I $G(PSONEW("IRXN")) D MARK^PSOOTMRX(PSONEW("IRXN"),0)
- ;saves drug allergy order chks pso*7*390
- I $D(^TMP("PSODAOC",$J)) D
- .I $G(PSORX("DFLG")) K ^TMP("PSODAOC",$J) Q
- .S RXN=PSONEW("IRXN"),PSODAOC="Finished CPRS Rx "_$S($P(^PSRX(RXN,"STA"),"^")=4:"NON-VERIFIED ",1:"")_"Order Acceptance_OP"
- .D DAOC^PSONEW
- D NPSOSD^PSOUTIL(.PSONEW),FULL^VALM1 K PSORX("MAIL/WINDOW")
- ; PSO*7*508 - link the erx to the outpatient prescription
- ; PSO*7*581 - if this is a renewal response replace message, update the request and the response values to RRC.
- N ERXIEN,EMTYPE,ERXREQ,RESTYPE
- S ERXIEN=$$CHKERX^PSOERXU1(OR0) I ERXIEN D
- .S ERXFDA(52.49,ERXIEN_",",.13)=PSONEW("IRXN") D FILE^DIE(,"ERXFDA") K ERXFDA
- .S EMTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I") I EMTYPE'="RE",EMTYPE'="CX" Q
- .S RESTYPE=$$GET1^DIQ(52.49,ERXIEN,52.1,"I") I RESTYPE'="R",EMTYPE'="CX" Q
- .S ERXREQ=$$GETREQ^PSOERXU2(ERXIEN)
- .I EMTYPE="RE" D UPDSTAT^PSOERXU1(ERXIEN,"RXC"),UPDSTAT^PSOERXU1(ERXREQ,"RRC")
- .I EMTYPE="CX" D UPDSTAT^PSOERXU1(ERXIEN,"CXC"),UPDSTAT^PSOERXU1(ERXREQ,"CRC")
- ; PSO*7*508 - end eRx enhancement
- D EOJ^PSONEW
- ABORT S VALMBCK="Q",DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR,CLEAN^PSOVER1,KV
- Q
- KV K DIRUT,DUOUT,DTOUT,DIR,PSOEDDOS
- Q
- REF ;
- ; Retrieving the Maximum Number of Refills allowed
- N MAXRF S MAXRF=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),+$G(PSONEW("DAYS SUPPLY")),+$G(PSONEW("PATIENT STATUS")),.CLOZPAT)
- I ($G(PSONEW("# OF REFILLS"))'="")&($G(PSONEW("# OF REFILLS"))'>MAXRF) D
- . S PSONEW("N# REF")=PSONEW("# OF REFILLS")
- E D
- . S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=MAXRF
- Q
- 1 I $P($G(OR0),"^",24) D Q
- . W !!,"Digitally Signed Order - Orderable Item cannot be changed",! D PZ
- N PSOBDR,PSOBDRG S PSOBDRG=1 D 1^PSOORNW2 Q ;oi
- ;
- 4 D INS^PSOORNW2 Q
- ;
- 3 I $G(LST)["3,",$P(OR0,"^",24) D Q
- . W !!,"Digitally Signed Order - Dose cannot be changed",! D PZ
- N PSOEDDOS S PSOEDDOS=1 D DOSE^PSOORED4(.PSONEW) Q
- ;
- 6 D 4^PSOORNW2 Q ;idt
- ;
- 7 D 5^PSOORNW2 S FDEDITED=1
- Q ;fdt
- ;
- 5 D 3^PSOORNW2 Q ;pstat
- ;
- 13 I $P($G(OR0),"^",24) D Q
- . W !!,"Digitally Signed Order - Provider cannot be changed",! D PZ
- D 12^PSOORNW2 Q ;doc
- ;
- 12 D 11^PSOORNW2 Q ;cli
- ;
- 2 N PSOCSIG I '$G(PSOBDRG) N PSOBDR,PSOBDRG S PSOBDRG=1,PSOQFLG=0
- N CPRN S CPRN=+$P($G(OR0),"^",24) D 2^PSOORNW1 Q:$G(PSOQFLG) D EN^PSODIAG ;drg/ICD
- I $G(PSOCSIG) K PSOCSIG G 3
- Q
- ;
- 9 D 8^PSOORNW2 Q ;qty
- ;
- 8 N CPRN S CPRN=+$P($G(OR0),"^",24) D 7^PSOORNW2 Q ;ds
- ;
- 10 I $P($G(OR0),"^",24) D Q
- . W !!,"Digitally Signed Order - Refills cannot be changed",! D PZ
- D 9^PSOORNW2 Q ;#rfs
- ;
- 14 D 13^PSOORNW2 Q ;cop
- ;
- 11 D 10^PSOORNW2 Q ;m/w
- ;
- 15 D 14^PSOORNW2 Q ;rem
- ;
- DRGMSG ;
- F SG=1:1:$L($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D
- .S:$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)
- K SG
- Q
- ;
- PZ ;
- N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
- Q
- ;
- NDF(DRGIEN) ;PATCH PSO*7*505/517 - 1:YES 0:NO checks the cs federal schedule field of the va product file
- N DEARES,VPROD
- S VPROD=$$GET1^DIQ(50,DRGIEN,22,"I") Q:'VPROD 0
- S DEARES=$$GET1^DIQ(50.68,VPROD,19,"I")
- I +$E(DEARES)>0 Q 1
- Q 0
- CSBLOCK(DFN,DIEN) ;
- N VAPA
- D ADD^VADPT
- I DIEN,$$CSDRG^PSOERUT6(DIEN)!($$NDF(DIEN)),($$UP^XLFSTR($P(VAPA(25),U,2))'="UNITED STATES") Q 0
- I DIEN,$$CSDRG^PSOERUT6(DIEN)!($$NDF(DIEN)),('$L(VAPA(6))),('$L(VAPA(11))) Q 1
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORNEW 16042 printed Feb 18, 2025@23:58:38 Page 2
- PSOORNEW ;BIR/SAB - display orders from oerr ;Dec 13, 2021@08:01:18
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,55,46,71,90,94,106,131,133,143,237,222,258,206,225,251,386,390,391,372,416,431,313,408,436,411,444,486,446,505,517,508,457,581,617,441,651,700,746,769**;DEC 1997;Build 26
- +2 ;External reference to ^PS(50.7 supported by DBIA 2223
- +3 ;External reference to ^PSDRUG supported by DBIA 221
- +4 ;External reference to ^PS(50.606 supported by DBIA 2174
- +5 ;External reference to ^PS(55 supported by DBIA 2228
- +6 ;External reference to EN1^ORCFLAG supported by DBIA 3620
- +7 ;
- +8 ;PSO*237 quit Finish if Today > Issue date + 365
- +9 ;
- DSPL IF $GET(PSODSPL)
- SET VALMBCK="Q"
- KILL PSODSPL,PSOANSQD
- QUIT
- +1 if '$DATA(PSOLMC)
- QUIT
- KILL ^TMP("PSOPO",$JOB)
- SET PSOLMC=PSOLMC+1
- +2 IF $DATA(CLOZPAT)
- SET PSONEW("DAYS SUPPLY")=$SELECT($GET(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),1:7)
- GOTO OI
- +3 SET PSONEW("DAYS SUPPLY")=$SELECT($GET(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$GET(^PS(55,PSODFN,"PS"))&($PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3))&('$GET(PSONEW("DAYS SUPPLY"))):$PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3
- ),1:30)
- OI IF '$GET(PSODRUG("OI"))
- Begin DoDot:1
- +1 NEW OI,OID
- SET (OI,PSODRUG("OI"))=$PIECE(OR0,"^",8)
- SET PSODRUG("OIN")=$PIECE(^PS(50.7,$PIECE(OR0,"^",8),0),"^")
- SET OID=$PIECE(OR0,"^",9)
- +2 IF $PIECE($GET(OR0),"^",9)
- SET POERR=1
- SET DREN=$PIECE(OR0,"^",9)
- DO DRG^PSOORDRG
- KILL POERR
- End DoDot:1
- +3 IF '$DATA(CLOZPAT)
- IF $GET(PSODRUG("DEA"))["A"
- IF $GET(PSODRUG("DEA"))'["B"!($GET(PSODRUG("DEA"))["F")
- SET PSONEW("# OF REFILLS")=0
- +4 IF $DATA(CLOZPAT)
- SET PSONEW("# OF REFILLS")=$SELECT($DATA(PSONEW("# OF REFILLS")):PSONEW("# OF REFILLS"),$GET(CLOZPAT)=2&($PIECE(OR0,"^",11)>2):3,$GET(CLOZPAT)&($PIECE(OR0,"^",11)>1):1,1:0)
- +5 SET IEN=0
- DO OBX^PSOORFI1
- DO DIN^PSONFI(PSODRUG("OI"),$SELECT($GET(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
- +6 ; Display Flag/Unflag Information
- DO LMDISP^PSOORFI5(+$GET(ORD))
- +7 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)="*(1) Orderable Item: "_$PIECE(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")_NFIO
- +8 if NFIO["<DIN>"
- SET NFIO=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
- +9 KILL LST
- IF $GET(PSODRUG("NAME"))]""
- Begin DoDot:1
- +10 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (2)"_$SELECT($DATA(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
- +11 if NFID["<DIN>"
- SET NFID=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
- +12 IF $PIECE($GET(^PSDRUG(PSODRUG("IEN"),0)),"^",10)]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Drug Message:"
- DO DRGMSG
- End DoDot:1
- GOTO PT
- +13 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (2) Drug: No Dispense Drug Selected"
- PT DO DOSE2^PSOORFI4
- +1 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (4) Pat Instruct:"
- if $ORDER(PSONEW("SIG",0))
- DO INST^PSOORFI4
- +2 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Provider Comments:"
- SET TY=3
- DO INST^PSOORFI1
- +3 ;*441-IND
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Indications: "_$GET(PSONEW("IND"))
- +4 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
- IF $GET(PSONEW("INDO"))]""
- Begin DoDot:1
- +5 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Other Indications: "_PSONEW("INDO")
- End DoDot:1
- +6 IF $$ERXIEN^PSOERXUT(ORD_"P")
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" eRx Drug: "_$$GET1^DIQ(52.49,$$ERXIEN^PSOERXUT(ORD_"P"),3.1)
- +7 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" "_$SELECT($$ERXIEN^PSOERXUT(ORD_"P"):"eRx",1:" ")_" Instructions: "
- SET TY=2
- DO INST^PSOORFI1
- +8 KILL PSOELSE
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" SIG:"
- +9 FOR I=0:0
- SET I=$ORDER(SIG(I))
- if 'I
- QUIT
- SET SIG=SIG(I)
- Begin DoDot:1
- +10 FOR SG=1:1:$LENGTH(SIG)
- if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(SIG," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "
- if $PIECE(SIG," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(SIG," ",SG)
- End DoDot:1
- +11 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (5) Patient Status: "_$PIECE($GET(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^")
- +12 KILL PSOELSE
- IF $GET(PSONEW("ISSUE DATE"))']""
- SET PSOELSE=1
- SET IEN=IEN+1
- SET (PSOID,Y)=$EXTRACT($PIECE(OR0,"^",6),1,7)
- XECUTE ^DD("DD")
- SET PSONEW("ISSUE DATE")=Y
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (4) Issue Date: "_Y
- +13 IF '$GET(PSOELSE)
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE")
- +14 KILL PSOELSE
- IF $GET(PSORX("FILL DATE"))']""
- SET PSOELSE=1
- Begin DoDot:1
- +15 SET (Y,PSORX("FILL DATE"))=$SELECT($EXTRACT($PIECE(OR0,"^",6),1,7)<DT:DT,1:$EXTRACT($PIECE(OR0,"^",6),1,7))
- XECUTE ^DD("DD")
- SET PSONEW("FILL DATE")=Y
- SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (5) Fill Date: "_Y
- End DoDot:1
- +16 IF '$GET(PSOELSE)
- SET Y=PSORX("FILL DATE")
- XECUTE ^DD("DD")
- SET PSORX("FILL DATE")=Y
- SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (7) Fill Date: "_PSORX("FILL DATE")
- +17 IF $PIECE(OR0,"^",18)
- SET IEN=IEN+1
- SET Y=$PIECE(OR0,"^",18)
- XECUTE ^DD("DD")
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",39)="Effective Date: "_Y
- +18 IF $DATA(CLOZPAT)
- DO ELIG^PSOORFI2
- if '$DATA(PSONEW("QTY"))
- SET PSONEW("QTY")=0
- +19 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (8) Days Supply: "_PSONEW("DAYS SUPPLY")
- +20 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (9) QTY"_$SELECT($PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),660)),"^",8)]"":" ("_$PIECE($GET(^PSDRUG(+PSODRUG("IEN"),660)),"^",8)_")",1:" ( )")
- +21 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_": "_$SELECT($GET(PSONEW("QTY"))]"":PSONEW("QTY"),1:$PIECE(OR0,"^",10))
- +22 IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),5)),"^")]""
- Begin DoDot:1
- +23 SET $PIECE(RN," ",79)=" "
- SET IEN=IEN+1
- +24 SET ^TMP("PSOPO",$JOB,IEN,0)=$EXTRACT(RN,$LENGTH("QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^")
- KILL RN
- End DoDot:1
- +25 SET IEN=IEN+1
- +26 IF $PIECE(OR0,"^",24)
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Provider ordered: days supply "_+$PIECE(OR0,"^",22)_", quantity "_+$PIECE(OR0,"^",10)_" & refills "_+$PIECE(OR0,"^",11)
- +27 IF '$TEST
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Provider ordered "_+$PIECE(OR0,"^",11)_" refills"
- +28 if $DATA(CLOZPAT)
- DO PQTY^PSOORFI4
- +29 ;PAPI 441
- NEW PSOMWP
- SET PSOMWP=$GET(PSONEW("MAIL/WINDOW"))
- +30 ;PAPI 441
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)="(10) # of Refills: "_$SELECT($GET(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),1:$PIECE(OR0,"^",11))_" (11) Routing: "_$SELECT(PSOMWP="M":"MAIL",PSOMWP="P":"PARK",1:"WINDOW")
- +31 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)="(12) Clinic: "_PSORX("CLINIC")
- +32 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME")
- +33 if $PIECE(OR0,"^",24)!((+$GET(PSODRUG("DEA"))>1)&(+$GET(PSODRUG("DEA"))<6))
- DO PRV^PSOORFI5($GET(PSONEW("PROVIDER")),$GET(PSODRUG("IEN")),$PIECE(OR0,"^"))
- +34 IF $PIECE($GET(^VA(200,$SELECT($GET(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$PIECE(OR0,"^",5)),"PS")),"^",7)&($PIECE($GET(^("PS")),"^",8))
- Begin DoDot:1
- +35 SET IEN=IEN+1
- SET PSONEW("COSIGNING PROVIDER")=$SELECT($GET(PSONEW("COSIGNING PROVIDER")):PSONEW("COSIGNING PROVIDER"),1:$PIECE(^("PS"),"^",8))
- +36 SET ^TMP("PSOPO",$JOB,IEN,0)=" Cos-Provider: "_$PIECE(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
- End DoDot:1
- +37 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)="(14) Copies: "_$SELECT($GET(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
- +38 SET PSONEW("REMARKS")=$SELECT($GET(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),$PIECE(OR0,"^",17)="C":"Administered in Clinic.",1:"")
- +39 KILL PSONEW("ADMINCLINIC")
- if $PIECE(OR0,"^",17)="C"
- SET PSONEW("ADMINCLINIC")=1
- +40 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)="(15) Remarks:"
- +41 IF $GET(PSONEW("REMARKS"))]""
- Begin DoDot:1
- +42 FOR SG=1:1:$LENGTH(PSONEW("REMARKS"))
- if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(PSONEW("REMARKS")," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "
- Begin DoDot:2
- +43 if $PIECE(PSONEW("REMARKS")," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(PSONEW("REMARKS")," ",SG)
- End DoDot:2
- End DoDot:1
- +44 IF $GET(PSOSIGFL)!(PSODRUG("OI")'=$PIECE(OR0,"^",8))
- SET PSONEW("CLERK CODE")=DUZ
- SET PSORX("CLERK CODE")=$PIECE(^VA(200,DUZ,0),"^")
- SET VALMSG="This change will create a new prescription!"
- +45 SET $PIECE(RN," ",35)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_$PIECE(^VA(200,PSONEW("CLERK CODE"),0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,PSONEW("CLERK CODE"),0),"^"))+1,35)
- +46 SET Y=$PIECE(OR0,"^",12)
- XECUTE ^DD("DD")
- SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"Entry Date: "_$EXTRACT($PIECE(OR0,"^",12),4,5)_"/"_$EXTRACT($PIECE(OR0,"^",12),6,7)_"/"_$EXTRACT($PIECE(OR0,"^",12),2,3)_" "_$PIECE(Y,"@",2)
- KILL RN
- +47 ; eRx Pending Order (Side-By-Side) Interface (Replaces conventional interface above)
- +48 SET ERXIEN=$$ERXIEN^PSOERXUT($GET(ORD)_"P")
- +49 IF ERXIEN
- Begin DoDot:1
- +50 NEW SUGFLDT,LASTRX,Y
- +51 IF $DATA(VALMEVL)
- FOR I=1:1:99
- DO RESTORE^VALM10(I)
- +52 SET SUGFLDT=$$SUGFLDT^PSOERUT(ORD)
- SET LASTRX=0
- +53 IF $DATA(^XUSEC("PSO ERX P746 TEMP KEY",DUZ))
- IF '$GET(FDEDITED)
- IF SUGFLDT>DT
- Begin DoDot:2
- +54 SET (PSONEW("FILL DATE"),Y)=$PIECE(SUGFLDT,"^")
- SET LASTRX=+$PIECE(SUGFLDT,"^",2)
- XECUTE ^DD("DD")
- SET PSORX("FILL DATE")=Y
- End DoDot:2
- +55 SET (IEN,LINE)=0
- KILL ^TMP("PSOPO",$JOB)
- +56 DO SETPEN^PSOERUT5("PSOPO",ERXIEN,+ORD,.PSONEW,.PSODRUG,.SIG,0,LASTRX)
- SET (VALMCNT,IEN)=LINE-1
- +57 DO RV^PSONFI
- End DoDot:1
- +58 IF PSOLMC<2
- DO ^PSOLMPO1
- SET VALMBCK="Q"
- SET PSOLMC=0
- +59 if PSOLMC>1
- SET VALMBCK="R"
- +60 QUIT
- ORCHK DO PROVCOM^PSOORFI4
- DO IND^PSOORFI4
- DO ORCHK^PSOORFI4
- +1 QUIT
- EDT ; Entry point for ED Action in the OP Pending Queue
- +1 DO KV
- +2 SET DIR("A",1)="* Indicates which fields will create an new Order"
- +3 SET DIR("A")="Select Field to Edit by number"
- SET DIR(0)="LO^1:15"
- +4 DO ^DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- QUIT
- +5 ;
- EDTSEL ; Entry point for individual field editing
- +1 KILL PSOVLMBG
- IF $$ERXIEN^PSOERXUT(ORD_"P")
- SET PSOVLMBG=VALMBG
- +2 ; Only 'Routing' Field can be edited for CS eRx Pending Orders
- +3 ; Not allowed to edit CS eRx orders
- IF +$GET(Y)'=11
- IF $$CSERX^PSOERUT6(ORD)
- QUIT
- +4 NEW LST,FLD,OUT,CHECK,CSDRG
- DO KV
- SET (OUT,CSDRG)=0
- +5 IF '$DATA(PSODRG)
- SET PSODRG=$GET(PSODRUG("IEN"))
- +6 IF PSODRG
- IF $$NDF(PSODRG)!($$CSDRG^PSOERUT6(PSODRG))
- SET CSDRG=1
- +7 IF +Y
- SET LST=Y
- DO FULL^VALM1
- NEW PSODOSE
- MERGE PSODOSE=PSONEW
- Begin DoDot:1
- +8 IF CSDRG
- IF (","_LST[",1,")!(","_LST[",3,")!(","_LST[",10,")!(","_LST[",13,")
- Begin DoDot:2
- +9 WRITE !!,"The selection includes field(s) that are not editable"
- +10 WRITE !,"for controlled substances. These field(s) will be skipped.",!
- +11 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:2
- +12 FOR FLD=1:1:$LENGTH(LST,",")
- if $PIECE(LST,",",FLD)']""!(OUT)
- QUIT
- Begin DoDot:2
- +13 SET CHECK=","_+$PIECE(LST,",",FLD)_","
- IF CSDRG
- IF ",1,3,10,13,"[CHECK
- QUIT
- +14 DO @(+$PIECE(LST,",",FLD))
- if $PIECE(LST,",",FLD)=8
- DO REF
- DO KV
- End DoDot:2
- End DoDot:1
- GOTO DSPL
- +15 IF '$TEST
- SET VALMBCK=""
- QUIT
- ACP ;
- +1 DO FULL^VALM1
- +2 NEW PSOORNEW,DIR,Y
- SET Y=0
- SET PSOORNEW=1
- +3 IF $GET(ORD)
- IF +$PIECE($GET(^PS(52.41,+ORD,0)),"^",23)=1
- Begin DoDot:1
- +4 IF '$DATA(^XUSEC("PSORPH",DUZ))
- Begin DoDot:2
- +5 SET DIR("A",1)="Order must be unflagged by a pharmacist before it can be finished."
- +6 SET DIR("A",2)=""
- +7 SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to continue"
- WRITE !,$CHAR(7)
- DO ^DIR
- +8 SET VALMBCK="R"
- End DoDot:2
- SET Y=0
- QUIT
- +9 DO KV
- +10 SET DIR("A",1)="This Order is flagged. In order to finish it"
- +11 SET DIR("A",2)="you must unflag it first."
- +12 SET DIR("A",3)=""
- +13 SET DIR(0)="Y"
- SET DIR("A")="Unflag Order"
- SET DIR("B")="NO"
- +14 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)!'Y
- SET VALMBCK="Q"
- End DoDot:1
- if $DATA(DIRUT)!'Y
- QUIT
- DO EN1^ORCFLAG(+$PIECE($GET(^PS(52.41,ORD,0)),"^"))
- HANG 1
- +15 IF $GET(ORD)
- IF +$PIECE($GET(^PS(52.41,+ORD,0)),"^",23)=1
- QUIT
- +16 ;
- +17 ;/MZR edited next line in case QTY not defined *457
- +18 IF $DATA(CLOZPAT)
- IF +$GET(PSONEW("QTY"))=0
- SET PSONEW("QTY")=$PIECE(OR0,"^",10)
- +19 SET (PSODIR("DFLG"),PSORX("DFLG"),PSODIR("QFLD"))=0
- SET ACP=1
- DO ORCHK
- +20 if $GET(PSONEW("QFLG"))
- GOTO DSPL
- +21 IF $GET(PSODIR("DFLG"))!$GET(PSORX("DFLG"))
- QUIT
- +22 IF $GET(PSONEW("FLD"))!($GET(PSODRUG("NAME"))']"")!('$ORDER(SIG(0)))
- GOTO DSPL
- +23 ;PATCH PSO*7*517 - Blocking action FN if issuing a controlled substance to a patient without a zipcode
- +24 SET DRGIEN=$GET(PSODRUG("IEN"))
- +25 IF $$CSBLOCK(PSODFN,DRGIEN)
- Begin DoDot:1
- +26 WRITE !,"Controlled substance prescriptions require a patient address. Please update"
- +27 WRITE !,"patient address information. This action will also invalidate a digitally"
- +28 WRITE !,"signed prescription and require the provider to re-enter the order."
- End DoDot:1
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- KILL Y
- QUIT
- +29 ;PSO*7*517 - END
- +30 ; *457 fixed wrong flow D CLEAN^PSOVER1 G DSPL
- IF $GET(PSODRUG("NAME"))]""
- IF '$GET(ORCHK)!($GET(ORDRG)'=PSODRUG("NAME"))
- Begin DoDot:1
- +31 DO POST^PSODRG
- if '$GET(PSORX("DFLG"))
- SET ORCHK=1
- SET ORDRG=PSODRUG("NAME")
- End DoDot:1
- IF $GET(PSORX("DFLG"))
- QUIT
- +32 if '$GET(PSORX("DFLG"))
- DO DOSCK^PSODOSUT("N")
- IF $GET(PSORX("DFLG"))
- GOTO DSPL
- +33 IF '$DATA(PSONEW("RX #"))
- SET PSOFROM="NEW"
- SET RTN=$SELECT($PIECE($GET(PSOPAR),"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN")
- DO @RTN
- if PSONEW("QFLG")
- QUIT
- IF '$PIECE($GET(PSOPAR),"^",7)
- SET PSOX=PSONEW("RX #")
- DO CHECK^PSONRXN
- +34 DO RXNCHK^PSOORNE1
- IF $GET(PSONEW("QFLG"))
- SET PSONEW("DFLG")=1
- QUIT
- +35 IF DT>$$FMADD^XLFDT($PIECE(OR0,"^",6),365)
- DO EXPR^PSONEW2
- GOTO DSPL
- +36 DO STOP^PSONEW2
- DO DISPLAY^PSONEW2
- DO ^PSONEWF
- +37 IF $GET(PSOCPZ("DFLG"))
- WRITE !!,"No action taken!",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- DO KV
- KILL PSOCPZ("DFLG"),DRET,PSOANSQD
- SET VALMBCK="Q"
- QUIT
- +38 ;
- +39 KILL PSOCPZ("DFLG")
- DO KV
- SET DIR(0)="Y"
- SET DIR("A")="Are you sure you want to Accept this Order"
- SET DIR("B")="NO"
- DO ^DIR
- IF $DATA(DIRUT)
- DO KV
- KILL DRET,PSOANSQ,PSOANSQD
- SET VALMBCK="Q"
- QUIT
- +40 DO KV
- IF 'Y
- KILL PSOANSQ
- GOTO DSPL
- +41 IF $GET(PSONEW("MAIL/WINDOW"))["W"
- if $PIECE($GET(PSOPAR),"^",12)
- Begin DoDot:1
- +42 WRITE !
- KILL DIR,DIRUT
- SET DIR(0)="52,35O"
- +43 if $GET(PSORX("METHOD OF PICK-UP"))]""
- SET DIR("B")=PSORX("METHOD OF PICK-UP")
- DO ^DIR
- IF $DATA(DIRUT)
- KILL DIR,DIRUT
- QUIT
- +44 SET (PSONEW("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y
- KILL X,Y
- End DoDot:1
- SET BINGCRT="Y"
- SET BINGRTE="W"
- SET PSORX("MAIL/WINDOW")="WINDOW"
- KILL RTN
- +45 SET PSONEW("POE")=1
- KILL PSORX("DFLG"),PSONEW("DFLG")
- DO EN^PSON52(.PSONEW)
- if $GET(PSONEW("DFLG"))
- GOTO ABORT
- DO DCORD^PSONEW2
- if $GET(PKI)=89802020
- DO ALERT^PSOPKIV1
- +46 ; - Possible Titration Rx?
- +47 IF $GET(PSONEW("IRXN"))
- DO MARK^PSOOTMRX(PSONEW("IRXN"),0)
- +48 ;saves drug allergy order chks pso*7*390
- +49 IF $DATA(^TMP("PSODAOC",$JOB))
- Begin DoDot:1
- +50 IF $GET(PSORX("DFLG"))
- KILL ^TMP("PSODAOC",$JOB)
- QUIT
- +51 SET RXN=PSONEW("IRXN")
- SET PSODAOC="Finished CPRS Rx "_$SELECT($PIECE(^PSRX(RXN,"STA"),"^")=4:"NON-VERIFIED ",1:"")_"Order Acceptance_OP"
- +52 DO DAOC^PSONEW
- End DoDot:1
- +53 DO NPSOSD^PSOUTIL(.PSONEW)
- DO FULL^VALM1
- KILL PSORX("MAIL/WINDOW")
- +54 ; PSO*7*508 - link the erx to the outpatient prescription
- +55 ; PSO*7*581 - if this is a renewal response replace message, update the request and the response values to RRC.
- +56 NEW ERXIEN,EMTYPE,ERXREQ,RESTYPE
- +57 SET ERXIEN=$$CHKERX^PSOERXU1(OR0)
- IF ERXIEN
- Begin DoDot:1
- +58 SET ERXFDA(52.49,ERXIEN_",",.13)=PSONEW("IRXN")
- DO FILE^DIE(,"ERXFDA")
- KILL ERXFDA
- +59 SET EMTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- IF EMTYPE'="RE"
- IF EMTYPE'="CX"
- QUIT
- +60 SET RESTYPE=$$GET1^DIQ(52.49,ERXIEN,52.1,"I")
- IF RESTYPE'="R"
- IF EMTYPE'="CX"
- QUIT
- +61 SET ERXREQ=$$GETREQ^PSOERXU2(ERXIEN)
- +62 IF EMTYPE="RE"
- DO UPDSTAT^PSOERXU1(ERXIEN,"RXC")
- DO UPDSTAT^PSOERXU1(ERXREQ,"RRC")
- +63 IF EMTYPE="CX"
- DO UPDSTAT^PSOERXU1(ERXIEN,"CXC")
- DO UPDSTAT^PSOERXU1(ERXREQ,"CRC")
- End DoDot:1
- +64 ; PSO*7*508 - end eRx enhancement
- +65 DO EOJ^PSONEW
- ABORT SET VALMBCK="Q"
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- DO CLEAN^PSOVER1
- DO KV
- +1 QUIT
- KV KILL DIRUT,DUOUT,DTOUT,DIR,PSOEDDOS
- +1 QUIT
- REF ;
- +1 ; Retrieving the Maximum Number of Refills allowed
- +2 NEW MAXRF
- SET MAXRF=$$MAXNUMRF^PSOUTIL(+$GET(PSODRUG("IEN")),+$GET(PSONEW("DAYS SUPPLY")),+$GET(PSONEW("PATIENT STATUS")),.CLOZPAT)
- +3 IF ($GET(PSONEW("# OF REFILLS"))'="")&($GET(PSONEW("# OF REFILLS"))'>MAXRF)
- Begin DoDot:1
- +4 SET PSONEW("N# REF")=PSONEW("# OF REFILLS")
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 SET (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=MAXRF
- End DoDot:1
- +7 QUIT
- 1 IF $PIECE($GET(OR0),"^",24)
- Begin DoDot:1
- +1 WRITE !!,"Digitally Signed Order - Orderable Item cannot be changed",!
- DO PZ
- End DoDot:1
- QUIT
- +2 ;oi
- NEW PSOBDR,PSOBDRG
- SET PSOBDRG=1
- DO 1^PSOORNW2
- QUIT
- +3 ;
- 4 DO INS^PSOORNW2
- QUIT
- +1 ;
- 3 IF $GET(LST)["3,"
- IF $PIECE(OR0,"^",24)
- Begin DoDot:1
- +1 WRITE !!,"Digitally Signed Order - Dose cannot be changed",!
- DO PZ
- End DoDot:1
- QUIT
- +2 NEW PSOEDDOS
- SET PSOEDDOS=1
- DO DOSE^PSOORED4(.PSONEW)
- QUIT
- +3 ;
- 6 ;idt
- DO 4^PSOORNW2
- QUIT
- +1 ;
- 7 DO 5^PSOORNW2
- SET FDEDITED=1
- +1 ;fdt
- QUIT
- +2 ;
- 5 ;pstat
- DO 3^PSOORNW2
- QUIT
- +1 ;
- 13 IF $PIECE($GET(OR0),"^",24)
- Begin DoDot:1
- +1 WRITE !!,"Digitally Signed Order - Provider cannot be changed",!
- DO PZ
- End DoDot:1
- QUIT
- +2 ;doc
- DO 12^PSOORNW2
- QUIT
- +3 ;
- 12 ;cli
- DO 11^PSOORNW2
- QUIT
- +1 ;
- 2 NEW PSOCSIG
- IF '$GET(PSOBDRG)
- NEW PSOBDR,PSOBDRG
- SET PSOBDRG=1
- SET PSOQFLG=0
- +1 ;drg/ICD
- NEW CPRN
- SET CPRN=+$PIECE($GET(OR0),"^",24)
- DO 2^PSOORNW1
- if $GET(PSOQFLG)
- QUIT
- DO EN^PSODIAG
- +2 IF $GET(PSOCSIG)
- KILL PSOCSIG
- GOTO 3
- +3 QUIT
- +4 ;
- 9 ;qty
- DO 8^PSOORNW2
- QUIT
- +1 ;
- 8 ;ds
- NEW CPRN
- SET CPRN=+$PIECE($GET(OR0),"^",24)
- DO 7^PSOORNW2
- QUIT
- +1 ;
- 10 IF $PIECE($GET(OR0),"^",24)
- Begin DoDot:1
- +1 WRITE !!,"Digitally Signed Order - Refills cannot be changed",!
- DO PZ
- End DoDot:1
- QUIT
- +2 ;#rfs
- DO 9^PSOORNW2
- QUIT
- +3 ;
- 14 ;cop
- DO 13^PSOORNW2
- QUIT
- +1 ;
- 11 ;m/w
- DO 10^PSOORNW2
- QUIT
- +1 ;
- 15 ;rem
- DO 14^PSOORNW2
- QUIT
- +1 ;
- DRGMSG ;
- +1 FOR SG=1:1:$LENGTH($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10))
- if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "
- Begin DoDot:1
- +2 if $PIECE($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)
- End DoDot:1
- +3 KILL SG
- +4 QUIT
- +5 ;
- PZ ;
- +1 NEW DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- WRITE !
- +2 QUIT
- +3 ;
- NDF(DRGIEN) ;PATCH PSO*7*505/517 - 1:YES 0:NO checks the cs federal schedule field of the va product file
- +1 NEW DEARES,VPROD
- +2 SET VPROD=$$GET1^DIQ(50,DRGIEN,22,"I")
- if 'VPROD
- QUIT 0
- +3 SET DEARES=$$GET1^DIQ(50.68,VPROD,19,"I")
- +4 IF +$EXTRACT(DEARES)>0
- QUIT 1
- +5 QUIT 0
- CSBLOCK(DFN,DIEN) ;
- +1 NEW VAPA
- +2 DO ADD^VADPT
- +3 IF DIEN
- IF $$CSDRG^PSOERUT6(DIEN)!($$NDF(DIEN))
- IF ($$UP^XLFSTR($PIECE(VAPA(25),U,2))'="UNITED STATES")
- QUIT 0
- +4 IF DIEN
- IF $$CSDRG^PSOERUT6(DIEN)!($$NDF(DIEN))
- IF ('$LENGTH(VAPA(6)))
- IF ('$LENGTH(VAPA(11)))
- QUIT 1
- +5 QUIT 0