- 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
- 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
