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