Routine: PSURT1

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 ***

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"

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)

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

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      ;

PSURT1.m