Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSORLST2

PSORLST2.m

Go to the documentation of this file. 
  1. PSORLST2 ;BIRM/MFR - List of Patients/Prescriptions for Recall Notice ;Oct 20, 2022@16
  1.  ;;7.0;OUTPATIENT PHARMACY;**348,371,525,441,545**;DEC 1997;Build 270
  1.  ;
  1.  ; Report Output fields ("^" separated):
  1.  ; ------------------------------------
  1.  ;    1. FILL TYPE (e.g.,\\ORIGINAL\)    2. RX #
  1.  ;    3. DRUG NAME                       4. PATIENT NAME
  1.  ;    5. SSN                             6. ADDRESS 1
  1.  ;    7. ADDRESS 2                       8. ADDRESS 3
  1.  ;    9. CITY                           10. STATE
  1.  ;   11. ZIP                            12. PHONE (HOME)
  1.  ;   13. PHONE (WORK)                   14. PHONE (CELL)
  1.  ;   15. DECEASED?                      16. FILL #
  1.  ;   17. ISSUE DATE                     18. FILL DATE
  1.  ;   19. RELEASED DATE/TIME             20. EXPIRATION DATE
  1.  ;   21. LOT #                          22. NDC
  1.  ;   23. DIVISION                       24. PHARMACIST
  1.  ;   25. PROVIDER                       26. PATIENT STATUS
  1.  ;   27. QTY                            28. DAYS SUPPLY
  1.  ;   29. # OF REFILLS                   30. MAIL/WINDOW/PARK
  1.  ;   31. CMOP?                          32. PARTIAL REMARKS
  1.  ;   33. TRANSMISSION NUMBER            34. SEQUENCE #
  1.  ;   35. CMOP NDC                       36. DATE SHIPPED
  1.  ;   37. CARRIER                        38. PACKAGE ID
  1.  ;   39. /*EOR*/   Added with PSO*7*371
  1.  ;   
  1. PROCESS ; Use input search criteria to find matching orders, store in TMP global.
  1.  N PSOFRMDT,PSOTODT,PSORX,PSOFILL,PSORDT,RXND0,RXND2,PSOPAT,REFILLS
  1.  N PSORXDRG,NDC,LOT,PSODEAD,PTSTAT,OUTPUT,ISSDT,EXPDT,RX,FILL,PAT,LOTFLG,LOTLP
  1.  ;
  1.  ; - Search Originals and Refills
  1.  K ^TMP(+$J,"PSORLST")
  1.  S PSOFRMDT=$P(PSODTRNG,"^"),PSOTODT=$P(PSODTRNG,"^",2)
  1.  S PSORDT=$$FMADD^XLFDT(PSOFRMDT,,,,-1)
  1.  F  S PSORDT=$O(^PSRX("AL",PSORDT)) Q:((PSORDT="")!(PSORDT>(PSOTODT_".24")))  D
  1.  . S PSORX=0
  1.  . F  S PSORX=$O(^PSRX("AL",PSORDT,PSORX)) Q:'PSORX  D
  1.  . . S RXND0=$G(^PSRX(PSORX,0)),RXND2=$G(^PSRX(PSORX,2))
  1.  . . S PSOPAT=$P(RXND0,"^",2) I 'PSOPAT Q
  1.  . . S PSODEAD=+$G(^DPT(+PSOPAT,.35)) I ($G(PSOXDED))&$G(PSODEAD) Q
  1.  . . S PSORXDRG=$P(RXND0,"^",6) I 'PSORXDRG Q
  1.  . . I PSOMED'=1,'$D(PSODDRG(+PSORXDRG)) Q
  1.  . . S PSOFILL=""
  1.  . . F  S PSOFILL=$O(^PSRX("AL",PSORDT,PSORX,PSOFILL)) Q:PSOFILL=""  D
  1.  . . . I '$$RXRLDT^PSOBPSUT(PSORX,PSOFILL) Q
  1.  . . . I '$D(PSOSDIV(+$$RXSITE^PSOBPSUT(PSORX,PSOFILL))) Q
  1.  . . . I PSOMED=1 S NDC=$$RAWNDC($$GETNDC^PSONDCUT(PSORX,PSOFILL)) Q:NDC=""  Q:'$D(PSONDC(NDC))
  1.  . . . I PSOMED=2 S LOT=$$LOT(PSORX,PSOFILL) Q:LOT=""  D  Q:'$G(LOTFLG)
  1.  . . . . S LOTFLG=0,LOTLP="" F  S LOTLP=$O(PSODDRG(+PSORXDRG,LOTLP)) Q:LOTLP=""  I $$UPPER(LOT)[$$UPPER(LOTLP) S LOTFLG=1 Q
  1.  . . . S ^TMP($J,"PSORLST",$$GET1^DIQ(2,PSOPAT,.01),PSORX,PSOFILL)=""
  1.  ;
  1.  ; - Search Partials
  1.  S PSORDT=$$FMADD^XLFDT(PSOFRMDT,,,,-1)
  1.  F  S PSORDT=$O(^PSRX("AM",PSORDT)) Q:((PSORDT="")!(PSORDT>(PSOTODT_".24")))  D
  1.  . S PSORX=0
  1.  . F  S PSORX=$O(^PSRX("AM",PSORDT,PSORX)) Q:'PSORX  D
  1.  . . S RXND0=$G(^PSRX(PSORX,0)),RXND2=$G(^PSRX(PSORX,2))
  1.  . . S PSOPAT=$P(RXND0,"^",2) I 'PSOPAT Q
  1.  . . S PSODEAD=+$G(^DPT(+PSOPAT,.35)) I ($G(PSOXDED))&$G(PSODEAD) Q
  1.  . . S PSORXDRG=$P(RXND0,"^",6) I 'PSORXDRG Q
  1.  . . I PSOMED'=1,'$D(PSODDRG(+PSORXDRG)) Q
  1.  . . S PSOFILL=0
  1.  . . F  S PSOFILL=$O(^PSRX("AM",PSORDT,PSORX,PSOFILL)) Q:'PSOFILL  D
  1.  . . . I '$D(PSOSDIV(+$$GET1^DIQ(52.2,(+PSOFILL)_","_PSORX,.09,"I"))) Q
  1.  . . . I PSOMED=1 S NDC=$$RAWNDC($$GET1^DIQ(52.2,(+PSOFILL)_","_PSORX,1)) S:NDC="" NDC=$$RAWNDC($P(RXND2,"^",7)) Q:NDC=""  Q:'$D(PSONDC(NDC))
  1.  . . . I PSOMED=2 S LOT=$$LOT(PSORX,PSOFILL_"P") Q:LOT=""  D  Q:'$G(LOTFLG)
  1.  . . . . S LOTFLG=0,LOTLP="" F  S LOTLP=$O(PSODDRG(+PSORXDRG,LOTLP)) Q:LOTLP=""  I $$UPPER(LOT)[$$UPPER(LOTLP) S LOTFLG=1 Q
  1.  . . . S ^TMP($J,"PSORLST",$$GET1^DIQ(2,PSOPAT,.01),PSORX,PSOFILL_"P")=""
  1.  ;
  1.  I $D(^TMP($J,"PSORLST")) D
  1.  . W !,"\\FILL TYPE\^RX #^DRUG NAME^PATIENT NAME^SSN^ADDRESS 1^ADDRESS 2^ADDRESS 3^"
  1.  . W "CITY^STATE^ZIP^PHONE (HOME)^PHONE (WORK)^PHONE (CELL)^DECEASED?^FILL #^ISSUE DATE^"
  1.  . W "FILL DATE^RELEASED DATE/TIME^EXPIRATION DATE^LOT #^NDC^DIVISION^PHARMACIST^PROVIDER^"
  1.  . W "PATIENT STATUS^QTY^DAYS SUPPLY^# OF REFILLS^MAIL/WINDOW^CMOP?^PARTIAL REMARKS^"
  1.  . W "TRANSMISSION NUMBER^SEQUENCE #^CMOP NDC^DATE SHIPPED^CARRIER^PACKAGE ID^/*EOR*/" ;371 Add End of Row indicator
  1.  . S (PAT,RX,FILL,OUTPUT)=""
  1.  . F  S PAT=$O(^TMP($J,"PSORLST",PAT)) Q:PAT=""  D
  1.  . . F  S RX=$O(^TMP($J,"PSORLST",PAT,RX)) Q:RX=""  D
  1.  . . . S RXND0=$G(^PSRX(RX,0)),RXND2=$G(^PSRX(RX,2))
  1.  . . . S ISSDT=$P(RXND0,"^",13) I ISSDT S ISSDT=$TR($$FMTE^XLFDT(ISSDT,2),"@"," ")
  1.  . . . S EXPDT=$P(RXND2,"^",6) I EXPDT S EXPDT=$TR($$FMTE^XLFDT(EXPDT,2),"@"," ")
  1.  . . . S PTSTAT=$P(RXND0,"^",3),PTSTAT=$P(^PS(53,+PTSTAT,0),"^")
  1.  . . . S REFILLS=$P(RXND0,"^",9)
  1.  . . . F  S FILL=$O(^TMP($J,"PSORLST",PAT,RX,FILL)) Q:FILL=""  D
  1.  . . . . I FILL=0 D
  1.  . . . . . S OUTPUT="\\ORIGINAL\^"_$$PATIENT(RXND0,RXND2)_"^"_$$ORIGINAL(RXND0,RXND2)_"^"_$$CMOP(RX,0)
  1.  . . . . E  I FILL'["P" D
  1.  . . . . . S OUTPUT="\\REFILL\^"_$$PATIENT(RXND0,RXND2)_"^"_$$REFILL(RX,FILL,RXND0,RXND2)_"^"_$$CMOP(RX,FILL)
  1.  . . . . E  D
  1.  . . . . . S OUTPUT="\\PARTIAL\^"_$$PATIENT(RXND0,RXND2)_"^"_$$PARTIAL(RX,+FILL,RXND0,RXND2)_"^^^^^^^"_"/*EOR*/"  ;371
  1.  . . . . S $P(OUTPUT,"^",17)=ISSDT
  1.  . . . . S $P(OUTPUT,"^",20)=EXPDT
  1.  . . . . S $P(OUTPUT,"^",26)=PTSTAT
  1.  . . . . S $P(OUTPUT,"^",29)=REFILLS
  1.  . . . . S $P(OUTPUT,"^",31)=$S($P(OUTPUT,"^",33)'="":"Y",1:"N")
  1.  . . . . W !,OUTPUT
  1.  E  D
  1.  . W !!!?15,"*** NO RECORDS TO PRINT ***",!!!!
  1.  ;
  1.  K ^TMP($J,"PSORLST") D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. PATIENT(RXND0,RXND2) ; Build patient information (HEADER), store in ^TMP
  1.  ; RXND0 - Prescription File (#52) zero node (^PSRX(RX,0))
  1.  ; RXND2 - Prescription File (#52) two node (^PSRX(RX,2))
  1.  ; Ouptput: RX #^DRUG NAME^PATIENT NAME^SSN^ADDRESS 1^ADDRESS 2^ADDRESS 3^CITY^STATE^ZIP^
  1.  ;          PHONE (HOME)^PHONE (WORK)^PHONE (CELL)^DECEASED?
  1.  ;
  1.  N PATIENT,DFN,VADM,VAPA,DEAD,PHONES,RESID,WORK,CELL
  1.  ;
  1.  S DFN=$P(RXND0,"^",2) D DEM^VADPT,ADD^VADPT
  1.  S DEAD=+$G(^DPT(+DFN,.35)),DEAD=$S(DEAD:"Y",1:"N")
  1.  S PATIENT=$P(RXND0,"^")_"^"_$$GET1^DIQ(50,+$P(RXND0,"^",6),.01)_"^"_VADM(1)_"^"_$P(VADM(2),"^",2)
  1.  S PATIENT=PATIENT_"^"_VAPA(1)_"^"_VAPA(2)_"^"_VAPA(3)_"^"_VAPA(4)_"^"_$P(VAPA(5),"^",2)_"^"_VAPA(6)
  1.  S PHONES=$G(^DPT(+DFN,.13)),RESID=$P(PHONES,"^"),WORK=$P(PHONES,"^",2),CELL=$P(PHONES,"^",4)
  1.  S PATIENT=PATIENT_"^"_RESID_"^"_WORK_"^"_CELL_"^"_DEAD
  1.  Q PATIENT
  1.  Q
  1.  ;
  1. ORIGINAL(RXND0,RXND2) ; Build output for specific original RX, store in ^TMP
  1.  ; RXND0 - Prescription File (#52) zero node (^PSRX(RX,0))
  1.  ; RXND2 - Prescription File (#52) two node (^PSRX(RX,2))
  1.  ; Output: 0(Original)^ISSUE DATE^FILL DATE^RELEASED DATE/TIME^^LOT #^NDC^DIVISION (###)^
  1.  ;         PHARMACIST^PROVIDER^^QTY^DAYS SUPPLY^# OF REFILLS^MAIL/WINDOW^^
  1.  ;
  1.  N ORIGINAL,FILLDT,RELDT,LOT,NDC,DIV,DIVNAM,DIVNUM,PHARM,PROV,MW,QTY,DAYS,Z
  1.  ;
  1.  S FILLDT=$P(RXND2,"^",2) I FILLDT S FILLDT=$TR($$FMTE^XLFDT(FILLDT,2),"@"," ")
  1.  S RELDT=$P(RXND2,"^",13) I RELDT S RELDT=$TR($$FMTE^XLFDT(RELDT,2),"@"," ")
  1.  ;S LOT=$P(RXND2,"^",4)
  1.  S LOT=$$LOT(RX,FILL) ;*525
  1.  S NDC=$P(RXND2,"^",7)
  1.  S DIVNAM="",DIV=$P(RXND2,"^",9)
  1.  S (DIVNAM,DIVNUM)="" I DIV S Z=$G(^PS(59,+DIV,0)),DIVNAM=$P(Z,"^"),DIVNUM=$P(Z,"^",6)
  1.  S PHARM=$P($G(^VA(200,+$P(RXND2,"^",3),0)),"^")
  1.  S PROV=$P($G(^VA(200,+$P(RXND0,"^",4),0)),"^")
  1.  S QTY=$P(RXND0,"^",7),DAYS=$P(RXND0,"^",8)
  1.  S MW=$P(RXND0,"^",11),MW=$S(MW="W":"WINDOW",MW="P":"PARK",1:"MAIL")  ;441 PAPI
  1.  S ORIGINAL="0^^"_FILLDT_"^"_RELDT_"^^"_LOT_"^"_NDC_"^"_DIVNAM_" ("_DIVNUM_")"
  1.  S ORIGINAL=ORIGINAL_"^"_PHARM_"^"_PROV_"^^"_QTY_"^"_DAYS_"^^"_MW_"^^"
  1.  Q ORIGINAL
  1.  ;
  1. REFILL(RX,REF,RXND0,RXND2) ; Build output for specific Refill, store in ^TMP
  1.  ; REF - Refill Number
  1.  ; RXND0 - Prescription File (#52) zero node (^PSRX(RX,0))
  1.  ; RXND2 - Prescription File (#52) two node (^PSRX(RX,2))
  1.  ; Output: FILL #^ISSUE DATE^FILL DATE^RELEASED DATE/TIME^^LOT #^NDC^DIVISION(###)^
  1.  ;         PHARMACIST^PROVIDER^^QTY^DAYS SUPPLY^# OF REFILLS^MAIL/WINDOW^^
  1.  ;
  1.  N REFILL,RF0,RF1,RFILDT,RLSDT,QTY,DAYS,LOT,NDC,DIV,DIVNAM,DIVNUM,PROV,PHARM,MW,Z
  1.  ;
  1.  S RF0=$G(^PSRX(RX,1,REF,0))
  1.  S RF1=$G(^PSRX(RX,1,REF,1))
  1.  S RFILDT=$P(RF0,"^") I RFILDT S RFILDT=$TR($$FMTE^XLFDT(RFILDT,2),"@"," ")
  1.  S RLSDT=$P(RF0,"^",18) I RLSDT S RLSDT=$TR($$FMTE^XLFDT(RLSDT,2),"@"," ")
  1.  S LOT=$$LOT(RX,REF)
  1.  S QTY=$P(RF0,"^",4)
  1.  S DAYS=$P(RF0,"^",10)
  1.  S NDC=$$GETNDC^PSONDCUT(RX,REF)
  1.  S DIV=$P(RF0,"^",9) S:'DIV DIV=$P(RXND2,"^",9)
  1.  S (DIVNAM,DIVNUM)="" I DIV S Z=$G(^PS(59,+DIV,0)),DIVNAM=$P(Z,"^"),DIVNUM=$P(Z,"^",6)
  1.  S PHARM=$P(RF0,"^",5) S:'PHARM PHARM=$P(RXND2,"^",3) S PHARM=$P($G(^VA(200,+PHARM,0)),"^")
  1.  S PROV=$P(RF0,"^",17) S:'PROV PROV=$P(RXND0,"^",4) S PROV=$P($G(^VA(200,+PROV,0)),"^")
  1.  S MW=$P(RF0,"^",2),MW=$S(MW="W":"WINDOW",MW="P":"PARK",1:"MAIL")  ;441 PAPI
  1.  S REFILL=REF_"^^"_RFILDT_"^"_RLSDT_"^^"_LOT_"^"_NDC_"^"_DIVNAM_" ("_DIVNUM_")"
  1.  S REFILL=REFILL_"^"_PHARM_"^"_PROV_"^^"_QTY_"^"_DAYS_"^^"_MW_"^^"
  1.  Q REFILL
  1.  ;
  1. PARTIAL(RX,PAR,RXND0,RXND2) ; Build output for specific partial fill, store in ^TMP
  1.  ; SEQ - Integer representing a specific Partial node from the Prescription file (#52)
  1.  ; RXND0 - Prescription File (#52) zero node (^PSRX(RX,0))
  1.  ; RXND2 - Prescription File (#52) two node (^PSRX(RX,2))
  1.  ; Output: FILL #^ISSUE DATE^FILL DATE^RELEASED DATE/TIME^^LOT #^NDC^DIVISION(###)^
  1.  ;         PHARMACIST^PROVIDER^^QTY^DAYS SUPPLY^# OF REFILLS^MAIL/WINDOW^CMOP?^REMARKS
  1.  ;
  1.  N PARTIAL,PT0,PARTDT,RLSDT,NDC,LOT,QTY,DAYS,DIV,DIVNUM,DIVNAM,PROV,PHARM,RMRKS,MW,RXNDP,Z
  1.  S PT0=$G(^PSRX(RX,"P",PAR,0))
  1.  S PARTDT=$P(PT0,"^") I PARTDT S PARTDT=$TR($$FMTE^XLFDT(PARTDT,2),"@"," ")
  1.  S RLSDT=$P(PT0,"^",19) IF RLSDT S RLSDT=$TR($$FMTE^XLFDT(RLSDT,2),"@"," ")
  1.  S LOT=$$LOT(RX,PAR_"P")
  1.  S NDC=$P(PT0,"^",12) S:NDC="" NDC=$$GETNDC^PSONDCUT(RX,0)
  1.  S QTY=$P(PT0,"^",4)
  1.  S DAYS=$P(PT0,"^",10)
  1.  S DIV=$P(PT0,"^",9) S:'DIV DIV=$P(RXND2,"^",9)
  1.  S (DIVNAM,DIVNUM)="" I DIV S Z=$G(^PS(59,+DIV,0)),DIVNAM=$P(Z,"^"),DIVNUM=$P(Z,"^",6)
  1.  S PHARM=$P(PT0,"^",5) S:'PHARM PHARM=$P(RXND2,"^",3) S PHARM=$P($G(^VA(200,+PHARM,0)),"^")
  1.  S PROV=$P(PT0,"^",17) S:'PROV PROV=$P(RXND0,"^",4) S PROV=$P($G(^VA(200,+PROV,0)),"^")
  1.  S MW=$S($P(PT0,"^",2)="W":"WINDOW",1:"MAIL")
  1.  S RMRKS=$P(PT0,"^",3)
  1.  S PARTIAL=PAR_"^^"_PARTDT_"^"_RLSDT_"^^"_LOT_"^"_NDC_"^"_DIVNAM_" ("_DIVNUM_")"
  1.  S PARTIAL=PARTIAL_"^"_PHARM_"^"_PROV_"^^"_QTY_"^"_DAYS_"^^"_MW_"^N^"_RMRKS
  1.  Q PARTIAL
  1.  ;
  1. CMOP(RX,FILL) ; Build output for CMOP fields
  1.  ; RX   - Prescription file (#52) IEN
  1.  ; FILL - Fill # (0 - Original, 1 - Refill #1, 2 - Refill #2, etc...)
  1.  ; Output: TRANSMISSION NUMBER^SEQUENCE #^CMOP NDC^DATE SHIPPED^CARRIER^PACKAGE ID
  1.  ;
  1.  N CMOP,CMOPSEQ,Z0,Z1
  1.  ;
  1.  S CMOP="^^^^^^/*EOR*/" ;371 Add End of Row indicator.
  1.  I '$D(^PSRX(RX,4)) Q CMOP
  1.  ;
  1.  S CMOPSEQ=0 F  S CMOPSEQ=$O(^PSRX(RX,4,CMOPSEQ)) Q:'CMOPSEQ  D
  1.  . S Z0=$G(^PSRX(RX,4,CMOPSEQ,0))
  1.  . I $P(Z0,"^",3)'=FILL!($P(Z0,"^",4)'=1) Q
  1.  . S CMOP=$P(Z0,"^",1)_"^"_$P(Z0,"^",2)_"^"_$P(Z0,"^",8)
  1.  . S Z1=$G(^PSRX(RX,4,CMOPSEQ,1))
  1.  . S CMOP=CMOP_"^"_$TR($$FMTE^XLFDT($P(Z1,"^",2),2),"@"," ")_"^"_$P(Z1,"^",3)_"^"_$P(Z1,"^",4)_"^"_"/*EOR*/"  ;371
  1.  ;
  1.  Q CMOP
  1.  ;
  1. LOT(RX,FILL) ; Returns the LOT# for a specific Fill
  1.  ; Input:  (r) RX   - Rx IEN (#52)
  1.  ;         (r) FILL - Refill #/Partial # (note: Partials contain a "P", e.g. "1P")
  1.  ; Output:     LOT  - Rx Drug Lot #
  1.  N LOT,I,J S LOT="",(I,J)=0 ;*525 to include CMOP LOT #
  1.  F  S I=$O(^PSRX(RX,5,I)) Q:('I)  D
  1.  . I $P($G(^PSRX(RX,5,I,0)),"^",3)=FILL N TMPLOT S J=1,TMPLOT=$P(^(0),"^") S LOT=$S($L($G(LOT))&$L(TMPLOT):LOT_" "_TMPLOT,'$L(TMPLOT):$G(LOT),1:TMPLOT)
  1.  Q:J LOT
  1.  I FILL["P" S LOT=$$GET1^DIQ(52.2,(+FILL)_","_RX,.06) Q LOT
  1.  I FILL>0 S LOT=$$GET1^DIQ(52.1,(+FILL)_","_RX,5) Q LOT
  1.  S LOT=$$GET1^DIQ(52,RX,24)
  1.  Q LOT
  1.  ;
  1. RAWNDC(NDC) ; Returns NDC without dashes ('-') or spaces (' ')
  1.  Q $TR($TR(NDC,"-","")," ","")
  1.  ;
  1. UPPER(PSOUCS) ;
  1.  Q $TR(PSOUCS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")