- PSOCPPRE ;BIR/SAB - enhanced dup drug checker for copy orders ;09/21/06 11:34am
- ;;7.0;OUTPATIENT PHARMACY;**251,375,387**;DEC 1997;Build 13
- ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- ;External references to ^ORRDI1 controlled subscription supported by DBIA 4659
- ;External references to ^XTMP("ORRDI" supported by DBIA 4660
- ;External references to ^PSSHRQ2 supported by DBIA 5369
- S LIST="PSOPEP",$P(PSONULN,"-",79)="-",(STA,DNM)="" N PSODLQT
- F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM="" D Q:$G(PSORX("DFLG"))
- .I STA="PENDING" D ^PSODDPR1 Q
- .I STA="ZNONVA" D NVA^PSODDPR1 Q
- .D:PSODRUG("NAME")=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) Q:$G(PSORX("DFLG"))
- ..I $P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG"))
- ..I $P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG"))
- ..I '$P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG"))
- .D:PSODRUG("NAME")=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP^PSODDPRE
- Q:$G(PSORX("DFLG"))
- D HD^PSODDPR2():(($Y+5)'>IOSL)
- D REMOTE
- Q
- OBX S LIST="PSOPEPS"
- K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),PSODLQT,DTOUT,DUOUT,DIRUT,PSODOSD
- K HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT
- K DIR I $P(^TMP($J,LIST,"OUT",0),"^")=-1 G EXIT
- K ^TMP($J,LIST,"IN","PING"),^TMP($J,LIST,"OUT","DRUGDRUG"),^TMP($J,LIST,"OUT","THERAPY")
- W !,"Now Processing Enhanced Order Checks! Please wait...",! H 2
- D FDB^PSODDPRE S PDRG=PSODRUG("IEN"),DO=0 D REMOTE^PSODDPR4
- D IN^PSSHRQ2(LIST) ;if patient has meds
- ;
- K DIR
- I $P(^TMP($J,LIST,"OUT",0),"^")=-1 D DATACK^PSODDPRE G EXIT
- D ^PSODDPR2 ;if order checks returned
- ;
- EXIT ;
- I $G(PSODLQT)!$G(PSORX("DFLG")) S PSODOSD=1
- D ^PSOBUILD K CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
- K ^TMP($J,LIST,"IN","PING"),^TMP($J,LIST,"OUT","DRUGDRUG"),^TMP($J,LIST,"OUT","THERAPY"),^TMP($J,"PSOPEPS"),^TMP($J,"PSORDI")
- K DO,LIST,DNM,PSONULN,PSORX("DFLG"),RXRECCOP,STA,Y,PSODLQT
- K HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT
- S VALMBCK="R"
- Q
- ULRX ;
- I '$G(RXRECCOP) Q
- D PSOUL^PSSLOCK(RXRECCOP)
- Q
- ;
- REMOTE ;
- I $T(HAVEHDR^ORRDI1)']"" Q
- I '$$HAVEHDR^ORRDI1 Q
- I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) G REMOTE2
- D HD^PSODDPR2():(($Y+5)'>IOSL)
- W !!,"Now doing remote order checks. Please wait...",!
- D REMOTE^PSOORRDI(PSODFN,PSODRUG("IEN"))
- D HD^PSODDPR2():(($Y+5)'>IOSL)
- I '$D(^XUSEC("PSORPH",DUZ)),$P(PSOPAR,"^",2),$G(PSOTECCK) G REMOTE2
- I $D(^TMP($J,"DD")) D DUP^PSOORRD2
- REMOTE2 ;
- K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCPPRE 2691 printed Mar 13, 2025@21:30:55 Page 2
- PSOCPPRE ;BIR/SAB - enhanced dup drug checker for copy orders ;09/21/06 11:34am
- +1 ;;7.0;OUTPATIENT PHARMACY;**251,375,387**;DEC 1997;Build 13
- +2 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- +3 ;External references to ^ORRDI1 controlled subscription supported by DBIA 4659
- +4 ;External references to ^XTMP("ORRDI" supported by DBIA 4660
- +5 ;External references to ^PSSHRQ2 supported by DBIA 5369
- +6 SET LIST="PSOPEP"
- SET $PIECE(PSONULN,"-",79)="-"
- SET (STA,DNM)=""
- NEW PSODLQT
- +7 FOR
- SET STA=$ORDER(PSOSD(STA))
- if STA=""
- QUIT
- FOR
- SET DNM=$ORDER(PSOSD(STA,DNM))
- if DNM=""
- QUIT
- Begin DoDot:1
- +8 IF STA="PENDING"
- DO ^PSODDPR1
- QUIT
- +9 IF STA="ZNONVA"
- DO NVA^PSODDPR1
- QUIT
- +10 if PSODRUG("NAME")=$PIECE(DNM,"^")&('$DATA(^XUSEC("PSORPH",DUZ)))
- Begin DoDot:2
- +11 IF $PIECE($GET(PSOPAR),"^",16)
- DO DUP^PSODDPRE
- if $GET(PSORX("DFLG"))
- QUIT
- +12 IF $PIECE(PSOPAR,"^",2)
- IF '$PIECE($GET(PSOPAR),"^",16)
- DO DUP^PSODDPRE
- if $GET(PSORX("DFLG"))
- QUIT
- +13 IF '$PIECE(PSOPAR,"^",2)
- IF '$PIECE($GET(PSOPAR),"^",16)
- DO DUP^PSODDPRE
- if $GET(PSORX("DFLG"))
- QUIT
- End DoDot:2
- if $GET(PSORX("DFLG"))
- QUIT
- +14 if PSODRUG("NAME")=$PIECE(DNM,"^")&($DATA(^XUSEC("PSORPH",DUZ)))
- DO DUP^PSODDPRE
- End DoDot:1
- if $GET(PSORX("DFLG"))
- QUIT
- +15 if $GET(PSORX("DFLG"))
- QUIT
- +16 if (($Y+5)'>IOSL)
- DO HD^PSODDPR2()
- +17 DO REMOTE
- +18 QUIT
- OBX SET LIST="PSOPEPS"
- +1 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI"),PSODLQT,DTOUT,DUOUT,DIRUT,PSODOSD
- +2 KILL HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT
- +3 KILL DIR
- IF $PIECE(^TMP($JOB,LIST,"OUT",0),"^")=-1
- GOTO EXIT
- +4 KILL ^TMP($JOB,LIST,"IN","PING"),^TMP($JOB,LIST,"OUT","DRUGDRUG"),^TMP($JOB,LIST,"OUT","THERAPY")
- +5 WRITE !,"Now Processing Enhanced Order Checks! Please wait...",!
- HANG 2
- +6 DO FDB^PSODDPRE
- SET PDRG=PSODRUG("IEN")
- SET DO=0
- DO REMOTE^PSODDPR4
- +7 ;if patient has meds
- DO IN^PSSHRQ2(LIST)
- +8 ;
- +9 KILL DIR
- +10 IF $PIECE(^TMP($JOB,LIST,"OUT",0),"^")=-1
- DO DATACK^PSODDPRE
- GOTO EXIT
- +11 ;if order checks returned
- DO ^PSODDPR2
- +12 ;
- EXIT ;
- +1 IF $GET(PSODLQT)!$GET(PSORX("DFLG"))
- SET PSODOSD=1
- +2 DO ^PSOBUILD
- KILL CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
- +3 KILL ^TMP($JOB,LIST,"IN","PING"),^TMP($JOB,LIST,"OUT","DRUGDRUG"),^TMP($JOB,LIST,"OUT","THERAPY"),^TMP($JOB,"PSOPEPS"),^TMP($JOB,"PSORDI")
- +4 KILL DO,LIST,DNM,PSONULN,PSORX("DFLG"),RXRECCOP,STA,Y,PSODLQT
- +5 KILL HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT
- +6 SET VALMBCK="R"
- +7 QUIT
- ULRX ;
- +1 IF '$GET(RXRECCOP)
- QUIT
- +2 DO PSOUL^PSSLOCK(RXRECCOP)
- +3 QUIT
- +4 ;
- REMOTE ;
- +1 IF $TEXT(HAVEHDR^ORRDI1)']""
- QUIT
- +2 IF '$$HAVEHDR^ORRDI1
- QUIT
- +3 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
- GOTO REMOTE2
- +4 if (($Y+5)'>IOSL)
- DO HD^PSODDPR2()
- +5 WRITE !!,"Now doing remote order checks. Please wait...",!
- +6 DO REMOTE^PSOORRDI(PSODFN,PSODRUG("IEN"))
- +7 if (($Y+5)'>IOSL)
- DO HD^PSODDPR2()
- +8 IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF $PIECE(PSOPAR,"^",2)
- IF $GET(PSOTECCK)
- GOTO REMOTE2
- +9 IF $DATA(^TMP($JOB,"DD"))
- DO DUP^PSOORRD2
- REMOTE2 ;
- +1 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI")
- +2 QUIT
