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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUOP3 9374 printed Dec 13, 2024@02:28:09 Page 2
PSUOP3 ;BIR/CFL,TJH,PDW-PSU PBM Outpatient Pharmacy shared variables ;08/25/2003
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ; Reference to file #7 supported by DBIA 2495
+4 ; Reference to file #50 supported by DBIA 221
+5 ; Reference to file #59 supported by DBIA 2510
+6 ; Reference to file #200 supported by DBIA 10060
+7 ; Reference to file #49 supported by DBIA 10093
+8 ; Reference to file #52 supported by DBIA 2512
+9 ;
PROVDR ;Get provider data, site number and AMIS category
+1 SET PSUSITE=$SELECT(PSUDIVP="":PSUSNDR,1:$$VALI^PSUTL(59,PSUDIVP,.06))
+2 ;
+3 ;Create storage global of division numbers and names for lab msgs.
+4 SET X=PSUSITE
SET DIC=59
SET DIC(0)="XM"
DO ^DIC
+5 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(59,X,.01)
+6 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
+7 IF '$LENGTH(PSUDIVNM)
SET X=PSUSITE
DO DIVNM^PSUOP6
+8 SET ^XTMP("PSU_"_PSUJOB,"DIV",PSUSITE)=PSUDIVNM
+9 ;
GETVAR ;Get shared variables
+1 ;Get AMIS workload category
+2 SET PSUPST=$$VALI^PSUTL(53,PSURXP,6)
+3 SET PSUSC=$SELECT(PSUPST=1:"SC",PSUPST=2:"AA",PSUPST=3:"OT",PSUPST=4:"IP",1:"")
+4 if $$GET1^DIQ(52,PSURXIEN,201)="YES"
SET PSUSC="NVA"
+5 KILL PSUPROV
+6 DO GETS^PSUTL(200,PSUPRID,"9;29;53.5;53.6","PSUPROV","I")
+7 IF '$DATA(PSUPROV)
DO NOPROV
QUIT
+8 DO MOVEI^PSUTL("PSUPROV")
+9 SET PSUPRSSN=PSUPROV(9)
+10 IF PSUPRSSN=""
SET PSUPRSSN=999999999
+11 SET ^XTMP("PSU_"_PSUJOB,"PSUPDR",PSUPRSSN,PSUPRID)=""
+12 SET PSUDOC(9)=PSUPRSSN
+13 SET PSUPTYP=$SELECT(PSUPROV(53.6)=4:"F",1:"S")
+14 if $$GET1^DIQ(52,PSURXIEN,201)="YES"
SET PSUPTYP="NVA"
+15 SET PSUPCLS=""
IF PSUPROV(53.5)'=""
Begin DoDot:1
+16 SET PSUPCLS=$$VALI^PSUTL(7,PSUPROV(53.5),1)
+17 IF PSUPCLS=""
SET PSUPCLS=$$VALI^PSUTL(7,PSUPROV(53.5),.01)
End DoDot:1
+18 SET PSUPSV=$SELECT($LENGTH(PSUPROV(29)):$$VAL^PSUTL(49,PSUPROV(29),.01),1:"")
+19 SET PSUPSV=$$UPPER^PSUTL(PSUPSV)
SET PSUPSERV=""
+20 IF $LENGTH(PSUPSV)
IF $DATA(PSECT(PSUPSV))
SET PSUPSERV=PSECT(PSUPSV)
+21 SET PSUSPTY=$$GET^XUA4A72(PSUPRID,PSUFDT)
+22 SET PSUSP1=$PIECE(PSUSPTY,U,3)
SET PSUSP2=$PIECE(PSUSPTY,U,4)
+23 ;
+24 QUIT
+25 ;
NOPROV ; set up PSUPROV array when provider isn't found in ^VA(200
+1 FOR I=9,29,53.5,53.6
SET PSUPROV(I)=""
+2 SET (PSUPRSSN,PSUPTYP,PSUPCLS,PSUPSERV,PSUSP1,PSUSP2)=""
+3 QUIT
GETDRUG ;Get drug data
+1 KILL PSUDRUG
+2 DO GETS^PSUTL(50,PSUDR,".01;2;3;14.5;20;21;22;25;27;31;51;52","PSUDRUG","I")
+3 DO MOVEI^PSUTL("PSUDRUG")
+4 IF '$DATA(PSUDRUG)
FOR I=.01,2,3,14.5,20,21,22,25,31,51,52
SET PSUDRUG(I)=""
+5 SET PSUGNM=PSUDRUG(.01)
+6 IF PSUGNM=""
SET PSUGNM="Unknown Generic Name"
+7 SET PSUVANM=PSUDRUG(21)
+8 IF PSUVANM=""
SET PSUVANM="Unknown VA Product Name"
+9 SET PSUDEA=PSUDRUG(3)
+10 SET PSUNFI=$SELECT(PSUDRUG(51)=1:"N/F",1:"")
+11 SET PSUDUN=PSUDRUG(14.5)
+12 SET PSUVACLS=PSUDRUG(2)
+13 SET PSUNDCL=PSUDRUG(22)
+14 SET PSUNAF=$SELECT(PSUDRUG(52):"N/F",1:"")
+15 SET PSUNADR=PSUDRUG(20)
+16 SET PSUCMID=PSUDRUG(27)
+17 ;Get the National Formulary Indicator and Restriction
+18 SET (PSOPNFI,PSOPNFR)=""
+19 IF $$VERSION^XPDUTL("PSN")'<4
Begin DoDot:1
+20 SET PSOPNFI=$$FORMI^PSNAPIS(PSUNADR,PSUNDCL)
+21 SET PSOPNFR=$$FORMR^PSNAPIS(PSUNADR,PSUNDCL)
End DoDot:1
GETDRUGQ QUIT
+1 ;
SETREC ;Set the record into the ^XTMP global
+1 if PSUDIVP=""
SET PSUDIVP=PSUSNDR
+2 SET REC1="^"
SET REC2="*"
SET PSU2U="^"
SET REC3="*"
SET REC4="*"
SET REC5="*"
SET REC6="*"
+3 SET REC1=REC1_$TRANSLATE(PSUSITE,"^","'")_PSU2U_$TRANSLATE(PSUFD,"^","'")_PSU2U
+4 SET REC1=REC1_$TRANSLATE(PSURELDT,"^","'")_PSU2U_$TRANSLATE(PSURXN,"^","'")_PSU2U
+5 SET REC1=REC1_$TRANSLATE(PSUSC,"^","'")_PSU2U_PSUSSN_PSU2U_$TRANSLATE(PSUVANM,"^","'")_PSU2U
+6 SET REC1=REC1_$TRANSLATE(PSUVACLS,"^","'")_PSU2U_$TRANSLATE(PSUGNM,"^","'")_PSU2U
+7 SET REC1=REC1_$TRANSLATE(PSUNDC,"^","'")_PSU2U_$TRANSLATE(PSUNFI,"^","'")_PSU2U
+8 SET REC1=REC1_$TRANSLATE(PSOPNFI,"^","'")_PSU2U_$TRANSLATE(PSOPNFR,"^","'")_PSU2U
+9 SET REC1=REC1_$TRANSLATE(PSUDEA,"^","'")_PSU2U_$TRANSLATE(PSUTYP,"^","'")_PSU2U
+10 SET REC1=REC1_$TRANSLATE(PSUCMOP,"^","'")_PSU2U_$TRANSLATE(PSUMW,"^","'")_PSU2U
+11 SET REC1=REC1_$TRANSLATE(PSUPRSSN,"^","'")_PSU2U_$TRANSLATE(PSUPTYP,"^","'")_PSU2U
+12 SET REC1=REC1_PSU2U_$TRANSLATE(PSUWPC,"^","'")_PSU2U
+13 SET REC1=REC1_$TRANSLATE(PSUDUN,"^","'")_PSU2U_$TRANSLATE(PSUDRCT,"^","'")_PSU2U
+14 SET REC1=REC1_$TRANSLATE(PSUDS,"^","'")_PSU2U_$TRANSLATE(PSUQTY,"^","'")_PSU2U_PSUNAF_U
+15 DO ICN^PSUV2
SET PSUPICN=$GET(^XTMP("PSU_"_PSUJOB,"PSUPICN"))
+16 SET REC1=REC1_$GET(PSUPICN)_PSU2U_PSUPRID_PSU2U_$GET(PSUCAN)_"^"
+17 ;
+18 ;
+19 ;**Add AMIS data
+20 ;
+21 ;Clinic
SET REC2=REC2_$GET(PSUCLN)_PSU2U
+22 ;
+23 ;CMOP ID
SET REC2=REC2_$GET(PSUCMID)_PSU2U
+24 ;
+25 IF $GET(PSUFP)
Begin DoDot:1
+26 ;Finishing person
SET REC2=REC2_PSUSITE_$GET(PSUFP)_PSU2U
End DoDot:1
+27 IF '$GET(PSUFP)
Begin DoDot:1
+28 SET REC2=REC2_PSU2U
End DoDot:1
+29 ;
+30 ;Login dates for new orders, refills, and partials
+31 ;New fills
IF PSUTYP="N"
SET REC2=REC2_$GET(PSUORDT)_PSU2U
+32 ;Refills
IF PSUTYP="R"
SET REC2=REC2_$GET(PSUREDT)_PSU2U
+33 ;Partials
IF PSUTYP="P"
SET REC2=REC2_$GET(PSUPDT)_PSU2U
+34 ;
+35 ;Copay status
SET REC2=REC2_$GET(PSUCOPAY)_PSU2U
+36 ;Expanded Instructions
SET REC2=REC2_$EXTRACT($GET(PSUPI),1,80)_PSU2U
+37 ;Multidose Flag
SET REC2=REC2_$GET(PSUMDFLG)_PSU2U
+38 ;
+39 ;**Single dose date and first dose of multidose data
+40 ;are in the following records**
+41 ;
+42 ;Dosage Ordered
SET REC2=REC2_$GET(PSUDSG)_PSU2U
+43 ;Dispense units
SET REC2=REC2_$GET(PSUDISPU)_PSU2U
+44 ;Units
SET REC2=REC2_$GET(PSUNITS)_PSU2U
+45 ;Noun
SET REC2=REC2_$GET(PSUNOUN)_PSU2U
+46 ;Duration
SET REC2=REC2_$GET(PSUDUR)_PSU2U
+47 ;Conjunction
SET REC2=REC2_$GET(PSUCONJ)_PSU2U
+48 ;Route
SET REC2=REC2_$GET(PSUROUT)_PSU2U
+49 ;Schedule
SET REC2=REC2_$GET(PSUSCHED)_PSU2U
+50 ;Verb
SET REC2=REC2_$GET(PSUVERB)_PSU2U
+51 ;
+52 ;**End of Single dose/First multidose data
+53 ;
+54 ;**The following are single dose globals for MailMan
+55 ;
+56 SET PSURCT=1+$PIECE($GET(^XTMP(PSUOPSUB,"DATA",PSUSITE,PSURXIEN,0)),U,1)
+57 SET ^XTMP(PSUOPSUB,"DATA",PSUSITE,PSURXIEN,PSURCT,1)=REC1
+58 SET ^XTMP(PSUOPSUB,"DATA",PSUSITE,PSURXIEN,PSURCT,2)=REC2
+59 SET $PIECE(^XTMP(PSUOPSUB,"DATA",PSUSITE,PSURXIEN,0),U,1)=PSURCT
+60 IF (($EXTRACT(PSUOPVER)=6)&(PSUTYP="P"))!($EXTRACT(PSUOPVER)>6)
SET ^XTMP(PSUOPSUB,"RXIEN",PSURXIEN)=""
+61 ;**End of single dose globals for MailMan
+62 ;
+63 ;**Multidose records
+64 ;
+65 IF $DATA(PSUMDFLG)
Begin DoDot:1
+66 SET PSUD1=1
+67 FOR
SET PSUD1=$ORDER(^TMP("PSOR",$JOB,PSURXIEN,"MI",PSUD1))
if PSUD1=""
QUIT
Begin DoDot:2
+68 SET PSUAMMD=^TMP("PSOR",$JOB,PSURXIEN,"MI",PSUD1,0)
+69 ;Set multidose variables
DO MULTI^PSUOPAM
+70 IF $LENGTH(REC3)>180
DO REC4
QUIT
+71 ;Dosage Ordered
SET REC3=REC3_$GET(PSUDSGMD)_PSU2U
+72 ;Dispense units
SET REC3=REC3_$GET(PSUDSPMD)_PSU2U
+73 ;Units
SET REC3=REC3_$GET(PSUNITMD)_PSU2U
+74 ;Noun
SET REC3=REC3_$GET(PSUNMD)_PSU2U
+75 ;Duration
SET REC3=REC3_$GET(PSUDURMD)_PSU2U
+76 ;Conjunction
SET REC3=REC3_$GET(PSUCONMD)_PSU2U
+77 ;Route
SET REC3=REC3_$GET(PSURTMD)_PSU2U
+78 ;Schedule
SET REC3=REC3_$GET(PSUSCHMD)_PSU2U
+79 ;Verb
SET REC3=REC3_$GET(PSUVRBMD)_PSU2U
+80 ;
+81 ;**End of Multidose data
+82 ;**End AMIS data
+83 ;
+84 ;
+85 ;global for multidose records for MailMan
End DoDot:2
End DoDot:1
+86 IF $DATA(PSUMDFLG)
Begin DoDot:1
+87 SET PSURCT=1+$PIECE($GET(^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,0)),U,1)
+88 SET ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,1)=REC1
+89 SET ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,2)=REC2
+90 SET ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,3)=REC3
+91 IF $LENGTH(REC4)>1
SET ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,4)=REC4
+92 IF $LENGTH(REC5)>1
SET ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,5)=REC5
+93 IF $LENGTH(REC6)>1
SET ^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,PSURCT,6)=REC6
+94 ;
+95 SET $PIECE(^XTMP(PSUOPSUB,"DATAMD",PSUSITE,PSURXIEN,0),U,1)=PSURCT
End DoDot:1
+96 ;
+97 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUOPFLG"))
Begin DoDot:1
+98 DO LAB^PSULR0("OP",PSUSITE,PSURXIEN,DFN,PSUGNM,PSUVACLS)
End DoDot:1
SUMDRUG ; total drug info for summary report
+1 SET PSUVARS="PSUTPART,PSUTFIL,PSUTRFIL,PSUTCST,PSUTQTY"
+2 SET PSUREC=$GET(^XTMP(PSUOPSUB,"DRUG",PSUSITE,PSUGNM,PSUCMOP))
+3 FOR I=1:1:5
SET @$PIECE(PSUVARS,",",I)=+$PIECE(PSUREC,U,I)
+4 IF PSUTYP="P"
SET PSUTPART=PSUTPART+1
+5 IF PSUTYP="N"
SET PSUTFIL=PSUTFIL+1
+6 IF PSUTYP="R"
SET PSUTRFIL=PSUTRFIL+1
+7 SET PSUTQTY=PSUQTY+PSUTQTY
+8 SET PSUTCST=(PSUDRCT*PSUQTY)+PSUTCST
+9 SET REC=PSUTPART_U_PSUTFIL_U_PSUTRFIL_U_$JUSTIFY(PSUTCST,0,2)_U_$JUSTIFY(PSUTQTY,0,2)
+10 SET $PIECE(REC,U,6)=$SELECT(PSUNFI="N/F":"*",1:"")
+11 SET $PIECE(REC,U,7)=$SELECT(PSOPNFI="0":"#",1:"")
+12 SET ^XTMP(PSUOPSUB,"DRUG",PSUSITE,PSUGNM,PSUCMOP)=REC
+13 QUIT
+14 ;
REC4 ;Multidose records greater than 200 characters in length
+1 ;
+2 IF $LENGTH(REC4)>180
DO REC5
QUIT
+3 ;Dosage Ordered
SET REC4=REC4_$GET(PSUDSGMD)_PSU2U
+4 ;Dispense units
SET REC4=REC4_$GET(PSUDSPMD)_PSU2U
+5 ;Units
SET REC4=REC4_$GET(PSUNITMD)_PSU2U
+6 ;Noun
SET REC4=REC4_$GET(PSUNMD)_PSU2U
+7 ;Duration
SET REC4=REC4_$GET(PSUDURMD)_PSU2U
+8 ;Conjunction
SET REC4=REC4_$GET(PSUCONMD)_PSU2U
+9 ;Route
SET REC4=REC4_$GET(PSURTMD)_PSU2U
+10 ;Schedule
SET REC4=REC4_$GET(PSUSCHMD)_PSU2U
+11 ;Verb
SET REC4=REC4_$GET(PSUVRBMD)_PSU2U
+12 QUIT
REC5 ;
+1 IF $LENGTH(REC5)>180
DO REC6
QUIT
+2 ;Dosage Ordered
SET REC5=REC5_$GET(PSUDSGMD)_PSU2U
+3 ;Dispense units
SET REC5=REC5_$GET(PSUDSPMD)_PSU2U
+4 ;Units
SET REC5=REC5_$GET(PSUNITMD)_PSU2U
+5 ;Noun
SET REC5=REC5_$GET(PSUNMD)_PSU2U
+6 ;Duration
SET REC5=REC5_$GET(PSUDURMD)_PSU2U
+7 ;Conjunction
SET REC5=REC5_$GET(PSUCONMD)_PSU2U
+8 ;Route
SET REC5=REC5_$GET(PSURTMD)_PSU2U
+9 ;Schedule
SET REC5=REC5_$GET(PSUSCHMD)_PSU2U
+10 ;Verb
SET REC5=REC5_$GET(PSUVRBMD)_PSU2U
+11 QUIT
REC6 ;
+1 ;Dosage Ordered
SET REC6=REC6_$GET(PSUDSGMD)_PSU2U
+2 ;Dispense units
SET REC6=REC6_$GET(PSUDSPMD)_PSU2U
+3 ;Units
SET REC6=REC6_$GET(PSUNITMD)_PSU2U
+4 ;Noun
SET REC6=REC6_$GET(PSUNMD)_PSU2U
+5 ;Duration
SET REC6=REC6_$GET(PSUDURMD)_PSU2U
+6 ;Conjunction
SET REC6=REC6_$GET(PSUCONMD)_PSU2U
+7 ;Route
SET REC6=REC6_$GET(PSURTMD)_PSU2U
+8 ;Schedule
SET REC6=REC6_$GET(PSUSCHMD)_PSU2U
+9 ;Verb
SET REC6=REC6_$GET(PSUVRBMD)_PSU2U
+10 QUIT
