Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUV1

PSUV1.m

Go to the documentation of this file. 
  1. PSUV1 ;BIR/CFL - Extract Data of PBM IV Module ;25 AUG 1998
  1.  ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1.  ;DBIAs
  1.  ; Reference to file #55   supported by DBIA 2497
  1.  ; Reference to file #59.5 supported by DBIA 2499
  1.  ; Reference to file #40.8 supported by DBIA 2438
  1.  ; Reference to file #7    supported by DBIA 2495
  1.  ; Reference to file #49   supported by DBIA 10093
  1.  ; Reference to file #52.6 supported by DBIA 436
  1.  ; Reference to file #50   supported by DBIA 221
  1.  ; Reference to file #52.7 supported by DBIA 437
  1.  ; Reference to file #2    supported by DBIA 10035 and 2701
  1.  ; Reference to file #200  supported by DBIA 10060
  1.  ;
  1. IVDATA ;Loop through IV data
  1.  N PSUDOC1
  1.  K PSUSSNA,PSUORDA
  1.  ; *34 |==>
  1.  S PSUIVDT=PSUSDT\1-.0001 ;use 1st day of extract for 'stop date' scan
  1.  S PSUTEDT=PSUEDT\1+.2359
  1.  F  S PSUIVDT=$O(^PS(55,"AIV",PSUIVDT)) Q:'PSUIVDT  D
  1.  .S PSUPDA=""
  1.  .F  S PSUPDA=$O(^PS(55,"AIV",PSUIVDT,PSUPDA)) Q:'PSUPDA  D
  1.  ..S PSUODA=""
  1.  ..F  S PSUODA=$O(^PS(55,"AIV",PSUIVDT,PSUPDA,PSUODA)) Q:'PSUODA  D
  1.  ...S ^XTMP("PSU_"_PSUJOB,"PSUHLD",PSUODA)=""   ;should be the D0's for file 55.01 ; <==| *34
  1.  ...S COUNT=0
  1.  ...S PSUDIV=""
  1.  ...K PSUIV
  1.  ...; screen test patients
  1.  ...Q:$$TESTPAT^PSUTL1(PSUPDA)
  1.  ...S XX=$$VALI^PSUTL(55.01,"PSUPDA,PSUODA",.02) Q:XX>PSUTEDT  ;*34
  1.  ...K PSUIV ;*34
  1.  ...D GETS^PSUTL(55.01,"PSUPDA,PSUODA",".01;.02;.03;.04;.06;.08;.09;.22;104;106;108","PSUIV","I")
  1.  ...;.01-Order num;.02-Start Dt;.03-Stop Dt;.04-Type;.06-Provider
  1.  ...;104-Ward;106-Chemotherapy Type;108-Intermittent Syringe
  1.  ...Q:'$D(PSUIV)
  1.  ...;VMP OIFO BAY PINES;ELR;PSU*3*35 ADDED NEXT LINE
  1.  ...Q:$G(PSUIV(.06,"I"))'>0
  1.  ...S ^XTMP("PSU_"_PSUJOB,"PSUPIEN",PSUPDA)=""     ;Patient IEN's ;*34
  1.  ...D MOVEI^PSUTL("PSUIV")
  1.  ...S PSUIV(.02)=PSUIV(.02)\1
  1.  ...S PSUIV(.03)=PSUIV(.03)\1
  1.  ...I PSUIV(.22)'="" S PSUDIV=$$VALI^PSUTL(59.5,PSUIV(.22),.02)
  1.  ...S PSUFAC=$$VALI^PSUTL(40.8,PSUDIV,1) S:PSUFAC="" PSUFAC=PSUSNDR
  1.  ...S PSUFAC(PSUFAC)=""
  1.  ...S PSUOUTP=$S(PSUIV(104)=.5:"Y",1:"N")
  1.  ...S DFN=PSUPDA D PID^VADPT
  1.  ...S PSUSSN=$TR(VA("PID"),"^-","")
  1.  ...D ICN
  1.  ...K PSUDOC
  1.  ...D GETS^PSUTL(200,"PSUIV(.06)","9;29;53.5","PSUDOC","I")
  1.  ...D MOVEI^PSUTL("PSUDOC")
  1.  ...I $G(PSUDOC(9))="" S PSUVSSN1=999999999
  1.  ...I $G(PSUDOC(9))'="" S PSUVSSN1=PSUDOC(9)
  1.  ...S ^XTMP("PSU_"_PSUJOB,"PSUPDR",PSUVSSN1,PSUIV(.06))=""
  1.  ...S (PSUPCLS,PSUSP1,PSUSP2)=""
  1.  ...I $D(PSUDOC(53.5)),PSUDOC(53.5)'="" D
  1.  ....S PSUPCLS=$$VALI^PSUTL(7,PSUDOC(53.5),1)
  1.  ....I PSUPCLS="" S PSUPCLS=$$VALI^PSUTL(7,PSUDOC(53.5),.01)
  1.  ...S PSUPSV=$S($L($G(PSUDOC(29))):$$VAL^PSUTL(49,PSUDOC(29),.01),1:"")
  1.  ...S PSUPSV=$$UPPER^PSUTL(PSUPSV),PSUSERV=""
  1.  ...I $L(PSUPSV),$D(PSECT(PSUPSV)) S PSUSERV=PSECT(PSUPSV)
  1.  ...S SPECPTR=$$GET^XUA4A72(PSUIV(.06),PSUIVDT)
  1.  ...S PSUSP1=$P($G(SPECPTR),U,3),PSUSP2=$P($G(SPECPTR),U,4)
  1.  ...D OCCAMT
  1.  ...I PSUFND D
  1.  ....D GETRATE^PSUV2(PSUIV(.04))
  1.  ....D SETTOT
  1.  ....S RECTYP=""
  1.  ....D ADDTIV
  1.  ....D SOLUTN
  1.  I $D(^XTMP(PSUIVSUB,"RECORDS")) D SETSUM^PSUV2
  1.  Q
  1.  ;
  1. ICN ;Find patient ICN 
  1.  ;
  1.  N PSUPICN,PSUPICN1,PSUICN
  1.  S PSUPTN=0
  1.  I $G(PSUSSN),PSUSSN'="" D
  1.  .F  S PSUPTN=$O(^DPT("SSN",PSUSSN,PSUPTN)) Q:PSUPTN=""  D
  1.  ..S PSUPICN1=$$GETICN^MPIF001(PSUPTN) D
  1.  ...I PSUPICN1'[-1 D
  1.  ....S ^XTMP("PSU_"_PSUJOB,"PSUPICN")=PSUPICN1
  1.  ...I PSUPICN1[-1 S ^XTMP("PSU_"_PSUJOB,"PSUPICN")=""
  1.  Q
  1.  ;
  1.  ;
  1. OCCAMT ;Calculate the number of dispensing occurrences
  1.  S (PSUFND,PSUDISP,PSUPULL,OCC,PSUDISPT,PSURECT,PSUDEST,PSUCAN)=0
  1.  F  S OCC=$O(^PS(55,PSUPDA,"IV",PSUODA,"LAB",OCC)) Q:'OCC  D
  1.  .K PSUOCC
  1.  .D GETS^PSUTL(55.1111,"PSUPDA,PSUODA,OCC","1;2;4;6","PSUOCC","I")
  1.  .D MOVEI^PSUTL("PSUOCC")
  1.  .S PSUOCC(1)=PSUOCC(1)\1
  1.  .I PSUOCC(1)<PSUSDT!(PSUOCC(1)>PSUTEDT) Q  ;*34
  1.  .S PSUFND=1
  1.  .I $G(PSUOCC(6))=1,$G(PSUOCC(2))=1 D
  1.  ..S PSUDISP=PSUDISP+$G(PSUOCC(4))
  1.  ..S PSUDISPT=PSUDISP                        ;Total IV dispensed
  1.  ..S PSUPULL=PSUPULL+$G(PSUOCC(4))
  1.  ..S ^XTMP(PSUIVSUB,"TYPE_"_PSUIV(.04),PSUFAC)=PSUOCC(4)+$G(^XTMP(PSUIVSUB,"TYPE_"_PSUIV(.04),PSUFAC))
  1.  ..I PSUOUTP="Y" D  ; Total outpatient IV's dispensed
  1.  ...S ^XTMP(PSUIVSUB,"ODISP",PSUFAC)=$G(^XTMP(PSUIVSUB,"ODISP",PSUFAC))+PSUOCC(4)
  1.  .;I PSUOCC(2)=2!(PSUOCC(2)=4) S PSUDISP=PSUDISP-PSUOCC(4)
  1.  .I PSUOCC(6)=1,PSUOCC(2)=2 D
  1.  ..S PSURECT=$G(PSURECT)+PSUOCC(4)               ;Total IV Recycled
  1.  .I PSUOCC(6)=1,PSUOCC(2)=3 D
  1.  ..S PSUDEST=$G(PSUDEST)+PSUOCC(4)               ;Total IV Destroyed
  1.  .I PSUOCC(6)=1,PSUOCC(2)=4 D
  1.  ..S PSUCAN=$G(PSUCAN)+PSUOCC(4)                 ;Total IV Cancelled
  1.  .I PSUOCC(6)=1 D
  1.  ..I (PSUOCC(2)=2)!(PSUOCC(2)=4) S PSUDISP=PSUDISP-PSUOCC(4) ;Net disp
  1.  Q
  1. SETTOT ;Set totals
  1.  ; Total number of IV's ordered
  1.  S ^XTMP(PSUIVSUB,"ORD",PSUFAC)=$G(^XTMP(PSUIVSUB,"ORD",PSUFAC))+1
  1.  ; Total number of IV patients
  1.  I '$D(^XTMP(PSUIVSUB,"PAT",PSUSSN,PSUFAC)) D
  1.  .S ^XTMP(PSUIVSUB,"SSN",PSUFAC)=$G(^XTMP(PSUIVSUB,"SSN",PSUFAC))+1
  1.  .S ^XTMP(PSUIVSUB,"PAT",PSUSSN,PSUFAC)=""
  1.  .S PSUDIV=PSUFAC D GETDIV^PSUV3 I PSUDIVNM'="" D
  1.  ..S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIVNM,PSUSSN)=""  ;Pt demo summary
  1.  .I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIV,PSUSSN)=""
  1.  I PSUOUTP="Y" D
  1.  .; Total outpatient IV's ordered
  1.  .S ^XTMP(PSUIVSUB,"OORD",PSUFAC)=$G(^XTMP(PSUIVSUB,"OORD",PSUFAC))+1
  1.  Q
  1. ADDTIV ;Loop through each additive
  1.  S (PSUNITS,ADTIV)=0
  1.  F  S ADTIV=$O(^PS(55,PSUPDA,"IV",PSUODA,"AD",ADTIV)) Q:'ADTIV  D
  1.  .K PSUADDTV,PSUGNRIC,PSUADD
  1.  .D GETS^PSUTL(55.02,"PSUPDA,PSUODA,ADTIV",".01;.02","PSUADDTV","I")
  1.  .D MOVEI^PSUTL("PSUADDTV")
  1.  .D GETS^PSUTL(52.6,"PSUADDTV(.01)",".01;1;7","PSUGNRIC","I")
  1.  .D MOVEI^PSUTL("PSUGNRIC")
  1.  .S PSUPNAM=PSUGNRIC(.01)
  1.  .S PSUDGU=$$VAL^PSUTL(52.6,PSUADDTV(.01),2)
  1.  .S PSUDGDA=PSUGNRIC(1)
  1.  .D GETS^PSUTL(50,"PSUDGDA",".01;2;20;21;22;25;31;51;52;3","PSUADD","I")
  1.  .D MOVEI^PSUTL("PSUADD")
  1.  .S PSUGNM=PSUADD(.01)
  1.  .S PSUDCLS=PSUADD(2)
  1.  .S PSUPRNM=PSUADD(21)
  1.  .S PSUNDC=PSUADD(31)
  1.  .S PSUNFI=PSUADD(51)
  1.  .S PSUNADR=PSUADD(20)
  1.  .S PSUNDCL=PSUADD(22)
  1.  .S PSUDEA=PSUADD(3)
  1.  .S PSUNAF=$S(PSUADD(52):"N/F",1:"")
  1.  .D SETVAR
  1.  .S PSUSTRN=+PSUADDTV(.02)
  1.  .;
  1.  .;DAM  Add AMIS Additive data
  1.  .N PSUTDSP1
  1.  .S PSUTDSP1=$G(PSUDISPT)*PSUSTRN       ;Total Additive units dispens
  1.  .;
  1.  .N PSURCY1
  1.  .S PSURCY1=$G(PSURECT)*PSUSTRN         ;Total Additive units recycled
  1.  .;
  1.  .N PSUDES1
  1.  .S PSUDES1=$G(PSUDEST)*PSUSTRN      ;Total Additive units destroyed
  1.  .;
  1.  .N PSUCAN1
  1.  .S PSUCAN1=$G(PSUCAN)*PSUSTRN         ;Total Additive units cancelled
  1.  .;END DAM
  1.  .S PSUNITS=PSUDISP*PSUSTRN
  1.  .S PSUBAGS=PSUPULL*PSUSTRN
  1.  .S PSUDCST=PSUGNRIC(7)
  1.  .S RECIND="A"
  1.  .D CALC
  1.  .D SETREC^PSUV2
  1.  .D SETDRUG^PSUV2
  1.  Q
  1. SOLUTN ;Loop through each solution
  1.  S (PSUNITS,SOLDA)=0 F  S SOLDA=$O(^PS(55,PSUPDA,"IV",PSUODA,"SOL",SOLDA)) Q:'SOLDA  D
  1.  .K PSUSOL,GENRIC,SOLDRUG
  1.  .D GETS^PSUTL(55.11,"PSUPDA,PSUODA,SOLDA",".01;1","PSUSOL","I")
  1.  .D MOVEI^PSUTL("PSUSOL")
  1.  .D GETS^PSUTL(52.7,"PSUSOL(.01)",".01;1;7","GENRIC","I")
  1.  .D MOVEI^PSUTL("GENRIC")
  1.  .S PSUPNAM=GENRIC(.01)
  1.  .S PSUDGU="ML"
  1.  .S PSUDGDA=GENRIC(1)
  1.  .D GETS^PSUTL(50,"PSUDGDA",".01;2;20;21;22;25;31;51;52;3","SOLDRUG","I")
  1.  .D MOVEI^PSUTL("SOLDRUG")
  1.  .S PSUGNM=SOLDRUG(.01)
  1.  .S PSUDCLS=SOLDRUG(2)
  1.  .S PSUPRNM=SOLDRUG(21)
  1.  .S PSUNDC=SOLDRUG(31)
  1.  .S PSUNFI=SOLDRUG(51)
  1.  .S PSUNADR=SOLDRUG(20)
  1.  .S PSUNDCL=SOLDRUG(22)
  1.  .S PSUDEA=SOLDRUG(3)
  1.  .S PSUNAF=$S(SOLDRUG(52):"N/F",1:"")
  1.  .D SETVAR
  1.  .S VOLUME=+PSUSOL(1)
  1.  .;
  1.  .;DAM ADD AMIS SOLUTION DATA
  1.  .N PSUTSOL1
  1.  .S PSUTSOL1=$G(PSUDISPT)*VOLUME    ;Total Solution units dispense
  1.  .;
  1.  .N PSUTRS1
  1.  .S PSUTRS1=$G(PSURECT)*VOLUME       ;Total Solution units recycl
  1.  .;
  1.  .N PSUTDS1
  1.  .S PSUTDS1=$G(PSUDEST)*VOLUME     ;Total Solution units destroyed
  1.  .;
  1.  .N PSUTCS1
  1.  .S PSUTCS1=$G(PSUCAN)*VOLUME        ;Total Solution units cancelled
  1.  .;END DAM
  1.  .S PSUNITS=PSUDISP*VOLUME
  1.  .S PSUBAGS=PSUPULL*VOLUME
  1.  .S PSUDCST=GENRIC(7)
  1.  .S RECIND="S"
  1.  .D CALC
  1.  .D SETREC^PSUV2
  1.  .D SETDRUG^PSUV2
  1.  Q
  1. SETVAR ;Setup common variables for IV Additives and Solutions
  1.  I PSUGNM="" S PSUGNM="UNKNOWN GENERIC NAME"
  1.  I PSUPRNM="" S PSUPRNM="UNKNOWN VA PRODUCT NAME"
  1.  I PSUNDC="" S PSUNDC="No NDC"
  1.  I PSUNFI=1 S PSUNFI="N/F"
  1.  S (PSIVNFI,PSIVNFR)=""
  1.  I $$VERSION^XPDUTL("PSN")'<4 D
  1.  .S PSIVNFI=$$FORMI^PSNAPIS(PSUNADR,PSUNDCL)
  1.  .S PSIVNFR=$$FORMR^PSNAPIS(PSUNADR,PSUNDCL)>0
  1.  Q
  1. CALC ;Do calculations for additives and solutions
  1.  S ^XTMP(PSUIVSUB,"CST",PSUFAC)=(PSUNITS*PSUDCST)+$G(^XTMP(PSUIVSUB,"CST",PSUFAC))
  1.  S RECTYP=""
  1.  S COUNT=COUNT+1
  1.  S:COUNT=1 RECTYP="P"
  1.  I PSUOUTP="Y" D
  1.  .S ^XTMP(PSUIVSUB,"OCST",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"OCST",PSUFAC))
  1.  I PSUIV(.04)="P" D
  1.  .S ^XTMP(PSUIVSUB,"SPIG",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SPIG",PSUFAC))
  1.  I PSUIV(.04)="A" D
  1.  .S ^XTMP(PSUIVSUB,"SADM",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SADM",PSUFAC))
  1.  I PSUIV(.04)="H" D
  1.  .S ^XTMP(PSUIVSUB,"SHYP",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SHYP",PSUFAC))
  1.  I PSUIV(.04)="S" D
  1.  .S ^XTMP(PSUIVSUB,"SSYR",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SSYR",PSUFAC))
  1.  I PSUIV(.04)="C" D
  1.  .S ^XTMP(PSUIVSUB,"SCHEM",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SCHEM",PSUFAC))
  1.  Q