PSUOP7 ;BIR/DAM - Outpatient AMIS Summary Data;04 MAR 2004
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;No DBIA's required
;
DATA ;Gather AMIS summary data from the detailed "DATA" global
;Called from PSUOP4
;
N QTY,PRICE,QUANT
;
S QTY=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,25)
;
;
;Find sum of 30-day fills for each division
I QTY'>30 D
.S ^TMP($J,"FILL",PSUDV,30)=$G(^TMP($J,"FILL",PSUDV,30))+1
I '$G(^TMP($J,"FILL",PSUDV,30)) S ^TMP($J,"FILL",PSUDV,30)=0
;
;
;Find sum of 60-day fills for each division
I (QTY>30)&(QTY'>60) D
.S ^TMP($J,"FILL",PSUDV,60)=$G(^TMP($J,"FILL",PSUDV,60))+1
I '$G(^TMP($J,"FILL",PSUDV,60)) S ^TMP($J,"FILL",PSUDV,60)=0
;
;
;Find sum of 90-day fills for each division
I QTY>60 D
.S ^TMP($J,"FILL",PSUDV,90)=$G(^TMP($J,"FILL",PSUDV,90))+1
I '$G(^TMP($J,"FILL",PSUDV,90)) S ^TMP($J,"FILL",PSUDV,90)=0
;
;
N FILL30,FILL60,FILL90
S FILL30=^TMP($J,"FILL",PSUDV,30)
S FILL60=^TMP($J,"FILL",PSUDV,60)
S FILL90=^TMP($J,"FILL",PSUDV,90)
;
;Calculate Unadjusted Total Fills
S ^TMP($J,"UNAD",PSUDV)=FILL30+FILL60+FILL90
;
;
;Calculate 30-day Equivalent Fills
S ^TMP($J,"EQUIV",PSUDV)=FILL30+(2*FILL60)+(3*FILL90)
;
;
;Calculate total cost for all fills
;S PRICE=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,2),U,5)
S PRICE=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,24)
S QUANT=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,26)
S PSUCOST=PRICE*QUANT
S ^TMP($J,"COST",PSUDV,PSURXIEN)=$G(^TMP($J,"COST",PSUDV,PSURXIEN))+PSUCOST
;
;
;Find number of "new", "refill", and "partial" prescriptions
S PSUTYPE=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,16)
;
I PSUTYPE="N" D
.S ^TMP($J,"NEW",PSUDV)=$G(^TMP($J,"NEW",PSUDV))+1 ;New fills
I '$G(^TMP($J,"NEW",PSUDV)) S ^TMP($J,"NEW",PSUDV)=0
;
;
I PSUTYPE'="N" D
.S ^TMP($J,"REF",PSUDV)=$G(^TMP($J,"REF",PSUDV))+1 ;Refills + partial
I '$G(^TMP($J,"REF",PSUDV)) S ^TMP($J,"REF",PSUDV)=0
;
;Find total number of "Window CS" and "Mail CS" prescription fills
;
S PSUWIN=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,18)
S PSUCMP=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,17)
S PSUCS=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,15)
;
;
I PSUWIN="W" S ^TMP($J,"WIN",PSUDV)=$G(^TMP($J,"WIN",PSUDV))+1 D
.I PSUCMP="N" D
..I (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5) D
...S ^TMP($J,"WINCS",PSUDV)=$G(^TMP($J,"WINCS",PSUDV))+1 ;WIN CS fills
I '$G(^TMP($J,"WIN",PSUDV)) S ^TMP($J,"WIN",PSUDV)=0
I '$G(^TMP($J,"WINCS",PSUDV)) S ^TMP($J,"WINCS",PSUDV)=0
;
;
I PSUWIN="M" S ^TMP($J,"MAIL",PSUDV)=$G(^TMP($J,"MAIL",PSUDV))+1 D
.I PSUCMP="N" D
..I (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5) D
...S ^TMP($J,"MAILCS",PSUDV)=$G(^TMP($J,"MAILCS",PSUDV))+1 ;Mail CS
I '$G(^TMP($J,"MAIL",PSUDV)) S ^TMP($J,"MAIL",PSUDV)=0
I '$G(^TMP($J,"MAILCS",PSUDV)) S ^TMP($J,"MAILCS",PSUDV)=0
;
;
I PSUCMP="Y" D
.S ^TMP($J,"CMOP",PSUDV)=$G(^TMP($J,"CMOP",PSUDV))+1 ;CMOP fills
I '$G(^TMP($J,"CMOP",PSUDV)) S ^TMP($J,"CMOP",PSUDV)=0
;
;
I PSUCMP="N" S ^TMP($J,"LOC",PSUDV)=$G(^TMP($J,"LOC",PSUDV))+1 D
.I (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5) D
..S ^TMP($J,"LOCS",PSUDV)=$G(^TMP($J,"LOCS",PSUDV))+1 ;Local CS fills
I '$G(^TMP($J,"LOC",PSUDV)) S ^TMP($J,"LOC",PSUDV)=0
I '$G(^TMP($J,"LOCS",PSUDV)) S ^TMP($J,"LOCS",PSUDV)=0
;
S PSUSTF=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,20)
;
I PSUSTF="S" D
.S ^TMP($J,"STAFF",PSUDV)=$G(^TMP($J,"STAFF",PSUDV))+1 ;Staff fills
I '$G(^TMP($J,"STAFF",PSUDV)) S ^TMP($J,"STAFF",PSUDV)=0
;
;
I PSUSTF="F" D
.S ^TMP($J,"FEE",PSUDV)=$G(^TMP($J,"FEE",PSUDV))+1 ;Fee fills
I '$G(^TMP($J,"FEE",PSUDV)) S ^TMP($J,"FEE",PSUDV)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUOP7 3788 printed Apr 09, 2024@21:31:01 Page 2
PSUOP7 ;BIR/DAM - Outpatient AMIS Summary Data;04 MAR 2004
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;No DBIA's required
+4 ;
DATA ;Gather AMIS summary data from the detailed "DATA" global
+1 ;Called from PSUOP4
+2 ;
+3 NEW QTY,PRICE,QUANT
+4 ;
+5 SET QTY=$PIECE(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,25)
+6 ;
+7 ;
+8 ;Find sum of 30-day fills for each division
+9 IF QTY'>30
Begin DoDot:1
+10 SET ^TMP($JOB,"FILL",PSUDV,30)=$GET(^TMP($JOB,"FILL",PSUDV,30))+1
End DoDot:1
+11 IF '$GET(^TMP($JOB,"FILL",PSUDV,30))
SET ^TMP($JOB,"FILL",PSUDV,30)=0
+12 ;
+13 ;
+14 ;Find sum of 60-day fills for each division
+15 IF (QTY>30)&(QTY'>60)
Begin DoDot:1
+16 SET ^TMP($JOB,"FILL",PSUDV,60)=$GET(^TMP($JOB,"FILL",PSUDV,60))+1
End DoDot:1
+17 IF '$GET(^TMP($JOB,"FILL",PSUDV,60))
SET ^TMP($JOB,"FILL",PSUDV,60)=0
+18 ;
+19 ;
+20 ;Find sum of 90-day fills for each division
+21 IF QTY>60
Begin DoDot:1
+22 SET ^TMP($JOB,"FILL",PSUDV,90)=$GET(^TMP($JOB,"FILL",PSUDV,90))+1
End DoDot:1
+23 IF '$GET(^TMP($JOB,"FILL",PSUDV,90))
SET ^TMP($JOB,"FILL",PSUDV,90)=0
+24 ;
+25 ;
+26 NEW FILL30,FILL60,FILL90
+27 SET FILL30=^TMP($JOB,"FILL",PSUDV,30)
+28 SET FILL60=^TMP($JOB,"FILL",PSUDV,60)
+29 SET FILL90=^TMP($JOB,"FILL",PSUDV,90)
+30 ;
+31 ;Calculate Unadjusted Total Fills
+32 SET ^TMP($JOB,"UNAD",PSUDV)=FILL30+FILL60+FILL90
+33 ;
+34 ;
+35 ;Calculate 30-day Equivalent Fills
+36 SET ^TMP($JOB,"EQUIV",PSUDV)=FILL30+(2*FILL60)+(3*FILL90)
+37 ;
+38 ;
+39 ;Calculate total cost for all fills
+40 ;S PRICE=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,2),U,5)
+41 SET PRICE=$PIECE(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,24)
+42 SET QUANT=$PIECE(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,26)
+43 SET PSUCOST=PRICE*QUANT
+44 SET ^TMP($JOB,"COST",PSUDV,PSURXIEN)=$GET(^TMP($JOB,"COST",PSUDV,PSURXIEN))+PSUCOST
+45 ;
+46 ;
+47 ;Find number of "new", "refill", and "partial" prescriptions
+48 SET PSUTYPE=$PIECE(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,16)
+49 ;
+50 IF PSUTYPE="N"
Begin DoDot:1
+51 ;New fills
SET ^TMP($JOB,"NEW",PSUDV)=$GET(^TMP($JOB,"NEW",PSUDV))+1
End DoDot:1
+52 IF '$GET(^TMP($JOB,"NEW",PSUDV))
SET ^TMP($JOB,"NEW",PSUDV)=0
+53 ;
+54 ;
+55 IF PSUTYPE'="N"
Begin DoDot:1
+56 ;Refills + partial
SET ^TMP($JOB,"REF",PSUDV)=$GET(^TMP($JOB,"REF",PSUDV))+1
End DoDot:1
+57 IF '$GET(^TMP($JOB,"REF",PSUDV))
SET ^TMP($JOB,"REF",PSUDV)=0
+58 ;
+59 ;Find total number of "Window CS" and "Mail CS" prescription fills
+60 ;
+61 SET PSUWIN=$PIECE(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,18)
+62 SET PSUCMP=$PIECE(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,17)
+63 SET PSUCS=$PIECE(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,15)
+64 ;
+65 ;
+66 IF PSUWIN="W"
SET ^TMP($JOB,"WIN",PSUDV)=$GET(^TMP($JOB,"WIN",PSUDV))+1
Begin DoDot:1
+67 IF PSUCMP="N"
Begin DoDot:2
+68 IF (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5)
Begin DoDot:3
+69 ;WIN CS fills
SET ^TMP($JOB,"WINCS",PSUDV)=$GET(^TMP($JOB,"WINCS",PSUDV))+1
End DoDot:3
End DoDot:2
End DoDot:1
+70 IF '$GET(^TMP($JOB,"WIN",PSUDV))
SET ^TMP($JOB,"WIN",PSUDV)=0
+71 IF '$GET(^TMP($JOB,"WINCS",PSUDV))
SET ^TMP($JOB,"WINCS",PSUDV)=0
+72 ;
+73 ;
+74 IF PSUWIN="M"
SET ^TMP($JOB,"MAIL",PSUDV)=$GET(^TMP($JOB,"MAIL",PSUDV))+1
Begin DoDot:1
+75 IF PSUCMP="N"
Begin DoDot:2
+76 IF (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5)
Begin DoDot:3
+77 ;Mail CS
SET ^TMP($JOB,"MAILCS",PSUDV)=$GET(^TMP($JOB,"MAILCS",PSUDV))+1
End DoDot:3
End DoDot:2
End DoDot:1
+78 IF '$GET(^TMP($JOB,"MAIL",PSUDV))
SET ^TMP($JOB,"MAIL",PSUDV)=0
+79 IF '$GET(^TMP($JOB,"MAILCS",PSUDV))
SET ^TMP($JOB,"MAILCS",PSUDV)=0
+80 ;
+81 ;
+82 IF PSUCMP="Y"
Begin DoDot:1
+83 ;CMOP fills
SET ^TMP($JOB,"CMOP",PSUDV)=$GET(^TMP($JOB,"CMOP",PSUDV))+1
End DoDot:1
+84 IF '$GET(^TMP($JOB,"CMOP",PSUDV))
SET ^TMP($JOB,"CMOP",PSUDV)=0
+85 ;
+86 ;
+87 IF PSUCMP="N"
SET ^TMP($JOB,"LOC",PSUDV)=$GET(^TMP($JOB,"LOC",PSUDV))+1
Begin DoDot:1
+88 IF (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5)
Begin DoDot:2
+89 ;Local CS fills
SET ^TMP($JOB,"LOCS",PSUDV)=$GET(^TMP($JOB,"LOCS",PSUDV))+1
End DoDot:2
End DoDot:1
+90 IF '$GET(^TMP($JOB,"LOC",PSUDV))
SET ^TMP($JOB,"LOC",PSUDV)=0
+91 IF '$GET(^TMP($JOB,"LOCS",PSUDV))
SET ^TMP($JOB,"LOCS",PSUDV)=0
+92 ;
+93 SET PSUSTF=$PIECE(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,20)
+94 ;
+95 IF PSUSTF="S"
Begin DoDot:1
+96 ;Staff fills
SET ^TMP($JOB,"STAFF",PSUDV)=$GET(^TMP($JOB,"STAFF",PSUDV))+1
End DoDot:1
+97 IF '$GET(^TMP($JOB,"STAFF",PSUDV))
SET ^TMP($JOB,"STAFF",PSUDV)=0
+98 ;
+99 ;
+100 IF PSUSTF="F"
Begin DoDot:1
+101 ;Fee fills
SET ^TMP($JOB,"FEE",PSUDV)=$GET(^TMP($JOB,"FEE",PSUDV))+1
End DoDot:1
+102 IF '$GET(^TMP($JOB,"FEE",PSUDV))
SET ^TMP($JOB,"FEE",PSUDV)=0
+103 QUIT
