PSUUD3 ;BIR/TJH/,PDW - PBM UNIT DOSE OUTPUT ;25 AUG 1998
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
EN ;
;
NONE ; send "no data" message if nothing collected
I '$D(^XTMP(PSUUDSUB,"DETAIL")) D Q
.S ^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")=""
.S NONE=1
.K PSUXMY,^XTMP(PSUUDSUB,"RECORDS")
.M PSUXMY=PSUXMYS1
.I PSUMASF!PSUPBMG M PSUXMY=PSUXMYH
.S ^XTMP(PSUUDSUB,"RECORDS",PSUSNDR,1)="No data to report"
.D EN^PSUUD4(.PSUMSGT)
.S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUSNDR,PSUOPTN,"L")=0
.S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUSNDR,PSUOPTN,"M")=1
NONEQ ; routine does not pass this point if "no data" due to Quit at NONE+1
;
MMFULL ; send full detail to Hines if Master File update was selected
K PSUXMY,^XTMP(PSUUDSUB,"RECORDS")
M PSUXMY=PSUXMYH
M ^XTMP(PSUUDSUB,"RECORDS")=^XTMP(PSUUDSUB,"DETAIL")
D EN^PSUUD6 ;AMIS Summary report
I 'PSUSMRY D
.D EN^PSUUD4(.PSUMSGT)
.M ^XTMP("PSU_"_PSUJOB,"CONFIRM")=PSUMSGT
;
;
MMSSUM ; statistical summary
N PSUUDFLG S PSUUDFLG=1 ;Flag for summary reports
S $P(SPACES," ",81)="",$P(DASH,"-",81)=""
K PSUXMY,^XTMP(PSUUDSUB,"RECORDS"),^XTMP(PSUUDSUB,"STATSUM")
M PSUXMY=PSUXMYS1
S PSUFACN=""
F S PSUFACN=$O(^XTMP(PSUUDSUB,"DIS",PSUFACN)) Q:PSUFACN="" D
.S PSUF2=$G(^XTMP(PSUUDSUB,"SSN",PSUFACN)) ; Total patients
.S PSUDIV=PSUFACN D GETDIV^PSUV3 I PSUDIVNM'="" D
..S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUF2
.I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUF2
;
MMDRUG ; summary by drug
K ^XTMP(PSUUDSUB,"RECORDS"),^XTMP(PSUUDSUB,"DRUGSUM")
Q:PSUSMRY ;Don't print if user wants summary only
;
K PSUXMY
M PSUXMY=PSUXMYS2
S PSUFACN=""
F S PSUFACN=$O(^XTMP(PSUUDSUB,"DRUG",PSUFACN)) Q:PSUFACN="" D
.S X="Unit Dose Statistical Data for "_PSURP("START")_" through "_PSURP("END")
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,1)=X
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,2)=" "
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,3)=" "
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,4)=$E(SPACES,1,50)_"Total"_$E(SPACES,1,11)_"Total"
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,5)=$E(SPACES,1,50)_"Dispensed"_$E(SPACES,1,7)_"Dispensed"
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,6)="Drug Name"_$E(SPACES,1,41)_"Units"_$E(SPACES,1,11)_"Cost"
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,7)=$E(DASH,1,75)
.S PSUX="",PSULN=7,PSUGTC=0,PSUGTU=0
.F S PSUX=$O(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUX)) Q:PSUX="" D
..S PSUR=^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUX)
..S PSUTU=$P(PSUR,U,1),PSUPPU=$P(PSUR,U,2),PSUNON=$P(PSUR,U,3),PSUNFI=$P(PSUR,U,4)
..S PSUTC=PSUTU*PSUPPU,PSUGTC=PSUGTC+PSUTC,PSUGTU=PSUGTU+PSUTU
..S PSUDN=$E(PSUX,1,40)_" "_$S(PSUNON="N/F":"*",1:"")_$S(PSUNFI=0:"#",1:"")
..S PSULN=PSULN+1
..S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=$E(PSUDN_SPACES,1,45)_$J(PSUTU,12,2)_" "_$J(PSUTC,12,2)
.S PSULN=PSULN+1
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=$E(DASH,1,75)
.S PSULN=PSULN+1
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="Totals:"_$E(SPACES,1,38)_$J(PSUGTU,12,2)_" "_$J(PSUGTC,12,2)
.S PSULN=PSULN+1
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=" "
.S PSULN=PSULN+1
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="* Non-Formulary"
.S PSULN=PSULN+1
.S ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="# Not on National Formulary"
M ^XTMP(PSUUDSUB,"RECORDS")=^XTMP(PSUUDSUB,"DRUGSUM")
D EN^PSUUD4(.PSUMSGT)
K ^XTMP(PSUUDSUB,"RECORDS")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUUD3 3368 printed Dec 13, 2024@02:28:38 Page 2
PSUUD3 ;BIR/TJH/,PDW - PBM UNIT DOSE OUTPUT ;25 AUG 1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
EN ;
+1 ;
NONE ; send "no data" message if nothing collected
+1 IF '$DATA(^XTMP(PSUUDSUB,"DETAIL"))
Begin DoDot:1
+2 SET ^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")=""
+3 SET NONE=1
+4 KILL PSUXMY,^XTMP(PSUUDSUB,"RECORDS")
+5 MERGE PSUXMY=PSUXMYS1
+6 IF PSUMASF!PSUPBMG
MERGE PSUXMY=PSUXMYH
+7 SET ^XTMP(PSUUDSUB,"RECORDS",PSUSNDR,1)="No data to report"
+8 DO EN^PSUUD4(.PSUMSGT)
+9 SET ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUSNDR,PSUOPTN,"L")=0
+10 SET ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUSNDR,PSUOPTN,"M")=1
End DoDot:1
QUIT
NONEQ ; routine does not pass this point if "no data" due to Quit at NONE+1
+1 ;
MMFULL ; send full detail to Hines if Master File update was selected
+1 KILL PSUXMY,^XTMP(PSUUDSUB,"RECORDS")
+2 MERGE PSUXMY=PSUXMYH
+3 MERGE ^XTMP(PSUUDSUB,"RECORDS")=^XTMP(PSUUDSUB,"DETAIL")
+4 ;AMIS Summary report
DO EN^PSUUD6
+5 IF 'PSUSMRY
Begin DoDot:1
+6 DO EN^PSUUD4(.PSUMSGT)
+7 MERGE ^XTMP("PSU_"_PSUJOB,"CONFIRM")=PSUMSGT
End DoDot:1
+8 ;
+9 ;
MMSSUM ; statistical summary
+1 ;Flag for summary reports
NEW PSUUDFLG
SET PSUUDFLG=1
+2 SET $PIECE(SPACES," ",81)=""
SET $PIECE(DASH,"-",81)=""
+3 KILL PSUXMY,^XTMP(PSUUDSUB,"RECORDS"),^XTMP(PSUUDSUB,"STATSUM")
+4 MERGE PSUXMY=PSUXMYS1
+5 SET PSUFACN=""
+6 FOR
SET PSUFACN=$ORDER(^XTMP(PSUUDSUB,"DIS",PSUFACN))
if PSUFACN=""
QUIT
Begin DoDot:1
+7 ; Total patients
SET PSUF2=$GET(^XTMP(PSUUDSUB,"SSN",PSUFACN))
+8 SET PSUDIV=PSUFACN
DO GETDIV^PSUV3
IF PSUDIVNM'=""
Begin DoDot:2
+9 SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUF2
End DoDot:2
+10 IF PSUDIVNM=""
SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUF2
End DoDot:1
+11 ;
MMDRUG ; summary by drug
+1 KILL ^XTMP(PSUUDSUB,"RECORDS"),^XTMP(PSUUDSUB,"DRUGSUM")
+2 ;Don't print if user wants summary only
if PSUSMRY
QUIT
+3 ;
+4 KILL PSUXMY
+5 MERGE PSUXMY=PSUXMYS2
+6 SET PSUFACN=""
+7 FOR
SET PSUFACN=$ORDER(^XTMP(PSUUDSUB,"DRUG",PSUFACN))
if PSUFACN=""
QUIT
Begin DoDot:1
+8 SET X="Unit Dose Statistical Data for "_PSURP("START")_" through "_PSURP("END")
+9 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,1)=X
+10 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,2)=" "
+11 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,3)=" "
+12 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,4)=$EXTRACT(SPACES,1,50)_"Total"_$EXTRACT(SPACES,1,11)_"Total"
+13 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,5)=$EXTRACT(SPACES,1,50)_"Dispensed"_$EXTRACT(SPACES,1,7)_"Dispensed"
+14 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,6)="Drug Name"_$EXTRACT(SPACES,1,41)_"Units"_$EXTRACT(SPACES,1,11)_"Cost"
+15 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,7)=$EXTRACT(DASH,1,75)
+16 SET PSUX=""
SET PSULN=7
SET PSUGTC=0
SET PSUGTU=0
+17 FOR
SET PSUX=$ORDER(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUX))
if PSUX=""
QUIT
Begin DoDot:2
+18 SET PSUR=^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUX)
+19 SET PSUTU=$PIECE(PSUR,U,1)
SET PSUPPU=$PIECE(PSUR,U,2)
SET PSUNON=$PIECE(PSUR,U,3)
SET PSUNFI=$PIECE(PSUR,U,4)
+20 SET PSUTC=PSUTU*PSUPPU
SET PSUGTC=PSUGTC+PSUTC
SET PSUGTU=PSUGTU+PSUTU
+21 SET PSUDN=$EXTRACT(PSUX,1,40)_" "_$SELECT(PSUNON="N/F":"*",1:"")_$SELECT(PSUNFI=0:"#",1:"")
+22 SET PSULN=PSULN+1
+23 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=$EXTRACT(PSUDN_SPACES,1,45)_$JUSTIFY(PSUTU,12,2)_" "_$JUSTIFY(PSUTC,12,2)
End DoDot:2
+24 SET PSULN=PSULN+1
+25 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=$EXTRACT(DASH,1,75)
+26 SET PSULN=PSULN+1
+27 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="Totals:"_$EXTRACT(SPACES,1,38)_$JUSTIFY(PSUGTU,12,2)_" "_$JUSTIFY(PSUGTC,12,2)
+28 SET PSULN=PSULN+1
+29 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)=" "
+30 SET PSULN=PSULN+1
+31 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="* Non-Formulary"
+32 SET PSULN=PSULN+1
+33 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSULN)="# Not on National Formulary"
End DoDot:1
+34 MERGE ^XTMP(PSUUDSUB,"RECORDS")=^XTMP(PSUUDSUB,"DRUGSUM")
+35 DO EN^PSUUD4(.PSUMSGT)
+36 KILL ^XTMP(PSUUDSUB,"RECORDS")
+37 ;
+38 QUIT
