source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSURT1.m@ 1397

PSURT1 ;BIR/RDC - PATIENT DEMOGRAPHIC RETRANSMITION; APR 2, 2007 ; 4/2/07 11:01am
 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
 ;
 ; THIS PROGRAM WILL ALLOW THE RETRANSMITION OF THE PATIENT
 ; DEMOGRAPHIC DATA FOR THE PBM EXTRACT USING THE DATA
 ; FROM ^PSUDEM (59.9) FOR RUN TIME OPTIMIZATION
 ;
EN ; ENTRY POINT
 NEW P,SDT,EDT,WHEN,NOGOOD,TMON,RMONTH,PMON,SMON,EMON,RTYPE,SRANGE,ERANGE
 S P=""
 ; move call to CLEANUP^PSUHL to routine PSUCP (PSU*4*12) 
 S SDT=$O(^PSUDEM("B",P))
 I 'SDT W !,"NO DATA AVAILABLE - NOTIFY YOUR SUPERVISOR" Q
 S EDT=$O(^PSUDEM("B",P),-1)
 S Y=SDT X ^DD("DD") S START=Y
 S Y=EDT-1 X ^DD("DD") S STOP=Y
 W !,"This option will allow the retransmission of Patient Demographic and Outpatient Visit data stored in the PBM PATIENT DEMOGRAPHICS FILE. Statistical data starting from "
 W START
 W " through "
 W STOP
 W " is available for retransmission."
 W !
 ;
 ; let fileman get response
 S DIR("A")="Is this a monthly report",DIR(0)="YO"
 D ^DIR K DIR
 ;
 S NOGOOD=1
 I Y=1 S NOGOOD=0 D MONTH
 I Y=0 S NOGOOD=0 D RANGE
 Q:NOGOOD
 D PROCESS        ; *** process the extract ***
 Q
 ;
MONTH ;      *** allow only whole months to be processed ***
 W !
 S TMON=$E(DT,4,5)
 S DIR("A")="Select Month/Year",DIR(0)="F" D ^DIR
 K DIR,DIR("A")
 I $D(DIRUT) S NOGOOD=1 Q
 S %DT="MP" D ^%DT K %DT
 I Y=-1 W !!,"Invalid Month/Year.  Please Reenter a month and year." G MONTH
 S RMONTH=$$FMTE^XLFDT(Y) W " ("_RMONTH_")"
 ; S %DT(0)=SDT,%DT="MP"
 ; S X=Y
 ; D ^%DT K %DT
 I $E(Y,4,5)=TMON S Y=-1
 I Y=-1 W !!,"Data for the entire month of "_RMONTH_" is not available.  Please reenter a month/year." G MONTH
 I Y>DT W !!,"You may not select a date from the future.  Please reenter a month/year within the valid parameters." G MONTH
 ;
 S PSURMON=Y
 S SMON=$E(PSURMON,1,5)_"00"
 S EMON=$E(PSURMON,1,5)_"99"
 S RTYPE="M"
 Q
 ;
RANGE ;             *** process a range of dates from within file #59.9 ***
 S %DT(0)=SDT
 ;
BGNRNG ;
 W !
 S %DT="PAE",%DT("A")="Select start date: " D ^%DT K %DT,%DT("A")
 I X="^"!($G(DTOUT)) S NOGOOD=1 Q
 I Y=-1 W !!,"Invalid date.  Please reenter a start date." G BGNRNG
 I Y=DT W !!,"Today is not a valid start date.  Please reenter a start date." G BGNRNG
 ;
 I Y>DT W !!,"You may not select a date in the future.  Please reenter a start date." G BGNRNG
 ;
 S SRANGE=Y          ;  *  start with this date  ***
 ;
ENDRNG ;
 W !
 S %DT="PAE",%DT("A")="Select stop date: " D ^%DT K %DT,%DT("A")
 I X="^"!($G(DTOUT)) S NOGOOD=1 Q
 I Y=-1 W !!,"Invalid date.  Please reenter a stop date." G ENDRNG
 I Y=DT W !!,"Statistical data has not been compiled for current date.  Please reenter a stop date." G ENDRNG
 ;
 I Y<SRANGE W !!,"You need to select a stop date greater than your start date.  Please reenter your start/stop dates." G BGNRNG
 ;
 I Y>DT W !!,"You may not select a date in the future.  Please reenter a stop date." G ENDRNG
 ;
 S ERANGE=Y                ; *  end at this date  ***
 ;
 S RTYPE="R"
 K %DT(0)
 ;
 Q
PROCESS ;
 I RTYPE="R" S (START,PSUSRNG)=SRANGE,(LAST,PSUERNG)=ERANGE
 I RTYPE="M" S START=SMON,LAST=EMON
 ;
 S PSUSMRY=0
 W !!
 S DIR("A")="Do you want a copy of this report sent to you in a MailMan message?"
 S DIR(0)="YO"
 S DIR("B")="NO"
 D ^DIR K DIR,DIR(0)
 I Y="^" Q
 I Y=1 S PSUMME=1,PSUDUZ=DUZ
 ;
 I RTYPE="M" D
 . W !!
 . S DIR("A")="Send this to the PBM section for addition to the master file?"
 . S DIR(0)="YO"
 . S DIR("B")="NO"
 . D ^DIR K DIR,DIR(0)
 . I Y=1 S PSUMSTR=1
 ;
 I Y="^" Q
 S PSUSTART=START,PSULAST=LAST
 K %DT,PSUWHEN
 D NOW^%DTC S %DT="REAX",%DT(0)="A",%DT("B")="NOW",%DT("A")="Queue to run at what time: " D ^%DT
 S PSUWHEN=Y
 S ZTRTN="EN^PSURT2",ZTIO="",ZTDESC="RETRASMISSION OF PT DEMOGRAPHICS",ZTDTH=PSUWHEN
 S ZTSAVE("PSUSTART")=""
 S ZTSAVE("PSULAST")=""
 S ZTSAVE("PSUMME")=""
 S ZTSAVE("PSUMSTR")=""
 S ZTSAVE("PSURMON")=""
 S ZTSAVE("PSUSRNG")=""
 S ZTSAVE("PSUERNG")=""
 S ZTSAVE("PSUDUZ")=""
 S ZTSAVE("PSUSMRY")=""
 ;
 ; D ^PSURT2
 ; Q
 ;
 D ^%ZTLOAD
 Q
 ;