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

PSOEPREP.m

Go to the documentation of this file.
  1. PSOEPREP ;BIR/TJL - ePCS Report RPC Broker ;12/2/21 08:38
  1. ;;7.0;OUTPATIENT PHARMACY;**545**;8 May 96;Build 270
  1. ;
  1. RPTEN(RESULTS,EPCSARY) ;RPC Broker entry point for ePCS Reports
  1. ;All ePCS GUI reports will call this line tag
  1. ; RPC: PSO EPCS REPORTS
  1. ;INPUTS EPCSARY - Contains the following elements for report printing
  1. ; EPCSDEV - Print to queue, if device
  1. ; EPCSQDT - Queue to print (date/time), optional
  1. ; EPCSPTYP - Where to send output (P)rinter, (D)evice or screen
  1. ;
  1. ;OUTPUTS RESULTS - Array of help text in the HELP FRAM File (#9.2)
  1. ;
  1. N HLPDA,HND,EPCSSTR,EPCSFILR,EPCSERR,EPCSDIRY,EPCSUFIL,EPCSGUI
  1. N EPCSQTIM ;CMF should not need this! %DT call below fails for future dates within this routine
  1. I '$G(DUZ) D
  1. . S DUZ=.5,DUZ(0)="@",U="^",DTIME=300
  1. . D NOW^%DTC S DT=X
  1. S EPCSERR=0,EPCSGUI=1 D PARSE,CHKDT I EPCSERR Q
  1. K ^TMP("EPCSMSG",$J),^TMP($J,"EPCSRPT")
  1. D I EPCSERR D END Q
  1. . I EPCSPTYP="E" Q
  1. . I EPCSPTYP="D" D HFSOPEN(EPCSHNDL) Q
  1. . I '$D(EPCSDEV) S ^TMP("EPCSMSG",$J,1)="0^Device undefined",EPCSERR=1
  1. S HND=$P($T(@EPCSHNDL),";;",2) I HND="" D Q
  1. . S ^TMP("EPCSMSG",$J,1)="0^Line Tag undefined" D END
  1. S ^XTMP("PSOEPRPT",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)_"^"_$$DT^XLFDT()
  1. S ^XTMP("PSOEPRPT","PSOEPREP","EPCSQDTbefore")=$G(EPCSQDT) ;;cmf diagnostic hack
  1. S:EPCSPTYP="P" EPCSQTIM=$TR($P(EPCSQDT,"@",2),":","")
  1. S EPCSQDT=$G(EPCSQDT,"NOW"),%DT="XT",X=EPCSQDT D ^%DT ;Print time
  1. S EPCSQDT=$S(Y>0:Y,1:"NOW")
  1. S:EPCSPTYP="P"&(EPCSQDT="NOW") EPCSQDT=DT_"."_EPCSQTIM ;Should not have to do this! %DT malfunctions inside this routine!!!
  1. D @$P(HND,";",2)
  1. I EPCSPTYP="D" D HFSCLOSE(EPCSFILR)
  1. END D KILLVAR
  1. I $D(^TMP("EPCSMSG",$J)) S RESULTS=$NA(^TMP("EPCSMSG",$J)) Q
  1. S RESULTS=$NA(^TMP($J))
  1. Q
  1. ;
  1. PARSE ;Parse data from array for filing
  1. N SUB
  1. S SUB="" F S SUB=$O(EPCSARY(SUB)) Q:SUB="" S @SUB=EPCSARY(SUB)
  1. Q
  1. CHKDT ;Required Data Check
  1. N I,C
  1. S C=1
  1. F I="EPCSHNDL","EPCSPTYP" D
  1. .I $G(@I)="" S ^TMP("EPCSMSG",$J,C)="0^Key data missing "_I,C=C+1,EPCSERR=1
  1. Q
  1. KILLVAR ;Kill variables
  1. N SUB
  1. S SUB="" F S SUB=$O(EPCSARY(SUB)) Q:SUB="" K @SUB
  1. K EPCSARY,POP,ECPSQDT
  1. Q
  1. HFSOPEN(HANDLE) ;
  1. ;S EPCSDIRY=$$GET^XPAR("DIV","EPCS HFS SCRATCH")
  1. S EPCSDIRY=$$DEFDIR^%ZISH()
  1. I EPCSDIRY="" S EPCSERR=1 D Q
  1. .S ^TMP("EPCSMSG",$J,1)="0^A scratch directory for reports doesn't exist"
  1. S EPCSFILR="EPCS"_DUZ_".DAT",EPCSUFIL=EPCSFILR S ^TMP("JEN",$J,.1)=EPCSUFIL
  1. D OPEN^%ZISH(HANDLE,EPCSDIRY,EPCSFILR,"W") D:POP Q:POP
  1. .S EPCSERR=1,^TMP("EPCSMSG",$J,1)="0^Unable to open file "_EPCSDIRY_EPCSFILR
  1. S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
  1. Q
  1. ;
  1. HFSCLOSE(HANDLE) ;
  1. N EPCSDEL
  1. D CLOSE^%ZISH(EPCSDIRY_HANDLE)
  1. K ^TMP($J)
  1. S EPCSDEL(EPCSFILR)=""
  1. S X=$$FTG^%ZISH(EPCSDIRY,EPCSFILR,$NAME(^TMP($J,1)),2)
  1. S X=$$DEL^%ZISH(EPCSDIRY,$NA(EPCSDEL))
  1. Q
  1. EPCSEXP ;;DEA Expiration Date Report;EPCSEXP^PSOEPRPT
  1. EPCSPPP ;;Print Prescribers with Privileges;EPCSPPP^PSOEPRPT
  1. EPCSDIS ;;Print DISUSER Prescriber with Privileges;EPCSDIS^PSOEPRPT
  1. EPCSAUD ;;Print Audits for Prescriber Editing;EPCSAUD^PSOEPRPT
  1. EPCSLACA ;;Logical Access Control Audit;EPCSLACA^PSOEPRPT
  1. EPCS1007 ;;File 100.7 Report;EPCS1007^PSOEPRPT