VistA-WorldVistAEHR/r/OUTPATIENT_PHARMACY-PSO-APS.../PSODI.m

107 lines
3.1 KiB
Mathematica

PSODI ;BHM/AGV - API FOR FILEMAN CALLS ;04/19/06 10:30 am
;;7.0;OUTPATIENT PHARMACY;**245,267**;DEC 1997;Build 3
;
DIQ(PSOFILE,DIC,DR,DA,DIQ) ;PROCESS FIELDS
;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
;DIC,DR,DA,DIQ: SEE VA FILEMAN PROGRAMMER MANUAL FOR EN^DIQ1 INPUT DEFINITIONS
;
S PSODIY=""
I +$G(PSOFILE)'>0 S PSODIY=-1 Q
N PSOTEST S PSOTEST=$$VALID1(PSOFILE,DIC)
I PSOTEST'>0 S PSODIY=-1 Q
D EN^DIQ1
Q
;
GET1(PSOFILE,PSOIEN,PSOFIELD,PSOFLAGS,PSOWORD) ;RETRIEVE FIELD DATA
;PSOFILE: FILE OR SUBFILE NUMBER
;PSOIEN: IEN FOR DATA RETURN
;PSOFIELD: FIELD FOR DATA RETURN
;FLAGS: CONTROLS THE PROCESSING OF DATA RETURNED
;PSOWORD: REQUIRED FOR RETURN OF WORD PROCESSING FIELDS
;
N PSORET,DIERR,DIRUT,DIROUT,DUOUT,DTOUT,DIHELP,DIMSG
I $G(PSOFILE)="" S PSORET="0^FILEMAN UNABLE TO PROCESS REQUEST" Q PSORET
I $G(PSOIEN)="" S PSOIEN=""
I $G(PSOFIELD)="" S PSOFIELD=""
I $G(PSOFLAGS)="" S PSOFLAGS=""
I $G(PSOWORD)="" S PSOWORD=""
N PSOTEST S PSOTEST=$$VALID3(PSOFILE)
I PSOTEST'>0 S PSORET="0^FILE ACCESS ERROR" Q PSORET
S PSORET=$$GET1^DIQ(PSOFILE,PSOIEN,PSOFIELD,PSOFLAGS,PSOWORD,"DIERR")
I $D(DIERR) S PSORET="0^FILEMAN UNABLE TO PROCESS REQUEST" Q PSORET
Q "1^"_PSORET
;
STATUS(PSOFILE,PSOFIELD,LIST) ;PROCESS FIELDS
;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
;PSOFIELD: FIELD NUMBER FROM FILE
;LIST: SUBSCRIPT USED IN LOCAL ARRAY
;
Q:'$G(PSOFILE) Q:'$G(PSOFIELD) Q:$G(LIST)=""
S PSODIY=""
N PSOTEST S PSOTEST=$$VALID2(PSOFILE,PSOFIELD)
I PSOTEST'>0 S PSODIY=-1 Q
D FIELD^DID(PSOFILE,PSOFIELD,"","POINTER",LIST)
Q
;
DIC(PSOFILE,DIC,X) ;
;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
;DIC,X: SEE VA FILEMAN PROGRAMMER MANUAL FOR ^DIC INPUT DEFINITIONS
;
S PSODIY=""
I +$G(PSOFILE)'>0 S PSODIY=-1 Q
N PSOTEST S PSOTEST=$$VALID1(PSOFILE,DIC)
I PSOTEST'>0 S PSODIY=-1 Q
I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSODIY=-1 Q
D ^DIC
Q
;
VALID1(PSTFILE,PSTDIC) ;TEST FOR VALID DATA INPUT INTO PSOFILE AND DIC
N PSVLOOP,PSVTEST,PSVALID S PSVALID=-1
F PSVLOOP=1:1 S PSVTEST=$P($T(FILE1+PSVLOOP),";;",2)_";;"_$P($T(FILE1+PSVLOOP),";;",3) Q:$G(PSVTEST)'>0!(PSVALID=1) D
.I PSTFILE=$P(PSVTEST,";;",1) D Q
..I '$G(PSTDIC) D Q
...I PSTDIC=$P(PSVTEST,";;",2) S PSVALID=1
..I PSTDIC=$P(PSVTEST,";;",1) S PSVALID=1
Q PSVALID
;
VALID2(PSTFILE,PSTFIELD) ;TEST FOR VALID DATA INPUT INTO PSOFILE AND PSOFIELD
N PSVLOOP,PSVTEST,PSVALID S PSVALID=-1
F PSVLOOP=1:1 S PSVTEST=$P($T(FILE2+PSVLOOP),";;",2)_";;"_$P($T(FILE2+PSVLOOP),";;",3) Q:$G(PSVTEST)'>0!(PSVALID=1) D
.I PSTFILE=$P(PSVTEST,";;",1) D Q
..I PSTFIELD=$P(PSVTEST,";;",2) S PSVALID=1
Q PSVALID
;
VALID3(PSTFILE) ;TEST FOR VALID DATA INPUT INTO PSOFILE
N PSVLOOP,PSVTEST,PSVALID S PSVALID=-1
F PSVLOOP=1:1 S PSVTEST=$P($T(FILE3+PSVLOOP),";;",2) Q:$G(PSVTEST)'>0!(PSVALID=1) D
.I PSTFILE=PSVTEST S PSVALID=1
Q PSVALID
;
FILE1 ;ACCESS FILE LIST FOR DIQ AND DIC
;;52;;^PSRX(
;;59;;^PS(59,
Q
;
FILE2 ;ACCESS FILE LIST FOR STATUS
;;52;;100
Q
;
FILE3 ;ACCESS FILE LIST FOR GET1
;;52
;;52.04
;;52.032
;;52.03
;;52.037
;;52.038
;;52.3
;;52.34
;;52.1
;;52.25
;;52.2
;;52.0107
;;52.0113
;;52.01
;;52.0401
;;52.052311
Q