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

PSUCP.m

Go to the documentation of this file.
  1. PSUCP ;BIR/TJH,PDW - PBM CONTROL POINT ; 06/08/07
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
  1. ; Reference to File #4 supported by DBIA 10090
  1. ; Reference to File #4.3 supported by DBIA 10091
  1. ; Reference to File #40.8 supported by DBIA 2438
  1. ; Reference to File #59.7 supported by DBIA 2854
  1. ; move CLEANUP^PSUHL from PSURT1, delete calls to PSUCP3 (PSU*4*12)
  1. MANUAL ; entry point for manual option
  1. S PSUALERT=0 D MANUAL^PSUALERT
  1. I PSUALERT K PSUALERT Q
  1. K PSUALERT
  1. S PSUFQ=1
  1. I $D(^XTMP("PSUJFLG")) D Q:Y=0 Q:Y="^"
  1. .W !!,"NOTE: A PREVIOUS JOB HAS NOT COMPLETED DUE TO AN ERROR"
  1. .W !!,"PLEASE ALERT YOUR IRM."
  1. .W !!,"RESPOND 'YES' TO CONTINUE, OR 'NO' TO EXIT"
  1. .S DIR(0)="Y",DIR("B")="NO"
  1. .S DIR("A")="Do you wish to continue"
  1. .D ^DIR
  1. D CLEANUP^PSUHL
  1. S PSUJOB=$J_"_"_$P($H,",",2)
  1. S ^XTMP("PSUMANL")=""
  1. D EN^PSUCP1 ; prompt for report choices
  1. I PSUERR G EXIT
  1. D XMY^PSUTL1 ; Setup for mail groups according to choices
  1. S ^XTMP("PSUJFLG")="",PSUAUTO=0,^XTMP("PSU_"_PSUJOB,"PSUJOB")=PSUJOB
  1. D PUT
  1. S PSUTITLE="PSU PBM MANUAL",PSURC="RUN^PSUCP"
  1. S PSURP=$S('$L(PSUIOP):"",1:"PRINT^PSUCP")
  1. S PSURX="EXIT^PSUCP",PSUNS="PS"
  1. S ^XTMP("PSU","RUNNING")=$G(ZTSK)
  1. K PSUALERT,XAQ,SQAFLG,SQAID,XQAMSG,XQMSG,ZTSK
  1. D ^PSUDBQUE
  1. MANUALQ Q
  1. ;
  1. AUTO ; set variables for Auto-report option and task to background
  1. S PSUALERT=0 D AUTO^PSUALERT
  1. I PSUALERT K PSUALERT Q
  1. I $D(^XTMP("PSU","RUNNING")) D Q
  1. .S XQA(DUZ)="",XQA("G.PSU PBM")="",XQMSG="An ERROR has occurred. Please contact IRM for assistance."
  1. .S XQAID="PSU",XQAFLG="D" D SETUP^XQALERT
  1. D CLEANUP^PSUHL
  1. S PSUJOB=$J_"_"_$P($H,",",2)
  1. S ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")="" ;flag for mail patient summary reports
  1. S ^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG")=1 ;Set 'auto' flag
  1. S ^XTMP("PSUJFLG")="" ;FLAG to avoid concurrent jobs running
  1. D ; schedule job completion check
  1. .S PSURC="AUTO^PSUCP2",PSUTITLE="PSU PBM JOB CHECK",PSUFQ=1
  1. .S (PSURP,PSURX,PSUIOP)=""
  1. .D NOW^%DTC S X1=%,X2=6 D C^%DTC S PSUDTH=X ; LIVE MODE, wait 6 days (72 hours)
  1. .D ^PSUDBQUE
  1. .S ^XTMP("PSU","RUNNING")=$G(ZTSK)
  1. D NOW^%DTC S PSUMON=$S('$D(DT):X,1:DT),PSUMON=$E(PSUMON,1,5)-1 ; get previous month
  1. I $E(PSUMON,4,5)="00" S PSUMON=($E(PSUMON,1,3)-1)_"12" ; set to Dec. of previous year if this month is Jan.
  1. S ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=PSUMON,PSUSDT=PSUMON_"01"
  1. S PSULY=$$LEAPYR(PSUMON),X=U_$E(PSUMON,4,5)_U
  1. S PSUEDT=PSUMON_$S(X["02":$S(PSULY:"29",1:"28"),"^04^06^09^11^"[X:"30",1:"31")
  1. S PSUDUZ=$S(DUZ=0:.5,1:DUZ),PSUMASF=1,PSUSMRY=0,PSUPBMG=1
  1. S ^XTMP("PSU_"_PSUJOB,"PSUPDFLAG")=1 ;Flag-detailed PD won't go to user auto extract
  1. S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99)
  1. S PSUOPTS="1,2,3,4,5,6,7,8,9,10,11,12,13",PSUAUTO=1,PSUIOP="" D
  1. .S ^XTMP("PSU_"_PSUJOB,"CBAMIS")=""
  1. S ^XTMP("PSU_"_PSUJOB,"PSUJOB")=PSUJOB
  1. D PUT
  1. S PSUTITLE="PSU PBM AUTO",PSURC="RUN^PSUCP",PSURX="EXIT^PSUCP",PSURP="",PSUNS="PS",PSUFQ=1
  1. D NOW^%DTC S PSUDTH=%
  1. D ^PSUDBQUE
  1. K PSUALERT,XQA,XQAID,XQAFLG,XQA,ZTSK
  1. AUTOQ Q ; exit from AUTO
  1. ;
  1. RUN ; run each selected module
  1. L ^XTMP("PSU","RUNNING"):1 I '$T Q
  1. D PULL,OPTS
  1. K PSUMOD,PSUFDA
  1. I PSUAUTO S PSUFDA(59.7,"1,",90)="@" D FILE^DIE("","PSUFDA","")
  1. F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
  1. S PSUOPTN=""
  1. F S PSUOPTN=$O(PSUMOD(PSUOPTN)) Q:PSUOPTN="" D
  1. .K PSUMSGT
  1. .D PULL
  1. .I PSUAUTO S PSUPBMG=1
  1. .D XMY^PSUTL1
  1. .S PSURTN=PSUA(PSUOPTN,"R")
  1. .D NOW^%DTC
  1. .S ^XTMP("PSU_"_PSUJOB,"STATUS",PSUOPTN,"START")=%
  1. .D @PSURTN,PULL,NOW^%DTC
  1. .S ^XTMP("PSU_"_PSUJOB,"STATUS",PSUOPTN,"STOP")=%
  1. D DT^DILF("E",PSUSDT,.EXTD)
  1. S PSURP("START")=EXTD(0)
  1. D DT^DILF("E",PSUEDT,.EXTD)
  1. S PSURP("END")=EXTD(0),PSUSUB="PSU_"_PSUJOB
  1. D MMNOMAP^PSUCP2 ; MM send regarding PBM locations not mapped
  1. D TIMING ; send a report of how long each module took to complete
  1. I PSUMASF!PSUPBMG D CONFIRM ;Confirmation message sent only if data went to Master File
  1. I PSUAUTO D
  1. .D NOW^%DTC
  1. .S PSUFDA(59.7,"1,",90)=% K %,%H,%I,X
  1. .D FILE^DIE("","PSUFDA","") ; file the completion date in 59.7,90;1
  1. L
  1. ;
  1. Q
  1. PRINT ; print hard copy if requested
  1. Q:'$L(PSUIOP) ; no printer selected, stop right here.
  1. D PULL,OPTS
  1. K PSUMOD
  1. F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
  1. S PSUOPTN=""
  1. F S PSUOPTN=$O(PSUMOD(PSUOPTN)) Q:PSUOPTN="" D
  1. .D PULL
  1. .S PSURTN=PSUA(PSUOPTN,"P")
  1. .D @PSURTN
  1. L
  1. K ^XTMP("PSU","RUNNING")
  1. PRINTQ Q
  1. EXIT ; exit point
  1. K ^XTMP("PSU","RUNNING")
  1. K ^XTMP("PSUJFLG") ;Remove flag to prevent concurrent jobs
  1. Q
  1. PUT ; put variables in ^XTMP so modules can retrieve them
  1. S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUIOP,PSUSNDR,PSUOPTS,PSUAUTO"
  1. S PSUVSTR=""
  1. F I=1:1:$L(PSUVARS,",") S $P(PSUVSTR,U,I)=@$P(PSUVARS,",",I)
  1. S X1=DT,X2=6 D C^%DTC
  1. S ^XTMP("PSU_"_PSUJOB,0)=X_U_DT_U_"Control data for PSU PBM individual modules"
  1. S ^XTMP("PSU_"_PSUJOB,1)=PSUVSTR
  1. K PSUVARS,PSUVSTR,X,X1
  1. PUTQ Q
  1. PULL ; pull variables from ^XTMP
  1. ; PSUJOB must exist and must be the job number used to store the data desired for this session.
  1. N I
  1. S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUIOP,PSUSNDR,PSUOPTS,PSUAUTO"
  1. F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P($G(^XTMP("PSU_"_PSUJOB,1)),U,I)
  1. PULLQ Q
  1. ;
  1. OPTS ; set option array
  1. S PSUA(1,"M")="IVs",PSUA(1,"R")="EN^PSUV0",PSUA(1,"P")="PRINT^PSUV0",PSUA(1,"C")="IV"
  1. S PSUA(2,"M")="Unit Dose",PSUA(2,"R")="EN^PSUUD0",PSUA(2,"P")="PRINT^PSUUD0",PSUA(2,"C")="UD"
  1. S PSUA(3,"M")="AR/WS",PSUA(3,"R")="EN^PSUAR0",PSUA(3,"P")="PRINT^PSUAR0",PSUA(3,"C")="AR"
  1. S PSUA(4,"M")="Prescription",PSUA(4,"R")="EN^PSUOP0",PSUA(4,"P")="PRINT^PSUOP0",PSUA(4,"C")="OP"
  1. S PSUA(5,"M")="Procurement",PSUA(5,"R")="EN^PSUPR0",PSUA(5,"P")="PRINT^PSUPR0",PSUA(5,"C")="PR"
  1. S PSUA(6,"M")="Controlled Substances",PSUA(6,"R")="EN^PSUCS0",PSUA(6,"P")="PRINT^PSUCS0",PSUA(6,"C")="CS"
  1. S PSUA(7,"M")="Patient Demographics",PSUA(7,"R")="EN^PSUDEM1",PSUA(7,"P")="PRINT^PSUDEM0",PSUA(7,"C")="PD"
  1. S PSUA(8,"M")="Outpatient Visits",PSUA(8,"R")="EN^PSUDEM2",PSUA(8,"P")="OPV^PSUDEM0",PSUA(8,"C")="OV"
  1. S PSUA(9,"M")="Inpatient PTF Records",PSUA(9,"R")="EN^PSUDEM7",PSUA(9,"P")="PTF^PSUDEM0",PSUA(9,"C")="PTF"
  1. S PSUA(10,"M")="Provider Data",PSUA(10,"R")="EN^PSUDEM4",PSUA(10,"P")="PRO^PSUDEM0",PSUA(10,"C")="PRO"
  1. S PSUA(11,"M")="Allergies/Adverse Events",PSUA(11,"R")="EN^PSUAA1",PSUA(11,"P")="PRINT^PSUAA1",PSUA(11,"C")="AA"
  1. S PSUA(12,"M")="Vitals/Immunizations Information",PSUA(12,"R")="EN^PSUVIT1",PSUA(12,"P")="EN^PSUVIT0",PSUA(12,"C")="VI"
  1. S PSUA(13,"M")="Laboratory Results",PSUA(13,"R")="EN^PSULR0",PSUA(13,"P")="PRINT^PSULR0",PSUA(13,"C")="LR"
  1. S PSUA("A")=""
  1. OPTSQ Q
  1. ;
  1. CONFIRM ;Send confirmation by Division(s)
  1. K PSUCONF
  1. S PSUDIV=0,$P(PSUDASH,"-",81)=""
  1. D OPTS
  1. S PSUCONF(1)="The chart below shows the package(s) whose dispensing statistics were extracted"
  1. S PSUCONF(2)="by the PBM "_$S($G(PSUAUTO):"Automatic",$G(PSURXMT):"RETRANSMISSION",1:"Manual")_" Pharmacy Statistics option."
  1. ; S PSUCONF(2)="by the PBM "_$S(PSUAUTO:"Automatic",1:"Manual")_" Pharmacy Statistics option."
  1. S PSUCONF(3)=" "
  1. S PSUCONF(4)="PACKAGE"_$J("# Line items",35)_$J("# MailMan msgs",19)
  1. S PSUCONF(5)=$E(PSUDASH,1,79)
  1. F S PSUDIV=$O(^XTMP(PSUSUB,"CONFIRM",PSUDIV)) Q:PSUDIV'?1N.E D
  1. .K ^XTMP(PSUSUB,"XMD")
  1. .M ^XTMP(PSUSUB,"XMD")=PSUCONF
  1. .S PSUOPT=0,PSULCT=5
  1. .F S PSUOPT=$O(^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT)) Q:PSUOPT'?1.N D
  1. ..S PSULCT=PSULCT+1
  1. ..S PSUPKG=PSUA(PSUOPT,"M")
  1. ..S PSULIN=^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT,"L")
  1. ..S PSUMSG=^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT,"M")
  1. ..S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUPKG_$J(PSULIN,37-$L(PSUPKG))_$J(PSUMSG,12)
  1. ..Q:PSUPKG'="Prescription" ;*
  1. .. ; process Prescription MultiDose
  1. ..S PSULCT=PSULCT+1
  1. ..S PSUPKG="Prescription MultiDose"
  1. ..S PSULIN=+$G(^XTMP(PSUSUB,"CONFIRMD",PSUDIV,PSUOPT,"L"))
  1. ..S PSUMSG=+$G(^XTMP(PSUSUB,"CONFIRMD",PSUDIV,PSUOPT,"M"))
  1. ..S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUPKG_$J(PSULIN,37-$L(PSUPKG))_$J(PSUMSG,12) ;*
  1. .S PSUSUBJ="PBM Stats for "
  1. .I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D XMD
  1. CONFIRMQ Q
  1. ;
  1. XMD ;Email
  1. ;
  1. S XMDUZ=DUZ
  1. D XMY^PSUTL1
  1. M XMY=PSUXMYS1
  1. I $G(PSUMASF)!$G(PSUPBMG) M XMY=PSUXMYH
  1. S X=PSUDIV,DIC=40.8,DIC(0)="XM" D ^DIC
  1. S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1. S XMSUB=PSUSUBJ_PSURP("START")_" to "_PSURP("END")_" from "_PSUDIV_" "_PSUDIVNM
  1. S XMTEXT="^XTMP(PSUSUB,""XMD"","
  1. S XMCHAN=1
  1. D ^XMD
  1. XMDQ Q
  1. ;
  1. TIMING ; Timing report
  1. K ^XTMP(PSUSUB,"XMD")
  1. S $P(PSUSPACE," ",41)=""
  1. S PSUX=0,PSULCT=0
  1. F S PSUX=$O(^XTMP(PSUSUB,"STATUS",PSUX)) Q:PSUX="" D
  1. .S (X,Y)=^XTMP(PSUSUB,"STATUS",PSUX,"START") X ^DD("DD") D
  1. ..I $E(Y,17)=":" S PSUT1=$E(Y,1,16)
  1. ..I $E(Y,17)'=":" S PSUT1=$E(Y,1,17)
  1. .S (X1,Y)=^XTMP(PSUSUB,"STATUS",PSUX,"STOP") X ^DD("DD") D
  1. ..I $E(Y,17)=":" S PSUT2=$E(Y,1,16)
  1. ..I $E(Y,17)'=":" S PSUT2=$E(Y,1,17)
  1. .S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1)
  1. .D ^%DTC:X S X=X*1440+Y
  1. .S PSULCT=PSULCT+1
  1. .S PSUREC=$E(PSUA(PSUX,"M")_PSUSPACE,1,20)_$J(PSUT1,20)_$J(PSUT2,20)_$J(X\60,4)_" hrs,"_$J(X#60,3)_" min"
  1. .S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUREC
  1. S PSULCT=PSULCT+1
  1. S $P(^XTMP(PSUSUB,"XMD",PSULCT),"-",80)="" S PSULCT=PSULCT+1
  1. S ^XTMP(PSUSUB,"XMD",PSULCT)="" S PSULCT=PSULCT+1
  1. S ^XTMP(PSUSUB,"XMD",PSULCT)="**NOTE: Timing for the Provider Data extract is not recorded when" S PSULCT=PSULCT+1
  1. S ^XTMP(PSUSUB,"XMD",PSULCT)=" the IV, Unit Dose, Prescription, and Patient Demographics extracts" S PSULCT=PSULCT+1
  1. S ^XTMP(PSUSUB,"XMD",PSULCT)=" are run concurrently."
  1. S PSUDIV=PSUSNDR
  1. S PSUSUBJ="PBM TIMING for report "
  1. D XMD
  1. TIMINGQ Q
  1. ;
  1. LEAPYR(FMYR) ; Check to see if year is a leap year: 1=leap year, 0=not leap year
  1. N YYYY
  1. S YYYY=1700+$E(FMYR,1,3)
  1. Q (((YYYY#4=0)&(YYYY#100'=0))!((YYYY#100=0)&(YYYY#400=0)))