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

PSUAR2.m

Go to the documentation of this file.
  1. PSUAR2 ;BIR/PDW - ASSEMBLE AR/WS RECORDS FOR TRANSMISSION ;10 JUL 1999
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ; DBIA(s)
  1. ; Reference to file #50 supported by DBIA 221
  1. ;
  1. EN ;EP Build ("RECORDS") from scan of ^XTMP(PSUARSUB,"DIV_DRUG",Drug,Div)=Total
  1. S PSUDRDA=0,PSULC=0,PSUDIVDA=0
  1. K ^XTMP(PSUARSUB,"RECORDS")
  1. K ^XTMP(PSUARSUB,"DRUG_TOTAL")
  1. F S PSUDIVDA=$O(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIVDA)) Q:PSUDIVDA="" D DRUGSCAN
  1. Q
  1. ;
  1. DRUGSCAN ;EP Scan for Drugs within division
  1. S PSUDDRDA=0,PSULC=0 ;**1
  1. F S PSUDRDA=$O(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIVDA,PSUDRDA)) Q:PSUDRDA'>0 S PSUTOT=^(PSUDRDA) D
  1. . S PSULC=PSULC+1
  1. . S ^XTMP(PSUARSUB,"RECORDS",PSUDIVDA,PSULC)=$$RECORD(PSUDRDA,PSUDIVDA,PSUTOT)
  1. . S X=$G(^XTMP(PSUARSUB,"DRUG_TOTAL",PSUDRDA))
  1. . S ^XTMP(PSUARSUB,"DRUG_TOTAL",PSUDRDA)=X+PSUTOT
  1. Q
  1. ;
  1. RECORD(PSUDRDA,PSUDIV,PSUTOT) ;EP Return record assembled
  1. ;
  1. ; @x@(Fld) holds the appropriate field values from the drug file 50
  1. ;
  1. N PSU,PSUP,PSUSEND,PSUDIVH
  1. I '$D(^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA)) D DRUG(PSUDRDA)
  1. S X="^XTMP(PSUARSUB,""PSUDRUG_DET"",PSUDRDA)"
  1. ; piece = value @X@(field from file 50)
  1. ; Process for sender being division or site
  1. S PSUSEND=PSUDIV,PSUDIVH=""
  1. I PSUDIV["_0H" S PSUSEND=$G(PSUSNDR),PSUDIVH="H"
  1. S PSU(2)=PSUSEND
  1. S PSU(3)=PSUDIVH
  1. S PSU(4)=$G(PSUMON)
  1. S PSU(5)=@X@(21)
  1. S PSU(6)=@X@(2)
  1. S PSU(7)=@X@(31)
  1. S PSU(8)=@X@(.01)
  1. S PSU(9)=@X@(51)
  1. S PSU(10)=@X@(99999.17) ;indicator for National Formulary
  1. S PSU(11)=@X@(99999.18) ;Indicator for National Formulary Restriction
  1. S PSU(12)=@X@(14.5)
  1. S PSU(13)=@X@(16)
  1. S PSU(14)=@X@(301)
  1. S PSU(15)=@X@(302)
  1. S PSU(16)=$G(PSUTOT)
  1. S PSU(17)=@X@(52)
  1. S PSU(18)=@X@(3)
  1. S PSU(19)=$G(PSUTDSP(PSUDIVDA,PSUDRDA)) ;Quantity Dispensed
  1. S PSU(20)=$G(PSUTRET(PSUDIVDA,PSUDRDA)) ;Quantity Returned
  1. S PSUP=0
  1. F S PSUP=$O(PSU(PSUP)) Q:PSUP'>0 S PSU(PSUP)=$TR(PSU(PSUP),"^","'")
  1. S PSUP=0
  1. F S PSUP=$O(PSU(PSUP)) Q:PSUP'>0 S $P(PSU,"^",PSUP)=PSU(PSUP)
  1. S PSU=PSU_"^"
  1. Q PSU
  1. ;
  1. DRUG(PSUDRDA) ;EP assemble from file 50+ needed fields
  1. ; PSUDRDA is da for the DRUG in file 50 from (58.52,.01)
  1. ; Store the fields in ^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDDA,Field)=value
  1. N PSUDRUG,PSUNDF
  1. D GETS^PSUTL(50,PSUDRDA,".01;2;14.5;15;16;20;21;22;25;31;51;301;302;52;3","PSUDRUG","I")
  1. ; Move PSUDRUG(Field,"I") value to PSUDRUG(Field) nodes
  1. D MOVEI^PSUTL("PSUDRUG")
  1. ;
  1. PROCESS ;Further process field values into their final values
  1. ;
  1. S PSUDRUG(51)=$$VAL^PSUTL(50,PSUDRDA,51)
  1. I PSUDRUG(31)="" S PSUDRUG(31)="No NDC"
  1. I PSUDRUG(21)="" S PSUDRUG(21)="Unknown VA Product Name"
  1. I PSUDRUG(.01)="" S PSUDRUG(.01)="Unknown Generic Name"
  1. S X=+PSUDRUG(301)
  1. S PSUDRUG(301)=$S(X=0:"03 or 04",X=1:"06 or 07",2:"17",3:"22",1:X)
  1. I PSUDRUG(52) S PSUDRUG(52)="N/F"
  1. ;
  1. ; Process VA DRUG CLASS
  1. ; Test for new NDF software s PSUNDF=1 if yes
  1. S PSUNDF=0
  1. I $$VERSION^XPDUTL("PSN")'<4 S PSUNDF=1
  1. ;
  1. ; Process for National Formulary Indicator & Restrictions
  1. ; Put into node 99999.17 for file(50.68,17)
  1. ; Put into node 99999.18 for file(50.68,18)
  1. ; test to see if file 50.68 exists (comes in with V4 of NDF)
  1. S PSUDRUG(99999.17)=""
  1. S PSUDRUG(99999.18)=""
  1. I 'PSUNDF G STORE
  1. ; Process for National Formulary Indicator from VA Product Name file
  1. S PSUVPNDA=PSUDRUG(22)
  1. I PSUNDF S PSUDRUG(99999.17)=$$FORMI^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
  1. ; Process for National Formulary Restriction
  1. I PSUNDF S PSUDRUG(99999.18)=$$FORMR^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
  1. K PSUNFR
  1. ;
  1. STORE ;Store the processed values into ^TMP
  1. M ^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA)=PSUDRUG
  1. Q
  1. ;
  1. REC ;EP Move PSUAR_RECORDS to PSUAREC)
  1. M ^XTMP(PSUARSUB,"PSUAREC")=^XTMP(PSUARSUB,"RECORDS",$J)
  1. Q