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