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