VistA-FOIAVistA/r/PHARMACY_BENEFITS_MANAGEMEN.../PSUOP3.m

225 lines
8.9 KiB
Mathematica
Raw Permalink Normal View History

PSUOP3 ;BIR/CFL,TJH,PDW-PSU PBM Outpatient Pharmacy shared variables ;08/25/2003
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
; Reference to file #7 supported by DBIA 2495
; Reference to file #50 supported by DBIA 221
; Reference to file #59 supported by DBIA 2510
; Reference to file #200 supported by DBIA 10060
; Reference to file #49 supported by DBIA 10093
; Reference to file #52 supported by DBIA 2512
;
PROVDR ;Get provider data, site number and AMIS category
S PSUSITE=$S(PSUDIVP="":PSUSNDR,1:$$VALI^PSUTL(59,PSUDIVP,.06))
;
;Create storage global of division numbers and names for lab msgs.
S X=PSUSITE,DIC=59,DIC(0)="XM" D ^DIC
S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
;VMP OIFO BAY PINES;ELR;PSU*3.0*31
I '$L(PSUDIVNM) S X=PSUSITE D DIVNM^PSUOP6
S ^XTMP("PSU_"_PSUJOB,"DIV",PSUSITE)=PSUDIVNM
;
GETVAR ;Get shared variables
;Get AMIS workload category
S PSUPST=$$VALI^PSUTL(53,PSURXP,6)
S PSUSC=$S(PSUPST=1:"SC",PSUPST=2:"AA",PSUPST=3:"OT",PSUPST=4:"IP",1:"")
S:$$GET1^DIQ(52,PSURXIEN,201)="YES" PSUSC="NVA"
K PSUPROV
D GETS^PSUTL(200,PSUPRID,"9;29;53.5;53.6","PSUPROV","I")
I '$D(PSUPROV) D NOPROV Q
D MOVEI^PSUTL("PSUPROV")
S PSUPRSSN=PSUPROV(9)
I PSUPRSSN="" S PSUPRSSN=999999999
S ^XTMP("PSU_"_PSUJOB,"PSUPDR",PSUPRSSN,PSUPRID)=""
S PSUDOC(9)=PSUPRSSN
S PSUPTYP=$S(PSUPROV(53.6)=4:"F",1:"S")
S:$$GET1^DIQ(52,PSURXIEN,201)="YES" PSUPTYP="NVA"
S PSUPCLS="" I PSUPROV(53.5)'="" D
.S PSUPCLS=$$VALI^PSUTL(7,PSUPROV(53.5),1)
.I PSUPCLS="" S PSUPCLS=$$VALI^PSUTL(7,PSUPROV(53.5),.01)
S PSUPSV=$S($L(PSUPROV(29)):$$VAL^PSUTL(49,PSUPROV(29),.01),1:"")
S PSUPSV=$$UPPER^PSUTL(PSUPSV),PSUPSERV=""
I $L(PSUPSV),$D(PSECT(PSUPSV)) S PSUPSERV=PSECT(PSUPSV)
S PSUSPTY=$$GET^XUA4A72(PSUPRID,PSUFDT)
S PSUSP1=$P(PSUSPTY,U,3),PSUSP2=$P(PSUSPTY,U,4)
;
Q
;
NOPROV ; set up PSUPROV array when provider isn't found in ^VA(200
F I=9,29,53.5,53.6 S PSUPROV(I)=""
S (PSUPRSSN,PSUPTYP,PSUPCLS,PSUPSERV,PSUSP1,PSUSP2)=""
Q
GETDRUG ;Get drug data
K PSUDRUG
D GETS^PSUTL(50,PSUDR,".01;2;3;14.5;20;21;22;25;27;31;51;52","PSUDRUG","I")
D MOVEI^PSUTL("PSUDRUG")
I '$D(PSUDRUG) F I=.01,2,3,14.5,20,21,22,25,31,51,52 S PSUDRUG(I)=""
S PSUGNM=PSUDRUG(.01)
I PSUGNM="" S PSUGNM="Unknown Generic Name"
S PSUVANM=PSUDRUG(21)
I PSUVANM="" S PSUVANM="Unknown VA Product Name"
S PSUDEA=PSUDRUG(3)
S PSUNFI=$S(PSUDRUG(51)=1:"N/F",1:"")
S PSUDUN=PSUDRUG(14.5)
S PSUVACLS=PSUDRUG(2)
S PSUNDCL=PSUDRUG(22)
S PSUNAF=$S(PSUDRUG(52):"N/F",1:"")
S PSUNADR=PSUDRUG(20)
S PSUCMID=PSUDRUG(27)
;Get the National Formulary Indicator and Restriction
S (PSOPNFI,PSOPNFR)=""
I $$VERSION^XPDUTL("PSN")'<4 D
.S PSOPNFI=$$FORMI^PSNAPIS(PSUNADR,PSUNDCL)
.S PSOPNFR=$$FORMR^PSNAPIS(PSUNADR,PSUNDCL)
GETDRUGQ Q
;
SETREC ;Set the record into the ^XTMP global
S:PSUDIVP="" PSUDIVP=PSUSNDR
S REC1="^",REC2="*",PSU2U="^",REC3="*",REC4="*",REC5="*",REC6="*"
S REC1=REC1_$TR(PSUSITE,"^","'")_PSU2U_$TR(PSUFD,"^","'")_PSU2U
S REC1=REC1_$TR(PSURELDT,"^","'")_PSU2U_$TR(PSURXN,"^","'")_PSU2U
S REC1=REC1_$TR(PSUSC,"^","'")_PSU2U_PSUSSN_PSU2U_$TR(PSUVANM,"^","'")_PSU2U
S REC1=REC1_$TR(PSUVACLS,"^","'")_PSU2U_$TR(PSUGNM,"^","'")_PSU2U
S REC1=REC1_$TR(PSUNDC,"^","'")_PSU2U_$TR(PSUNFI,"^","'")_PSU2U
S REC1=REC1_$TR(PSOPNFI,"^","'")_PSU2U_$TR(PSOPNFR,"^","'")_PSU2U
S REC1=REC1_$TR(PSUDEA,"^","'")_PSU2U_$TR(PSUTYP,"^","'")_PSU2U
S REC1=REC1_$TR(PSUCMOP,"^","'")_PSU2U_$TR(PSUMW,"^","'")_PSU2U
S REC1=REC1_$TR(PSUPRSSN,"^","'")_PSU2U_$TR(PSUPTYP,"^","'")_PSU2U
S REC1=REC1_PSU2U_$TR(PSUWPC,"^","'")_PSU2U
S REC1=REC1_$TR(PSUDUN,"^","'")_PSU2U_$TR(PSUDRCT,"^","'")_PSU2U
S REC1=REC1_$TR(PSUDS,"^","'")_PSU2U_$TR(PSUQTY,"^","'")_PSU2U_PSUNAF_U
D ICN^PSUV2 S PSUPICN=$G(^XTMP("PSU_"_PSUJOB,"PSUPICN"))
S REC1=REC1_$G(PSUPICN)_PSU2U_PSUPRID_PSU2U_$G(PSUCAN)_"^"
;
;
;**Add AMIS data
;
S REC2=REC2_$G(PSUCLN)_PSU2U ;Clinic
;
S REC2=REC2_$G(PSUCMID)_PSU2U ;CMOP ID
;
I $G(PSUFP) D
.S REC2=REC2_PSUSITE_$G(PSUFP)_PSU2U ;Finishing person
I '$G(PSUFP) D
.S REC2=REC2_PSU2U
;
;Login dates for new orders, refills, and partials
I PSUTYP="N" S REC2=REC2_$G(PSUORDT)_PSU2U ;New fills
I PSUTYP="R" S REC2=REC2_$G(PSUREDT)_PSU2U ;Refills
I PSUTYP="P" S REC2=REC2_$G(PSUPDT)_PSU2U ;Partials
;
S REC2=REC2_$G(PSUCOPAY)_PSU2U ;Copay status
S REC2=REC2_$E($G(PSUPI),1,80)_PSU2U ;Expanded Instructions
S REC2=REC2_$G(PSUMDFLG)_PSU2U ;Multidose Flag
;
;**Single dose date and first dose of multidose data
;are in the following records**
;
S REC2=REC2_$G(PSUDSG)_PSU2U ;Dosage Ordered
S REC2=REC2_$G(PSUDISPU)_PSU2U ;Dispense units
S REC2=REC2_$G(PSUNITS)_PSU2U ;Units
S REC2=REC2_$G(PSUNOUN)_PSU2U ;Noun
S REC2=REC2_$G(PSUDUR)_PSU2U ;Duration
S REC2=REC2_$G(PSUCONJ)_PSU2U ;Conjunction
S REC2=REC2_$G(PSUROUT)_PSU2U ;Route
S REC2=REC2_$G(PSUSCHED)_PSU2U ;Schedule
S REC2=REC2_$G(PSUVERB)_PSU2U ;Verb
;
;**End of Single dose/First multidose data
;
;**The following are single dose globals for MailMan
;
S PSURCT=1+$P($G(^XTMP(PSUOPSUB,"DATA",PSUSITE,PSURXIEN,0)),U,1)
S ^XTMP(PSUOPSUB,"DATA",PSUSITE,PSURXIEN,PSURCT,1)=REC1
S ^XTMP(PSUOPSUB,"DATA",PSUSITE,PSURXIEN,PSURCT,2)=REC2
S $P(^XTMP(PSUOPSUB,"DATA",PSUSITE,PSURXIEN,0),U,1)=PSURCT
I (($E(PSUOPVER)=6)&(PSUTYP="P"))!($E(PSUOPVER)>6) S ^XTMP(PSUOPSUB,"RXIEN",PSURXIEN)=""
;**End of single dose globals for MailMan
;
;**Multidose records
;
I $D(PSUMDFLG) D
.S PSUD1=1
.F S PSUD1=$O(^TMP("PSOR",$J,PSURXIEN,"MI",PSUD1)) Q:PSUD1="" D
..S PSUAMMD=^TMP("PSOR",$J,PSURXIEN,"MI",PSUD1,0)
..D MULTI^PSUOPAM ;Set multidose variables
..I $L(REC3)>180 D REC4 Q
..S REC3=REC3_$G(PSUDSGMD)_PSU2U ;Dosage Ordered
..S REC3=REC3_$G(PSUDSPMD)_PSU2U ;Dispense units
..S REC3=REC3_$G(PSUNITMD)_PSU2U ;Units
..S REC3=REC3_$G(PSUNMD)_PSU2U ;Noun
..S REC3=REC3_$G(PSUDURMD)_PSU2U ;Duration
..S REC3=REC3_$G(PSUCONMD)_PSU2U ;Conjunction
..S REC3=REC3_$G(PSURTMD)_PSU2U ;Route
..S REC3=REC3_$G(PSUSCHMD)_PSU2U ;Schedule
..S REC3=REC3_$G(PSUVRBMD)_PSU2U ;Verb
..;
..;**End of Multidose data
..;**End AMIS data
..;
..;
..;global for multidose records for MailMan
I $D(PSUMDFLG) D
.S PSURCT=1+$P($G(^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,0)),U,1)
.S ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,1)=REC1
.S ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,2)=REC2
.S ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,3)=REC3
.I $L(REC4)>1 S ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,4)=REC4
.I $L(REC5)>1 S ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,5)=REC5
.I $L(REC6)>1 S ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,6)=REC6
.;
.S $P(^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,0),U,1)=PSURCT
;
I '$D(^XTMP("PSU_"_PSUJOB,"PSUOPFLG")) D
.D LAB^PSULR0("OP",PSUSITE,PSURXIEN,DFN,PSUGNM,PSUVACLS)
SUMDRUG ; total drug info for summary report
S PSUVARS="PSUTPART,PSUTFIL,PSUTRFIL,PSUTCST,PSUTQTY"
S PSUREC=$G(^XTMP(PSUOPSUB,"DRUG",PSUSITE,PSUGNM,PSUCMOP))
F I=1:1:5 S @$P(PSUVARS,",",I)=+$P(PSUREC,U,I)
I PSUTYP="P" S PSUTPART=PSUTPART+1
I PSUTYP="N" S PSUTFIL=PSUTFIL+1
I PSUTYP="R" S PSUTRFIL=PSUTRFIL+1
S PSUTQTY=PSUQTY+PSUTQTY
S PSUTCST=(PSUDRCT*PSUQTY)+PSUTCST
S REC=PSUTPART_U_PSUTFIL_U_PSUTRFIL_U_$J(PSUTCST,0,2)_U_$J(PSUTQTY,0,2)
S $P(REC,U,6)=$S(PSUNFI="N/F":"*",1:"")
S $P(REC,U,7)=$S(PSOPNFI="0":"#",1:"")
S ^XTMP(PSUOPSUB,"DRUG",PSUSITE,PSUGNM,PSUCMOP)=REC
Q
;
REC4 ;Multidose records greater than 200 characters in length
;
I $L(REC4)>180 D REC5 Q
S REC4=REC4_$G(PSUDSGMD)_PSU2U ;Dosage Ordered
S REC4=REC4_$G(PSUDSPMD)_PSU2U ;Dispense units
S REC4=REC4_$G(PSUNITMD)_PSU2U ;Units
S REC4=REC4_$G(PSUNMD)_PSU2U ;Noun
S REC4=REC4_$G(PSUDURMD)_PSU2U ;Duration
S REC4=REC4_$G(PSUCONMD)_PSU2U ;Conjunction
S REC4=REC4_$G(PSURTMD)_PSU2U ;Route
S REC4=REC4_$G(PSUSCHMD)_PSU2U ;Schedule
S REC4=REC4_$G(PSUVRBMD)_PSU2U ;Verb
Q
REC5 ;
I $L(REC5)>180 D REC6 Q
S REC5=REC5_$G(PSUDSGMD)_PSU2U ;Dosage Ordered
S REC5=REC5_$G(PSUDSPMD)_PSU2U ;Dispense units
S REC5=REC5_$G(PSUNITMD)_PSU2U ;Units
S REC5=REC5_$G(PSUNMD)_PSU2U ;Noun
S REC5=REC5_$G(PSUDURMD)_PSU2U ;Duration
S REC5=REC5_$G(PSUCONMD)_PSU2U ;Conjunction
S REC5=REC5_$G(PSURTMD)_PSU2U ;Route
S REC5=REC5_$G(PSUSCHMD)_PSU2U ;Schedule
S REC5=REC5_$G(PSUVRBMD)_PSU2U ;Verb
Q
REC6 ;
S REC6=REC6_$G(PSUDSGMD)_PSU2U ;Dosage Ordered
S REC6=REC6_$G(PSUDSPMD)_PSU2U ;Dispense units
S REC6=REC6_$G(PSUNITMD)_PSU2U ;Units
S REC6=REC6_$G(PSUNMD)_PSU2U ;Noun
S REC6=REC6_$G(PSUDURMD)_PSU2U ;Duration
S REC6=REC6_$G(PSUCONMD)_PSU2U ;Conjunction
S REC6=REC6_$G(PSURTMD)_PSU2U ;Route
S REC6=REC6_$G(PSUSCHMD)_PSU2U ;Schedule
S REC6=REC6_$G(PSUVRBMD)_PSU2U ;Verb
Q