- PSODRDU2 ;BHAM ISC/SAB - dup drug/class display for outpatient orders ;08/23/17 19:54
- ;;7.0;OUTPATIENT PHARMACY;**132,251,375,387,441,768**;DEC 1997;Build 12
- ;External reference ^PS(50.7 - 2223
- ;External reference ^PS(50.606 - 2174
- ;External reference ^PSDRUG( - 221
- ;External reference to ^PS(55 - 2228
- EN(PSODFN,ORN,LIST) ;psodfn=patient's ifn, orn=ordertype;order#;drugtype;counter
- N DUPRXO,I,ISSD,J,BSIG,RFLS,RXREC,ST,PSONULN,LSTFL
- S $P(PSONULN,"-",79)="-"
- I $P(ORN,";")="O" G RX
- I $P(ORN,";")="P" G PND
- I $P(ORN,";")="N" G NVA
- I $P(ORN,";")="R" G RDI
- Q
- RX ;Rx info
- Q:'$D(^PSRX($P(ORN,";",2),0)) N ISSD,LSTFLD S RXREC=$P(ORN,";",2)
- S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),ISSD=$E(ISSD,4,5)_"/"_$E(ISSD,6,7)_"/"_$E(ISSD,2,3)
- S LSTFL=(+^PSRX(RXREC,3)),LSTFL=$E(LSTFL,4,5)_"/"_$E(LSTFL,6,7)_"/"_$E(LSTFL,2,3),RX0=DUPRX0,RX2=^PSRX(RXREC,2)
- S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^DONE^EXPIRED^DISCONTINUED^DELETED^DISCONTINUED BY PROVIDER^DISCONTINUED (EDIT)^HELD BY PROVIDER"
- S ST=$P(STA,"^",(+$P(^PSRX(RXREC,"STA"),"^")+1)) D K STA ;441 PAPI
- . I ST="ACTIVE",$G(^PSRX(RXREC,"PARK")) S ST="PARKED"
- W !,"Local Rx #"_$P(DUPRX0,"^")_" ("_ST_") for "_$P(^PSDRUG($P(DUPRX0,"^",6),0),"^")
- K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,60) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV)
- K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,60)
- W !,"SIG: "_$G(BSIG(1)) I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?20,$G(BSIG(PSREV))
- D PRSTAT(RXREC) W !
- Q
- PND ;op pending orders
- Q:'$D(^PS(52.41,$P(ORN,";",2),0))
- N DUPRX0,FSIG
- S DUPRX0=^PS(52.41,$P(ORN,";",2),0)
- W !,"Pending Outpatient Drug for "_$S('$P(DUPRX0,"^",9):$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"))
- D FSIG^PSOUTLA("P",$P(ORN,";",2),IOM-6)
- W !,"SIG: " F I=0:0 S I=$O(FSIG(I)) Q:'I W FSIG(I),!?5
- Q
- NVA ;non-va meds
- Q:'$D(^PS(55,PSODFN,"NVA",$P(ORN,";",2),0))
- S DUPRX0=^PS(55,PSODFN,"NVA",$P(ORN,";",2),0)
- W !,"NON-VA Med: "_$S('$P(DUPRX0,"^",2):$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:$P(^PSDRUG($P(DUPRX0,"^",2),0),"^")) ;_" (ACTIVE)"
- W !,"Dosage: "_$P(DUPRX0,"^",3),?25,"Schedule: "_$P(DUPRX0,"^",5)
- W !
- ;W !?3,"Date Documented: "_$E($P(DUPRX0,"^",10),4,5)_"/"_$E($P(DUPRX0,"^",10),6,7)_"/"_$E($P(DUPRX0,"^",10),2,3),?30,"Status: Active",!
- K DUPRX0
- Q
- RDI ;RDI orders
- Q:'$D(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2)))
- S RXREC=^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2))
- W !,"LOCATION: "_$P(RXREC,"^")
- W !,"Remote Rx #"_$P(RXREC,"^",5)_" ("_$P(RXREC,"^",4)_") for "_$P(RXREC,"^",3)
- W !,"SIG: " S I="" F S I=$O(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I)) Q:I="" D
- .W ^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I),!
- .I $O(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I))'="" W ?5
- W "Last Filled On: "_$P(RXREC,"^",6),!
- K RXREC,I
- Q
- PRSTAT(DA) ;Displays the prescription's status
- N PSOTRANS,PSOREL,PSOCMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS,CMOP,PSOMW,PSORFL
- D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) S RXPSTA="Processing Status: ",PSOLRD=$P($G(^PSRX(RXREC,2)),"^",13)
- D ^PSOCMOPA I $G(PSOCMOP)]"" D K CMOP,PSOTRANS,PSOREL
- .S PSOTRANS=$E($P(PSOCMOP,"^",2),4,5)_"/"_$E($P(PSOCMOP,"^",2),6,7)_"/"_$E($P(PSOCMOP,"^",2),2,3)
- .S PSOREL=$S(CMOP("L")=0:$P($G(^PSRX(DA,2)),"^",13),1:$P(^PSRX(DA,1,CMOP("L"),0),"^",18))
- .S PSOREL=$E(PSOREL,4,5)_"/"_$E(PSOREL,6,7)_"/"_$E(PSOREL,2,3)_"@"_$E($P(PSOREL,".",2),1,4)
- .I '$D(IOINORM)!('$D(IOINHI)) S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS
- .I $P($G(^PSRX(RXREC,"STA")),"^")=0 W:$$TRANCMOP^PSOUTL(RXREC) ?5,IORVON_IOINHI
- .W !,RXPSTA_$S($P(PSOCMOP,"^")=0!($P(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$P(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed"),IOINORM_IORVOFF
- D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
- I $G(PSOCMOP)']"" D
- .S PSORFL=""
- .F PSOX=0:0 S PSOX=$O(^PSRX(RXREC,1,PSOX)) Q:'PSOX D
- ..S PSORFL=PSOX ;PSO*7*768
- ..S RFLZRO=$G(^PSRX(RXREC,1,PSOX,0))
- ..S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R",PSORTS=$P(RFLZRO,"^",16)
- .I '$O(^PSRX(RXREC,1,0)),$P(^PSRX(RXREC,2),"^",15) S PSOLRD=PSOLRD_"^R",PSORTS=$P(^PSRX(RXREC,2),"^",15)
- .W !,RXPSTA I +$G(PSORTS) W "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2) Q
- .;pso768
- .S PSOMW=""
- .I PSORFL S PSOMW=$S($P(^PSRX(RXREC,1,PSORFL,0),"^",2)="W":" (Window)",1:" (Mail)")
- .I PSOMW="" S PSOMW=$S($P(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)")
- .W $S(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($P(PSOLRD,"^"),2)_" "_$P(PSOLRD,"^",2))_PSOMW
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODRDU2 4811 printed Feb 18, 2025@23:53:47 Page 2
- PSODRDU2 ;BHAM ISC/SAB - dup drug/class display for outpatient orders ;08/23/17 19:54
- +1 ;;7.0;OUTPATIENT PHARMACY;**132,251,375,387,441,768**;DEC 1997;Build 12
- +2 ;External reference ^PS(50.7 - 2223
- +3 ;External reference ^PS(50.606 - 2174
- +4 ;External reference ^PSDRUG( - 221
- +5 ;External reference to ^PS(55 - 2228
- EN(PSODFN,ORN,LIST) ;psodfn=patient's ifn, orn=ordertype;order#;drugtype;counter
- +1 NEW DUPRXO,I,ISSD,J,BSIG,RFLS,RXREC,ST,PSONULN,LSTFL
- +2 SET $PIECE(PSONULN,"-",79)="-"
- +3 IF $PIECE(ORN,";")="O"
- GOTO RX
- +4 IF $PIECE(ORN,";")="P"
- GOTO PND
- +5 IF $PIECE(ORN,";")="N"
- GOTO NVA
- +6 IF $PIECE(ORN,";")="R"
- GOTO RDI
- +7 QUIT
- RX ;Rx info
- +1 if '$DATA(^PSRX($PIECE(ORN,";",2),0))
- QUIT
- NEW ISSD,LSTFLD
- SET RXREC=$PIECE(ORN,";",2)
- +2 SET DUPRX0=^PSRX(RXREC,0)
- SET RFLS=$PIECE(DUPRX0,"^",9)
- SET ISSD=$PIECE(^PSRX(RXREC,0),"^",13)
- SET ISSD=$EXTRACT(ISSD,4,5)_"/"_$EXTRACT(ISSD,6,7)_"/"_$EXTRACT(ISSD,2,3)
- +3 SET LSTFL=(+^PSRX(RXREC,3))
- SET LSTFL=$EXTRACT(LSTFL,4,5)_"/"_$EXTRACT(LSTFL,6,7)_"/"_$EXTRACT(LSTFL,2,3)
- SET RX0=DUPRX0
- SET RX2=^PSRX(RXREC,2)
- +4 SET STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^DONE^EXPIRED^DISCONTINUED^DELETED^DISCONTINUED BY PROVIDER^DISCONTINUED (EDIT)^HELD BY PROVIDER"
- +5 ;441 PAPI
- SET ST=$PIECE(STA,"^",(+$PIECE(^PSRX(RXREC,"STA"),"^")+1))
- Begin DoDot:1
- +6 IF ST="ACTIVE"
- IF $GET(^PSRX(RXREC,"PARK"))
- SET ST="PARKED"
- End DoDot:1
- KILL STA
- +7 WRITE !,"Local Rx #"_$PIECE(DUPRX0,"^")_" ("_ST_") for "_$PIECE(^PSDRUG($PIECE(DUPRX0,"^",6),0),"^")
- +8 KILL FSIG,BSIG
- IF $PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
- DO FSIG^PSOUTLA("R",RXREC,60)
- FOR PSREV=1:1
- if '$DATA(FSIG(PSREV))
- QUIT
- SET BSIG(PSREV)=FSIG(PSREV)
- +9 KILL FSIG,PSREV
- IF '$PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
- DO EN2^PSOUTLA1(RXREC,60)
- +10 WRITE !,"SIG: "_$GET(BSIG(1))
- IF $ORDER(BSIG(1))
- FOR PSREV=1:0
- SET PSREV=$ORDER(BSIG(PSREV))
- if 'PSREV
- QUIT
- WRITE !?20,$GET(BSIG(PSREV))
- +11 DO PRSTAT(RXREC)
- WRITE !
- +12 QUIT
- PND ;op pending orders
- +1 if '$DATA(^PS(52.41,$PIECE(ORN,";",2),0))
- QUIT
- +2 NEW DUPRX0,FSIG
- +3 SET DUPRX0=^PS(52.41,$PIECE(ORN,";",2),0)
- +4 WRITE !,"Pending Outpatient Drug for "_$SELECT('$PIECE(DUPRX0,"^",9):$PIECE(^PS(50.7,$PIECE(DUPRX0,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^"),1:$PIECE(^PSDRUG($PIECE(DUPRX0,"^",9),0),"^"))
- +5 DO FSIG^PSOUTLA("P",$PIECE(ORN,";",2),IOM-6)
- +6 WRITE !,"SIG: "
- FOR I=0:0
- SET I=$ORDER(FSIG(I))
- if 'I
- QUIT
- WRITE FSIG(I),!?5
- +7 QUIT
- NVA ;non-va meds
- +1 if '$DATA(^PS(55,PSODFN,"NVA",$PIECE(ORN,";",2),0))
- QUIT
- +2 SET DUPRX0=^PS(55,PSODFN,"NVA",$PIECE(ORN,";",2),0)
- +3 ;_" (ACTIVE)"
- WRITE !,"NON-VA Med: "_$SELECT('$PIECE(DUPRX0,"^",2):$PIECE(^PS(50.7,$PIECE(DUPRX0,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^"),1:$PIECE(^PSDRUG($PIECE(DUPRX0,"^",2),0),"^"))
- +4 WRITE !,"Dosage: "_$PIECE(DUPRX0,"^",3),?25,"Schedule: "_$PIECE(DUPRX0,"^",5)
- +5 WRITE !
- +6 ;W !?3,"Date Documented: "_$E($P(DUPRX0,"^",10),4,5)_"/"_$E($P(DUPRX0,"^",10),6,7)_"/"_$E($P(DUPRX0,"^",10),2,3),?30,"Status: Active",!
- +7 KILL DUPRX0
- +8 QUIT
- RDI ;RDI orders
- +1 if '$DATA(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2)))
- QUIT
- +2 SET RXREC=^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2))
- +3 WRITE !,"LOCATION: "_$PIECE(RXREC,"^")
- +4 WRITE !,"Remote Rx #"_$PIECE(RXREC,"^",5)_" ("_$PIECE(RXREC,"^",4)_") for "_$PIECE(RXREC,"^",3)
- +5 WRITE !,"SIG: "
- SET I=""
- FOR
- SET I=$ORDER(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2),"SIG",I))
- if I=""
- QUIT
- Begin DoDot:1
- +6 WRITE ^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2),"SIG",I),!
- +7 IF $ORDER(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2),"SIG",I))'=""
- WRITE ?5
- End DoDot:1
- +8 WRITE "Last Filled On: "_$PIECE(RXREC,"^",6),!
- +9 KILL RXREC,I
- +10 QUIT
- PRSTAT(DA) ;Displays the prescription's status
- +1 NEW PSOTRANS,PSOREL,PSOCMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS,CMOP,PSOMW,PSORFL
- +2 if (($Y+5)'>IOSL)
- DO HD^PSODDPR2()
- if $GET(PSODLQT)
- QUIT
- SET RXPSTA="Processing Status: "
- SET PSOLRD=$PIECE($GET(^PSRX(RXREC,2)),"^",13)
- +3 DO ^PSOCMOPA
- IF $GET(PSOCMOP)]""
- Begin DoDot:1
- +4 SET PSOTRANS=$EXTRACT($PIECE(PSOCMOP,"^",2),4,5)_"/"_$EXTRACT($PIECE(PSOCMOP,"^",2),6,7)_"/"_$EXTRACT($PIECE(PSOCMOP,"^",2),2,3)
- +5 SET PSOREL=$SELECT(CMOP("L")=0:$PIECE($GET(^PSRX(DA,2)),"^",13),1:$PIECE(^PSRX(DA,1,CMOP("L"),0),"^",18))
- +6 SET PSOREL=$EXTRACT(PSOREL,4,5)_"/"_$EXTRACT(PSOREL,6,7)_"/"_$EXTRACT(PSOREL,2,3)_"@"_$EXTRACT($PIECE(PSOREL,".",2),1,4)
- +7 IF '$DATA(IOINORM)!('$DATA(IOINHI))
- SET X="IORVOFF;IORVON;IOINHI;IOINORM"
- DO ENDR^%ZISS
- +8 IF $PIECE($GET(^PSRX(RXREC,"STA")),"^")=0
- if $$TRANCMOP^PSOUTL(RXREC)
- WRITE ?5,IORVON_IOINHI
- +9 WRITE !,RXPSTA_$SELECT($PIECE(PSOCMOP,"^")=0!($PIECE(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$PIECE(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed"),IOINORM_IORVOFF
- End DoDot:1
- KILL CMOP,PSOTRANS,PSOREL
- +10 if (($Y+5)'>IOSL)
- DO HD^PSODDPR2()
- if $GET(PSODLQT)
- QUIT
- +11 IF $GET(PSOCMOP)']""
- Begin DoDot:1
- +12 SET PSORFL=""
- +13 FOR PSOX=0:0
- SET PSOX=$ORDER(^PSRX(RXREC,1,PSOX))
- if 'PSOX
- QUIT
- Begin DoDot:2
- +14 ;PSO*7*768
- SET PSORFL=PSOX
- +15 SET RFLZRO=$GET(^PSRX(RXREC,1,PSOX,0))
- +16 if $PIECE(RFLZRO,"^",18)'=""
- SET PSOLRD=$PIECE(RFLZRO,"^",18)
- IF $PIECE(RFLZRO,"^",16)
- SET PSOLRD=PSOLRD_"^R"
- SET PSORTS=$PIECE(RFLZRO,"^",16)
- End DoDot:2
- +17 IF '$ORDER(^PSRX(RXREC,1,0))
- IF $PIECE(^PSRX(RXREC,2),"^",15)
- SET PSOLRD=PSOLRD_"^R"
- SET PSORTS=$PIECE(^PSRX(RXREC,2),"^",15)
- +18 WRITE !,RXPSTA
- IF +$GET(PSORTS)
- WRITE "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2)
- QUIT
- +19 ;pso768
- +20 SET PSOMW=""
- +21 IF PSORFL
- SET PSOMW=$SELECT($PIECE(^PSRX(RXREC,1,PSORFL,0),"^",2)="W":" (Window)",1:" (Mail)")
- +22 IF PSOMW=""
- SET PSOMW=$SELECT($PIECE(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)")
- +23 WRITE $SELECT(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($PIECE(PSOLRD,"^"),2)_" "_$PIECE(PSOLRD,"^",2))_PSOMW
- End DoDot:1
- +24 QUIT
