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