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

PSUAR1.m

Go to the documentation of this file.
  1. PSUAR1 ;BIR/PDW - Start AR/WS Extract ;11 AUG 1999
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;;
  1. ;PSUDTDA - IEN FOR DATE
  1. ;PSUSDA - IEN FOR INPATIENT SITE
  1. ;PSUDRDA - IEN FOR DRUG
  1. ;PSUCDA - IEN FOR CATEGORY
  1. ;PSUDIV - IEN FOR DIVISION OR "NONE"
  1. ;
  1. ;DBIAs
  1. ; Reference to file #58.5 supported by DBIA 456
  1. ; Reference to file #58.1 supported by DBIA 2515
  1. ; Reference to file #59.4 supported by DBIA 2498
  1. ; Reference to file #44 supported by DBIA 2439
  1. ; Reference to file #40.8 supported by DBIA 2438
  1. ; Reference to file #59 supported by DBIA 1876
  1. ; Reference to file #59.7 supported by DBIA 2854
  1. ;
  1. EN ;EP MAIN ENTRY POINT
  1. ;
  1. K PSUTDSP,PSUTRET
  1. ;
  1. START ;Start date scan thru stats file
  1. S PSUSDT=PSUSDT-.1
  1. S PSUDT=PSUSDT
  1. S PSUEDT=PSUEDT\1+.24
  1. Q F S PSUDT=$O(^PSI(58.5,"B",PSUDT)) Q:'PSUDT Q:PSUDT>PSUEDT D DATE Q:$G(PSUQUIT)
  1. Q
  1. DATE ;PROCESS ONE DATE - Loop through inpatient sites
  1. S PSUDTDA=$O(^PSI(58.5,"B",PSUDT,0))
  1. K PSUSITE
  1. D GETM^PSUTL(58.5,PSUDTDA,"1*^.01","PSUSITE")
  1. S PSUSDA=0
  1. F S PSUSDA=$O(PSUSITE(PSUSDA)) Q:PSUSDA'>0 D SITE Q:$G(PSUQUIT)
  1. K PSUSITE
  1. Q
  1. ;
  1. SITE ;Process one site for one date
  1. ; Find division for site for loading drug stats
  1. S PSUDIV=$$DIV(PSUSDA,PSUDTDA)
  1. ;
  1. I PSUDIV="NULL" S PSUDIV=PSUSNDR
  1. ;
  1. ; Process individual Drug information from 58.52
  1. ; Drug multiple loaded into PSUDRUG
  1. K PSUDRUG
  1. D GETM^PSUTL(58.501,"PSUDTDA,PSUSDA","2*^.01","PSUDRUG")
  1. S PSUDRDA=0
  1. F S PSUDRDA=$O(PSUDRUG(PSUDRDA)) Q:PSUDRDA'>0 D DRUG Q:$G(PSUQUIT)
  1. K PSUDRUG
  1. ;
  1. D MAP
  1. ; Process Amis categories from 58.501
  1. ; Category multiple loaded into PSUCAT
  1. K PSUCAT
  1. CATEGORY ;EP Pull Categories
  1. K PSUAMCAT
  1. D GETM^PSUTL(58.501,"PSUDTDA,PSUSDA","1*^.01;1;2;3;4","PSUAMCAT","I")
  1. ;
  1. ; Move (da,Fld,"I") values to (da,Fld) nodes
  1. D MOVEMI^PSUTL("PSUAMCAT")
  1. ;
  1. ; Gather totals for categories and accumulate in
  1. ; ^XTMP(PSUARSUB,"DIV_CAT",PSUDIV,PSUAMCAT,"DISP":COST")
  1. N PSUDISP,PSUCOST
  1. S PSUCDA=0 F S PSUCDA=$O(PSUAMCAT(PSUCDA)) Q:PSUCDA'>0 D
  1. . S PSUDISP=PSUAMCAT(PSUCDA,1)-PSUAMCAT(PSUCDA,3)
  1. . S PSUCOST=PSUAMCAT(PSUCDA,2)-PSUAMCAT(PSUCDA,4)
  1. . S PSUAMCAT=PSUAMCAT(PSUCDA,.01) ; "03"-"04"-"06" etc
  1. . S X=$G(^XTMP(PSUARSUB,"DIV_CAT",PSUDIV,PSUAMCAT,"DISP"))
  1. . S ^XTMP(PSUARSUB,"DIV_CAT",PSUDIV,PSUAMCAT,"DISP")=X+PSUDISP
  1. . S X=$G(^XTMP(PSUARSUB,"DIV_CAT",PSUDIV,PSUAMCAT,"COST"))
  1. . S ^XTMP(PSUARSUB,"DIV_CAT",PSUDIV,PSUAMCAT,"COST")=X+PSUCOST
  1. . M ^XTMP("PSUTCST",PSUDIV,PSUAMCAT)=^XTMP(PSUARSUB,"DIV_CAT",PSUDIV,PSUAMCAT,"COST")
  1. ;
  1. Q
  1. ;
  1. DRUG ; Process one drug for one site for one day
  1. ; Load & loop categories within Drug
  1. ; total dispense & returns
  1. ; Category multiple loaded into PSUCAT
  1. ;
  1. S PSUDRIEN=$$VALI^PSUTL(58.52,"PSUDTDA,PSUSDA,PSUDRDA",.01)
  1. K PSUCAT
  1. D GETM^PSUTL(58.52,"PSUDTDA,PSUSDA,PSUDRDA","1*^.01;1","PSUCAT","I")
  1. ;
  1. S PSUCDA=0,PSUDISP=0,PSUTR=0
  1. F S PSUCDA=$O(PSUCAT(PSUCDA)) Q:PSUCDA'>0 Q:$G(PSUQUIT) D
  1. . S X=PSUCAT(PSUCDA,.01,"I")
  1. . S Y=PSUCAT(PSUCDA,1,"I")
  1. . I (X="A")!(X="W") S PSUDISP=PSUDISP+Y,PSUTDS=PSUDISP
  1. . I (X="RA")!(X="RW") S PSUDISP=PSUDISP-Y,PSUTR=PSUTR+Y
  1. ; Adjust accumulative dispenses
  1. ;
  1. S X=$G(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV,PSUDRIEN))
  1. S ^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV,PSUDRIEN)=X+PSUDISP
  1. ;
  1. N PSUT
  1. S PSUT=$G(PSUTDSP(PSUDIV,PSUDRIEN))
  1. I $D(PSUTDS) D
  1. .S PSUTDSP(PSUDIV,PSUDRIEN)=PSUTDS+PSUT ;Total Quantity dispensed
  1. .I (PSUTDS+PSUT)=0 S PSUTDSP(PSUDIV,PSUDRIEN)=""
  1. ;
  1. N PSUT1
  1. S PSUT1=$G(PSUTRET(PSUDIV,PSUDRIEN))
  1. I $D(PSUTR) D
  1. .S PSUTRET(PSUDIV,PSUDRIEN)=PSUTR+PSUT1 ;Total Quantity returned
  1. .I (PSUTR+PSUT1)=0 S PSUTRET(PSUDIV,PSUDRIEN)=""
  1. K PSUCAT
  1. Q
  1. DIV(PSUSDA,PSUDTDA) ;EP process for a site the associated divisions by date.
  1. ; uses PSUSDA as entry for site ien in file 59.4 : returns division
  1. ; as of 2/99 date is no longer used as a parameter
  1. N PSUDIV,PSUDT
  1. I '$D(^XTMP(PSUARSUB,"DIVLK",PSUSDA)) D AOU
  1. ; ^XTMP(PSUARSUB,"DIVlk",Site IEN, AOU Inactive Date -1)=Division IEN
  1. ;
  1. ; if AOU did not set division then return null
  1. I '$D(^XTMP(PSUARSUB,"DIVLK",PSUSDA)) S PSUDIV="NULL" Q PSUDIV
  1. ;
  1. S PSUDIV=$O(^XTMP(PSUARSUB,"DIVLK",PSUSDA,""))
  1. Q PSUDIV
  1. ;
  1. AOU ;EP map divisions by dates for inpatient sites from the AOU file
  1. ;PSUADA - ien for AOU Stock file
  1. ;
  1. N PSUADA,PSUDIV,PSUINACT,PSUDIV,PSUSLOC,MAPLOCI
  1. ;
  1. D GETM^PSUTL(59.7,1,"90.01*^.01;.02;.03","MAPLOCI","I")
  1. ;set array MAPLOCI(ien,fld)=internal value
  1. ;field .02 points to 40.8 Medical Center Division where fac num is #1
  1. ;field .03 points to 59 Outpatient site where site num is #.06
  1. D MOVEMI^PSUTL("MAPLOCI")
  1. ;
  1. K ^XTMP(PSUARSUB,"DIVLK")
  1. ;
  1. S PSUADA=0
  1. F S PSUADA=$O(^PSI(58.1,"ASITE",PSUSDA,PSUADA)) Q:PSUADA'>0 D
  1. . N PSUDIV S PSUDIV=""
  1. . S PSUSLOC=$$VALI^PSUTL(59.4,PSUSDA,.01)
  1. . S PSUINACT=$$VALI^PSUTL(58.1,PSUADA,3)
  1. . I PSUINACT Q ; inactivated sites are to be ignored regardles of date
  1. . S:'PSUINACT PSUINACT=DT+1
  1. . I '$G(MAPLOCI(PSUADA,.01)) S PSUDIV="NULL"
  1. . I $G(MAPLOCI(PSUADA,.01)) D
  1. .. S X=$G(MAPLOCI(PSUADA,.02)) I X S PSUDIV=$$VALI^PSUTL(40.8,X,1)
  1. .. S X=$G(MAPLOCI(PSUADA,.03)) I X S PSUDIV=$$VALI^PSUTL(59,X,.06)
  1. .. S ^XTMP(PSUARSUB,"DIVLK",PSUSDA,PSUDIV)=""
  1. ;
  1. Q
  1. ;
  1. MAP ;Find out whether an Area of Use (AOU) is mapped to a division or
  1. ;outpatient site. If it is not mapped, store the NAME and INACTIVATION
  1. ;DATE (if applicable) in a global to be mailed to the user.
  1. ;
  1. S PSUNAM=0 ;This is the name of the Area of USE
  1. ;
  1. F S PSUNAM=$O(^PSI(58.1,"B",PSUNAM)) Q:PSUNAM="" D
  1. .S IEN=0 ;This is the IEN for file 58.1
  1. .F S IEN=$O(^PSI(58.1,"B",PSUNAM,IEN)) Q:IEN="" D
  1. ..K AOU
  1. ..D GETS^PSUTL(58.1,IEN,".01;3","AOU(IEN)") ;Name & Inactive Date
  1. ..D MAP1
  1. Q
  1. ;
  1. MAP1 ;MAP continued. This subroutine takes the IEN from file 58.1 and looks
  1. ;to see if it is in file 59.7, field 90.01. If it is, then it has
  1. ;been mapped if there is a value in subfield .02 or .03.
  1. ;If there is no value in subfield .02 or .03 it has not been mapped
  1. ;
  1. ;Keep only the entries that are NOT mapped
  1. ;
  1. N PSUDA
  1. ;
  1. I $G(^PS(59.7,1,90.01,IEN,0)) D
  1. .D GETM^PSUTL(59.7,1,"90.01*^.01;.02;.03","MAPLOCI")
  1. .S PSUDA=0
  1. .F S PSUDA=$O(MAPLOCI(PSUDA)) Q:PSUDA="" D
  1. ..I MAPLOCI(PSUDA,.02)'="" K AOU(PSUDA)
  1. ..I $G(MAPLOCI(PSUDA,.03))'="" K AOU(PSUDA)
  1. M ^XTMP(PSUARSUB,"AOU")=AOU ;Contains only unmapped locations
  1. Q
  1. ;
  1. CLEAR ;EP Clear ^XTMP("PSUAR*")
  1. S X="PSUAR",Y=X
  1. F S Y=$O(^XTMP(Y)) Q:($E(Y,1,5)'=X) W !,Y K ^XTMP(Y)
  1. Q