PSOEPRPT ;BIR/TJL - ePCS Reports RPC Entry Points ;9/27/22 08:48
;;7.0;OUTPATIENT PHARMACY;**545**;8 May 96;Build 270
;
;Added reports to ePCS GUI v 2.0 - Summer 2021.
REQCHK(EPCSVV) ;Required data check
N I,C
S C=1
F I=1:1:$L(EPCSV,U) I '$D(@$P(EPCSV,U,I)) D
. S ^TMP("EPCSMSG",$J,C)="0^Required data missing "_$P(EPCSV,U,I)
. S C=C+1,EPCSERR=1
Q
DATECHK(EPCSSD,EPCSED) ;Check human-friendly date and convert to FileMan format
; Input EPCSSD - Start Date (ex. 10/9/01)
; EPCSED - End Date
N EPCSI,X,Y
S %DT="X" F EPCSI="EPCSSD","EPCSED" S X=@EPCSI D ^%DT S @EPCSI=Y
S EPCSSD=$S(EPCSSD=-1:DT,1:EPCSSD),EPCSED=$S(EPCSED=-1:DT,1:EPCSED)
S EPCSDATE=$$FMTE^XLFDT(EPCSSD)_"^"_$$FMTE^XLFDT(EPCSED)
Q
QUEUE ;Queues report to printer
N ZTIO,ZTDESC,ZTRTN,ZTDTH,ZTSAVE,%ZIS,I,IOP,POP
S IOP="Q;`"_EPCSDEV,%ZIS="Q" D ^%ZIS I POP D Q
. S ^TMP("EPCSMSG",$J,1)="0^Device selection unsuccessful"
S ZTIO=ION,ZTDESC=EPCSDESC,ZTRTN=EPCSROU
S ZTDTH=$$FMTH^XLFDT(EPCSQDT)
;D NOW^%DTC S ZTDTH=$S(%'<EPCSQDT:%+.0002,1:EPCSQDT)
F I=1:1:$L(EPCSV,U) I $D(@$P(EPCSV,U,I)) S ZTSAVE($P(EPCSV,U,I))=""
M ZTSAVE=EPCSSAVE
D ^%ZTLOAD,HOME^%ZIS,^%ZISC ;K IO("Q")
I $D(ZTSK) S ^TMP("EPCSMSG",$J)="1^Report queued. Task #"_ZTSK Q
S ^TMP("EPCSMSG",$J)="0^Task Rejected"
Q
;
EPCSEXP ;DEA Expiration Date Report for RPC Call
; Variables passed in
; EPCSCPRS - System Access to CPRS - Include:
; (A)ctive, (D)isusered or (B)oth
; EPCSTYPE - Type of System Access:
; (C)PRS Active Users Only or (A)ll Active Users
; EPCSSTAT - Expiration Date Status:
; (E)xpired, (N)o expiration date, <= (3)0 days, <= (9)0 days
; EPCSPTYP - Send output to:
; (P)rinter, (D)evice or screen
;
; Variable return
; ^TMP($J,"EPCSRPT",n)=report output or to print device.
N EPCSV,EPCSROU,EPCSDESC
S EPCSV="EPCSCPRS^EPCSTYPE^EPCSSTAT" D REQCHK(EPCSV) I EPCSERR Q
I EPCSPTYP="P" D Q
. S EPCSROU="GUI^PSODEARP"
. S EPCSDESC="EPCS DEA EXPIRATION DATE REPORT"
. D QUEUE
D GUI^PSODEARP
Q
EPCSPPP ;Print Prescribers with Privileges [PSO EPCS PRIVS]
;
; Variables passed in
; EPCSPTYP - Send output to:
; (P)rinter, (D)evice or screen
;
; Variable return
; ^TMP($J,"EPCSRPT",n)=report output or to print device.
;
N EPCSV,EPCSROU,EPCSDESC
S EPCSV="EPCSPPP"
I EPCSPTYP="P" D Q
. S EPCSROU="GUI^PSODEARA"
. S EPCSDESC="PRINT PRESCRIBERS WITH PRIVILEGES"
. D QUEUE
D GUI^PSODEARA
Q
EPCSDIS ;Print DISUSER Prescriber with Privileges [PSO EPCS DISUSER PRIVS]
;
; Variables passed in
; EPCSPTYP - Send output to:
; (P)rinter, (D)evice or screen
;
; Variable return
; ^TMP($J,"EPCSRPT",n)=report output or to print device.
;
N EPCSV,EPCSROU,EPCSDESC
S EPCSV="EPCSDIS"
I EPCSPTYP="P" D Q
. S EPCSROU="GUI^PSODEARB"
. S EPCSDESC="PRINT DISUSER PRESCRIBER WITH PRIVILEGES"
. D QUEUE
D GUI^PSODEARB
Q
EPCSAUD ;Changes to DEA Prescribing Privileges Report RPC Call [PSO EPCS LOGICAL ACCESS REPORT]
;
; Variables passed in
; EPCSSD - Start Date of Report
; EPCSED - End Date of Report
; EPCSPTYP - Send output to:
; (P)rinter, (E)xport, (D)evice or screen
;
; Variable return
; ^TMP($J,"EPCSRPT",n)=report output or to print device.
;
N EPCSV,EPCSSAVE,EPCSDESC,EPCSROU
S EPCSV="EPCSSD^EPCSED" D REQCHK(EPCSV) I EPCSERR Q
D DATECHK(.EPCSSD,.EPCSED)
S EPCSSD=EPCSSD-.0001,EPCSED=EPCSED+.9999
I EPCSPTYP="P" D Q
. S EPCSV="EPCSSD^EPCSED"
. S EPCSROU="GUI^PSODEART"
. S EPCSDESC="CHANGES TO DEA PRESCRIBING PRIVILEGES REPORT"
. D QUEUE
U IO D GUI^PSODEART
Q
EPCSLACA ;Logical Access Control Audit Report RPC Call [PSO EPCS LOGICAL ACCESS CONTROL AUDIT]
;
; Variables passed in
; EPCSSD - Start Date or Report
; EPCSED - End Date or Report
; EPCSPTYP - Send output to:
;
; Variable returned
; ^TMP($J,"EPCSRPT",n)=report output or to print device.
;
N EPCSV,EPCSSAVE,EPCSDESC,EPCSROU
S EPCSV="EPCSSD^EPCSED" D REQCHK(EPCSV) I EPCSERR Q
D DATECHK(.EPCSSD,.EPCSED)
S EPCSSD=EPCSSD-.0001,EPCSED=EPCSED+.9999
I EPCSPTYP="P" D Q
. S EPCSV="EPCSSD^EPCSED",EPCSROU="GUI^PSODEARL"
. S EPCSDESC="LOGICAL ACCESS CONTROL AUDIT REPORT"
. D QUEUE
U IO D GUI^PSODEARL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOEPRPT 4412 printed Nov 22, 2024@17:37:33 Page 2
PSOEPRPT ;BIR/TJL - ePCS Reports RPC Entry Points ;9/27/22 08:48
+1 ;;7.0;OUTPATIENT PHARMACY;**545**;8 May 96;Build 270
+2 ;
+3 ;Added reports to ePCS GUI v 2.0 - Summer 2021.
REQCHK(EPCSVV) ;Required data check
+1 NEW I,C
+2 SET C=1
+3 FOR I=1:1:$LENGTH(EPCSV,U)
IF '$DATA(@$PIECE(EPCSV,U,I))
Begin DoDot:1
+4 SET ^TMP("EPCSMSG",$JOB,C)="0^Required data missing "_$PIECE(EPCSV,U,I)
+5 SET C=C+1
SET EPCSERR=1
End DoDot:1
+6 QUIT
DATECHK(EPCSSD,EPCSED) ;Check human-friendly date and convert to FileMan format
+1 ; Input EPCSSD - Start Date (ex. 10/9/01)
+2 ; EPCSED - End Date
+3 NEW EPCSI,X,Y
+4 SET %DT="X"
FOR EPCSI="EPCSSD","EPCSED"
SET X=@EPCSI
DO ^%DT
SET @EPCSI=Y
+5 SET EPCSSD=$SELECT(EPCSSD=-1:DT,1:EPCSSD)
SET EPCSED=$SELECT(EPCSED=-1:DT,1:EPCSED)
+6 SET EPCSDATE=$$FMTE^XLFDT(EPCSSD)_"^"_$$FMTE^XLFDT(EPCSED)
+7 QUIT
QUEUE ;Queues report to printer
+1 NEW ZTIO,ZTDESC,ZTRTN,ZTDTH,ZTSAVE,%ZIS,I,IOP,POP
+2 SET IOP="Q;`"_EPCSDEV
SET %ZIS="Q"
DO ^%ZIS
IF POP
Begin DoDot:1
+3 SET ^TMP("EPCSMSG",$JOB,1)="0^Device selection unsuccessful"
End DoDot:1
QUIT
+4 SET ZTIO=ION
SET ZTDESC=EPCSDESC
SET ZTRTN=EPCSROU
+5 SET ZTDTH=$$FMTH^XLFDT(EPCSQDT)
+6 ;D NOW^%DTC S ZTDTH=$S(%'<EPCSQDT:%+.0002,1:EPCSQDT)
+7 FOR I=1:1:$LENGTH(EPCSV,U)
IF $DATA(@$PIECE(EPCSV,U,I))
SET ZTSAVE($PIECE(EPCSV,U,I))=""
+8 MERGE ZTSAVE=EPCSSAVE
+9 ;K IO("Q")
DO ^%ZTLOAD
DO HOME^%ZIS
DO ^%ZISC
+10 IF $DATA(ZTSK)
SET ^TMP("EPCSMSG",$JOB)="1^Report queued. Task #"_ZTSK
QUIT
+11 SET ^TMP("EPCSMSG",$JOB)="0^Task Rejected"
+12 QUIT
+13 ;
EPCSEXP ;DEA Expiration Date Report for RPC Call
+1 ; Variables passed in
+2 ; EPCSCPRS - System Access to CPRS - Include:
+3 ; (A)ctive, (D)isusered or (B)oth
+4 ; EPCSTYPE - Type of System Access:
+5 ; (C)PRS Active Users Only or (A)ll Active Users
+6 ; EPCSSTAT - Expiration Date Status:
+7 ; (E)xpired, (N)o expiration date, <= (3)0 days, <= (9)0 days
+8 ; EPCSPTYP - Send output to:
+9 ; (P)rinter, (D)evice or screen
+10 ;
+11 ; Variable return
+12 ; ^TMP($J,"EPCSRPT",n)=report output or to print device.
+13 NEW EPCSV,EPCSROU,EPCSDESC
+14 SET EPCSV="EPCSCPRS^EPCSTYPE^EPCSSTAT"
DO REQCHK(EPCSV)
IF EPCSERR
QUIT
+15 IF EPCSPTYP="P"
Begin DoDot:1
+16 SET EPCSROU="GUI^PSODEARP"
+17 SET EPCSDESC="EPCS DEA EXPIRATION DATE REPORT"
+18 DO QUEUE
End DoDot:1
QUIT
+19 DO GUI^PSODEARP
+20 QUIT
EPCSPPP ;Print Prescribers with Privileges [PSO EPCS PRIVS]
+1 ;
+2 ; Variables passed in
+3 ; EPCSPTYP - Send output to:
+4 ; (P)rinter, (D)evice or screen
+5 ;
+6 ; Variable return
+7 ; ^TMP($J,"EPCSRPT",n)=report output or to print device.
+8 ;
+9 NEW EPCSV,EPCSROU,EPCSDESC
+10 SET EPCSV="EPCSPPP"
+11 IF EPCSPTYP="P"
Begin DoDot:1
+12 SET EPCSROU="GUI^PSODEARA"
+13 SET EPCSDESC="PRINT PRESCRIBERS WITH PRIVILEGES"
+14 DO QUEUE
End DoDot:1
QUIT
+15 DO GUI^PSODEARA
+16 QUIT
EPCSDIS ;Print DISUSER Prescriber with Privileges [PSO EPCS DISUSER PRIVS]
+1 ;
+2 ; Variables passed in
+3 ; EPCSPTYP - Send output to:
+4 ; (P)rinter, (D)evice or screen
+5 ;
+6 ; Variable return
+7 ; ^TMP($J,"EPCSRPT",n)=report output or to print device.
+8 ;
+9 NEW EPCSV,EPCSROU,EPCSDESC
+10 SET EPCSV="EPCSDIS"
+11 IF EPCSPTYP="P"
Begin DoDot:1
+12 SET EPCSROU="GUI^PSODEARB"
+13 SET EPCSDESC="PRINT DISUSER PRESCRIBER WITH PRIVILEGES"
+14 DO QUEUE
End DoDot:1
QUIT
+15 DO GUI^PSODEARB
+16 QUIT
EPCSAUD ;Changes to DEA Prescribing Privileges Report RPC Call [PSO EPCS LOGICAL ACCESS REPORT]
+1 ;
+2 ; Variables passed in
+3 ; EPCSSD - Start Date of Report
+4 ; EPCSED - End Date of Report
+5 ; EPCSPTYP - Send output to:
+6 ; (P)rinter, (E)xport, (D)evice or screen
+7 ;
+8 ; Variable return
+9 ; ^TMP($J,"EPCSRPT",n)=report output or to print device.
+10 ;
+11 NEW EPCSV,EPCSSAVE,EPCSDESC,EPCSROU
+12 SET EPCSV="EPCSSD^EPCSED"
DO REQCHK(EPCSV)
IF EPCSERR
QUIT
+13 DO DATECHK(.EPCSSD,.EPCSED)
+14 SET EPCSSD=EPCSSD-.0001
SET EPCSED=EPCSED+.9999
+15 IF EPCSPTYP="P"
Begin DoDot:1
+16 SET EPCSV="EPCSSD^EPCSED"
+17 SET EPCSROU="GUI^PSODEART"
+18 SET EPCSDESC="CHANGES TO DEA PRESCRIBING PRIVILEGES REPORT"
+19 DO QUEUE
End DoDot:1
QUIT
+20 USE IO
DO GUI^PSODEART
+21 QUIT
EPCSLACA ;Logical Access Control Audit Report RPC Call [PSO EPCS LOGICAL ACCESS CONTROL AUDIT]
+1 ;
+2 ; Variables passed in
+3 ; EPCSSD - Start Date or Report
+4 ; EPCSED - End Date or Report
+5 ; EPCSPTYP - Send output to:
+6 ;
+7 ; Variable returned
+8 ; ^TMP($J,"EPCSRPT",n)=report output or to print device.
+9 ;
+10 NEW EPCSV,EPCSSAVE,EPCSDESC,EPCSROU
+11 SET EPCSV="EPCSSD^EPCSED"
DO REQCHK(EPCSV)
IF EPCSERR
QUIT
+12 DO DATECHK(.EPCSSD,.EPCSED)
+13 SET EPCSSD=EPCSSD-.0001
SET EPCSED=EPCSED+.9999
+14 IF EPCSPTYP="P"
Begin DoDot:1
+15 SET EPCSV="EPCSSD^EPCSED"
SET EPCSROU="GUI^PSODEARL"
+16 SET EPCSDESC="LOGICAL ACCESS CONTROL AUDIT REPORT"
+17 DO QUEUE
End DoDot:1
QUIT
+18 USE IO
DO GUI^PSODEARL
+19 QUIT
