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

PSUCP1.m

Go to the documentation of this file. 
  1. PSUCP1 ;BIR/TJH,PDW - PBM - CONTROL POINT, MANUAL ENTRY ; 1/12/09 12:12pm
  1.  ;;4.0;PHARMACY BENEFITS MANAGEMENT;**15**;MARCH, 2005;Build 2
  1.  ;
  1.  ;DBIA's
  1.  ; Reference to file #4   supported by DBIA 10090
  1.  ; Reference to file #4.3 supported by DBIA 10091
  1.  ; 
  1. EN ; start here
  1.  D PSUHDR ; display option explanation
  1.  S PSUERR=0
  1.  S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99)
  1. ASK ; ask type of report desired
  1.  S DIR("?",1)="If this is the monthly report that will be sent to the PBM section"
  1.  S DIR("?",2)="for inclusion into the master file, answer with a 'Y' for YES."
  1.  S DIR("?",3)="If this is not the monthly report or you want to specify a date range"
  1.  S DIR("?")="then enter 'N' for NO."
  1.  S DIR("A")="Is this the monthly report",DIR(0)="YO"
  1.  D ^DIR K DIR W !
  1.  G ERR:(Y="^")!(Y="")!($D(DTOUT))
  1.  K DTOUT
  1.  S PSUAM=Y,ERC=0
  1. DATES ; do this if user entered N, wants date range
  1.  I 'PSUAM D
  1.  .K PSUMNTH
  1.  .S %DT(0)=2880000,%DT="AEPX",%DT("A")="Select Start Date: "
  1.  .D ^%DT K %DT W !
  1.  .I +Y'>0 S ERC=1 Q  ; condition 1, exit.
  1.  .S PSUSDT=+Y
  1.  .S %DT(0)=2880000,%DT="AEPX",%DT("A")="  Select End Date: "
  1.  .D ^%DT K %DT W !
  1.  .I +Y'>0 S ERC=1 Q  ; condition 1, exit.
  1.  .S PSUEDT=+Y
  1.  .I PSUEDT'>PSUSDT D  Q
  1.  ..W !!,"The end date of the search must be greater than the start date.",!
  1.  ..K PSUSDT,PSUEDT
  1.  ..S ERC=2 ; condition 2, ask dates again
  1.  .I PSUSDT>DT!(PSUEDT>DT) D
  1.  ..W !!,"Searches cannot be executed for future dates.",!
  1.  ..K PSUSDT,PSUEDT
  1.  ..S ERC=2 ; condition 2, ask dates again
  1.  I ERC=1 G ERR
  1.  I ERC=2 S ERC=0 G DATES
  1.  ;
  1. PSUMON ; do this if user asked for monthly report
  1.  I PSUAM D
  1.  .S PSUMNTH=1
  1.  .S %DT(0)=2880000,%DT="MAEP",%DT("A")="Select Month/Year: " K DTOUT,X,Y
  1.  .D ^%DT K %DT W !
  1.  .S ERC=$S($D(DTOUT):1,X="^":1,X="^^":3,+Y'>0:1,1:0)
  1.  .Q:ERC  ; check error condition
  1.  .I Y>DT!($E(Y,1,5)=$E(DT,1,5)) D  Q:ERC
  1.  ..W !!,"PBM statistical data can only be compiled for months that have already passed.",!
  1.  ..K Y
  1.  ..S ERC=2 ; condition 2, ask month again
  1.  .I $E(Y,4,5)="00" D  Q:ERC
  1.  ..W !!,"Oops, you forgot to enter a month.  Try again, please."
  1.  ..K Y
  1.  ..S ERC=2
  1.  .S PSUSDT=$E(Y,1,5)_"01",MNUM=$E(Y,4,5)
  1.  .S PSUMTH=$E(Y,1,5)    ;leap year correction
  1.  .S PSULY=$$LEAPYR^PSUCP(PSUMTH)    ;leap year correction
  1.  .S PSUEDT=$E(Y,1,5)_$S(MNUM["02":$S(PSULY:"29",1:"28"),MNUM="04":"30",MNUM="06":"30",MNUM="09":"30",MNUM="11":"30",1:31)   ;leap year correction
  1.  .;S PSUEDT=$E(Y,1,5)_$S(MNUM="02":"29",MNUM="04":"30",MNUM="06":"30",MNUM="09":"30",MNUM="11":"30",1:31)
  1.  ;
  1.  ;
  1.  G ERR:ERC=1,ASK:ERC=3
  1.  I ERC=2 S ERC=0 G PSUMON ; erroneous input, try again
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=$E(PSUSDT,1,5)
  1.  ;
  1. SETDT ; set month name variables
  1.  S X=PSUSDT D DATE S PSUMON1=Y
  1.  S X=PSUEDT D DATE S PSUMON2=Y
  1.  S X=$E(PSUSDT,1,5)_"00" D DATE S PSUMON=$E(PSUSDT,1,5)
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=PSUMON
  1.  K X,X1
  1.  ;
  1. SELF ; include self and PSU PBM mailgroup
  1.  S PSUPBMG=0
  1.  S PSUDUZ=0
  1.  S DIR("A")="Do you want a copy of this report sent to you in a MailMan message"
  1.  S DIR("?")="Please answer with a 'Y' or 'N'."
  1.  S DIR(0)="YO",DIR("B")="NO"
  1.  D ^DIR K DIR,DIRUT,DIROUT,DUOUT,DTOUT W !
  1.  G ERR:Y="",ERR:Y="^",DATES:Y["^^"
  1.  I Y S PSUDUZ=DUZ,^XTMP("PSU_"_PSUJOB,"PSUFLAG1")="",^XTMP("PSU_"_PSUJOB,"PSUFLAG2")="",PSUFLAG1=1,PSUFLAG2=1
  1.  I 'Y S ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")="",PSUFLAG3=1
  1.  I Y S PSUPBMG=1  ;Send copy to PSU PBM mail group
  1.  ;
  1. MASTER ; if monthly, should it be added to master file
  1.  S (PSUMASF,Y)=0
  1.  I PSUAM D
  1.  .S DIR("A")="Send this to the PBM section for addition to the master file"
  1.  .S DIR("?")="Please answer with a 'Y' or 'N'."
  1.  .S DIR(0)="YO",DIR("B")="NO"
  1.  .D ^DIR K DIR,DIRUT,DIROUT,DUOUT,DTOUT W !
  1.  G ERR:Y="",ERR:Y="^",SELF:Y["^^"
  1.  I Y S PSUMASF=1
  1.  ;
  1. MODULE ; display and select module(s)
  1.  D OPTS^PSUCP ; set up PSUA array with option info
  1.  W !!,"Select one or more of the following:",!
  1.  F I=1:1:12 W !,I,".",?5,PSUA(I,"M")
  1.  W !!,"Laboratory data and a Patient Demographic summary report will be automatically"
  1.  W !,"generated if IVs, Unit Dose, or Prescription extracts are chosen."
  1.  W !,"You may select all of the modules by entering 'A' for ALL or by using '1:12'."
  1.  W !!,"The Provider Data report may take an extended amount of time to run."
  1.  W !,"It is recommended that it be run during off peak hours."
  1. MODP ; module selection prompt
  1.  W !!,"Select the code(s) associated with the data requested: "
  1.  R X:DTIME E  G ERR
  1.  I X["^" G ERR:X="^",MASTER:PSUAM,SELF
  1.  I X="" W "  <??>",$C(7) S X="?"
  1.  ;
  1.  ;
  1.  ;I X["7" D  G MODULE
  1.  ;.W !!,"Lab may not be selected directly.  It will be automatically included when"
  1.  ;.W !,"options 1, 2 or 4 are part of the selection."
  1.  S:"Aa"[$E(X) X="1:12"
  1. MODHLP I X["?" D  G MODULE:X["??",MODP
  1.  .W !!,"Enter:  A single code number to print just that report."
  1.  .W !,?8,"A range of code numbers.  Example:  1:3"
  1.  .W !,?8,"Multiple code numbers separated by commas.  Example:  2,4,5"
  1.  .W !,?8,"The letter A to select ALL reports."
  1.  .W !,?8,"A single up-arrow ( ^ ) to exit now without running any reports."
  1.  .W !,?8,"Double up-arrow  ( ^^ ) to go back to a previous prompt.",!
  1.  S X=$TR(X,"-;_><.A","::::::")
  1.  K PSUMOD
  1.  F PII=1:1:$L(X,",") D
  1.  .S X1=$P(X,",",PII)
  1.  .Q:X1=""
  1.  .I X1[":" D  Q
  1.  ..S XBEG=$P(X1,":",1),XEND=$P(X1,":",2)
  1.  ..I (XBEG="")!(XEND="") Q
  1.  ..F PJJ=XBEG:1:XEND S PSUMOD(PJJ)=""
  1.  ..K PJJ,XBEG,XEND
  1.  .S PSUMOD(X1)=""
  1.  S (X,ERC)=0 F  S X=$O(PSUMOD(X)) Q:X=""  I '$D(PSUA(X)) S ERC=1 Q
  1.  I ERC W !!,"<INVALID CHOICE - ",X,", TRY AGAIN>",$C(7) G MODP
  1.  I '$D(PSUMOD) W !!,"No choices were made." S X="?" G MODHLP
  1.  ;
  1.  F PII=1,2,4 I $D(PSUMOD(PII)) S PSUMOD(13)="" ; add Lab if IV,UD or OP
  1.  ;
  1.  W !!,"You have selected: "
  1.  S X="",PSUOPTS="" F  S X=$O(PSUMOD(X)) Q:X=""  W ?20,X," - ",PSUA(X,"M"),! S PSUOPTS=PSUOPTS_X_","
  1.  I $D(PSUMOD(1))!$D(PSUMOD(2))!$D(PSUMOD(4)) D
  1.  . W ?20,"Patient Demographic Summary" W !
  1.  S PSUOPTS=$E(PSUOPTS,1,$L(PSUOPTS)-1) ; remove trailing comma
  1.  ;
  1.  ;Set flag for combined AMIS summary report.
  1.  I (PSUOPTS["1,2,3,4")&(PSUOPTS[6) S ^XTMP("PSU_"_PSUJOB,"CBAMIS")=""
  1.  ;
  1. RPT ; select report type - full report or summary only
  1.  N PSUGO
  1.  D:PSUOPTS'=11&(PSUOPTS'=12)        ; no summary for VITALS/IMMS OR AA**
  1.  . S DIR("A")="Print Summary Only"
  1.  . S DIR("?",1)="Please answer with a 'Y' or 'N'."
  1.  . S DIR("?")="Answer Yes and only the summary report will be generated."
  1.  . S DIR(0)="YO",DIR("B")="NO"
  1.  . D ^DIR K DIR,DIRUT,DIROUT,DUOUT,DTOUT W !
  1.  . ;PSU*4*15
  1.  . I (Y["^") S:Y="^" PSUGO=1 S:Y["^^" PSUGO=2 Q
  1.  . S PSUSMRY=$S(Y:1,1:0)
  1.  G ERR:$G(PSUGO)=1,MODULE:$G(PSUGO)=2
  1.  S:PSUOPTS=11!(PSUOPTS=12) PSUSMRY=0
  1.  ;
  1.  ;
  1. BCKGND ; always run as a background job
  1.  W !!,"This report will automatically run as a background job."
  1.  ; ask time to queue
  1.  S DIR("?",1)="You can start the program now or queue it to start later."
  1.  S DIR("?",2)="Past date/time is not allowed.  Future dates up to 10 days are allowed."
  1.  S DIR("?")="Enter an appropriate date and time or press <Enter> to start now."
  1.  S %DT="RX",X="NOW+10" D ^%DT
  1.  S DIR("A")="REQUESTED TIME TO RUN: ",DIR(0)="DAO^NOW:"_Y_":EFRX"
  1.  S DIR("B")="NOW"
  1.  D ^DIR K DIR W !
  1.  G ERR:(Y="^")!(Y="")!($D(DTOUT))
  1.  K DTOUT
  1.  S PSUDTH=Y
  1.  ;
  1. DEVICE ;
  1.  S PSUIOP="",PSUPOP=1
  1.  I 'PSUDUZ D  G ERR:POP
  1.  . I PSUOPTS=11!(PSUOPTS=12) W !,"HARDCOPIES NOT AVAILABLE FOR THIS OPTION" S POP=1 Q
  1.  .S PSUIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  .S %ZIS="N0",%ZIS("B")="",%ZIS("A")="Select 132 column device: "
  1.  .D ^%ZIS K %ZIS
  1.  .I POP!($E(IOST)="C"),$G(PSUFQ) D  I PSUPOP S POP=1 Q
  1.  ..W !!,"You have not selected an appropriate print device."
  1.  ..W !,"Enter 'C' to continue data compilation and send mail messages"
  1.  ..W !,"          but not print any hardcopy."
  1.  ..W !,"Enter '^' to abort this whole option now."
  1.  ..F  R !,"-> ",PSUX:DTIME Q:"C^"[$E(PSUX)  W "  ??"
  1.  ..S PSUPOP=$S(PSUX="C":0,1:1)
  1.  .S PSUIOP=$S('PSUPOP:"",1:ION_";"_IOST_";"_IOM_";"_IOSL) ; save printer parameters
  1.  .D RESETVAR^%ZIS ; restore terminal parameters
  1. EXIT ; exit point for normal finish
  1.  ;
  1.  Q  ; return to calling routine, ^PSUCP
  1.  ;
  1. PSUHDR ;Display header
  1.  W !!,"The Pharmacy Benefits Management (PBM) report will extract"
  1.  W !,"statistics from one or more of the following files:",!
  1.  W !,"1. Pharmacy Patient IV Sub-file       File # 55.01"
  1.  W !,"2. Pharmacy Patient UD Sub-file       File # 55.06"
  1.  W !,"3. AR/WS Stats                        File # 58.5"
  1.  W !,"4. Prescription                       File # 52"
  1.  W !,"5. Procurement                        File # 58.811,# 58.81"
  1.  W !,"6. Controlled Substances              File # 58.81"
  1.  W !,"7. Patient Demographics               File # 2"
  1.  W !,"8. Outpatient Visits                  File # 9000010,# 9000010.07"
  1.  W !,"9. Inpatient PTF Record               File # 45"
  1.  W !,"10. Provider Data                     File # 200,# 7,# 49,# 8932.1"
  1.  W !,"11. Allergy/Adverse Event             File # 120.8,# 120.85"
  1.  W !,"12. Vitals/Immunization Record        File # 120.5,# 9999999.14"
  1.  W !,"13. Laboratory                        File # 60,# 63"
  1.  ;
  1.  W !!,"This data can be collected for ALL of the files listed or for one or"
  1.  W !,"more specific files.  A summary of data or a detailed report by drug"
  1.  W !,"can be delivered to you in a mail message or in a hard copy report.",!!
  1.  Q
  1.  ;
  1. DATE ;Date conversion
  1.  S Y=X X ^DD("DD") S:Y="" Y="Unknown"
  1.  Q
  1.  ;
  1. ERR ; Exit point following erroneous input or ^
  1.  K ERC,MNUM,MOD,PII,PSUA,PSUAM,PSUDUZ,PSUEDT,PSUPBMG,PSUMASF,PSUPBMG,PSUMNTH,PSUMOD
  1.  ;K PSUMON,PSUMON1,PSUMON2,PSUOPTS,PSUSDT,PSUSMRY,X1
  1.  K PSUMON1,PSUMON2,PSUOPTS,PSUSDT,PSUSMRY,X1
  1.  S PSUERR=1
  1.  Q
  1.  ;