- 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 Mar 13, 2025@21:32:42 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
