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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODI 3304 printed Sep 23, 2025@20:03:15 Page 2
PSODI ;BHM/AGV - API FOR FILEMAN CALLS ;04/19/06 10:30 am
+1 ;;7.0;OUTPATIENT PHARMACY;**245,267**;DEC 1997;Build 3
+2 ;
DIQ(PSOFILE,DIC,DR,DA,DIQ) ;PROCESS FIELDS
+1 ;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
+2 ;DIC,DR,DA,DIQ: SEE VA FILEMAN PROGRAMMER MANUAL FOR EN^DIQ1 INPUT DEFINITIONS
+3 ;
+4 SET PSODIY=""
+5 IF +$GET(PSOFILE)'>0
SET PSODIY=-1
QUIT
+6 NEW PSOTEST
SET PSOTEST=$$VALID1(PSOFILE,DIC)
+7 IF PSOTEST'>0
SET PSODIY=-1
QUIT
+8 DO EN^DIQ1
+9 QUIT
+10 ;
GET1(PSOFILE,PSOIEN,PSOFIELD,PSOFLAGS,PSOWORD) ;RETRIEVE FIELD DATA
+1 ;PSOFILE: FILE OR SUBFILE NUMBER
+2 ;PSOIEN: IEN FOR DATA RETURN
+3 ;PSOFIELD: FIELD FOR DATA RETURN
+4 ;FLAGS: CONTROLS THE PROCESSING OF DATA RETURNED
+5 ;PSOWORD: REQUIRED FOR RETURN OF WORD PROCESSING FIELDS
+6 ;
+7 NEW PSORET,DIERR,DIRUT,DIROUT,DUOUT,DTOUT,DIHELP,DIMSG
+8 IF $GET(PSOFILE)=""
SET PSORET="0^FILEMAN UNABLE TO PROCESS REQUEST"
QUIT PSORET
+9 IF $GET(PSOIEN)=""
SET PSOIEN=""
+10 IF $GET(PSOFIELD)=""
SET PSOFIELD=""
+11 IF $GET(PSOFLAGS)=""
SET PSOFLAGS=""
+12 IF $GET(PSOWORD)=""
SET PSOWORD=""
+13 NEW PSOTEST
SET PSOTEST=$$VALID3(PSOFILE)
+14 IF PSOTEST'>0
SET PSORET="0^FILE ACCESS ERROR"
QUIT PSORET
+15 SET PSORET=$$GET1^DIQ(PSOFILE,PSOIEN,PSOFIELD,PSOFLAGS,PSOWORD,"DIERR")
+16 IF $DATA(DIERR)
SET PSORET="0^FILEMAN UNABLE TO PROCESS REQUEST"
QUIT PSORET
+17 QUIT "1^"_PSORET
+18 ;
STATUS(PSOFILE,PSOFIELD,LIST) ;PROCESS FIELDS
+1 ;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
+2 ;PSOFIELD: FIELD NUMBER FROM FILE
+3 ;LIST: SUBSCRIPT USED IN LOCAL ARRAY
+4 ;
+5 if '$GET(PSOFILE)
QUIT
if '$GET(PSOFIELD)
QUIT
if $GET(LIST)=""
QUIT
+6 SET PSODIY=""
+7 NEW PSOTEST
SET PSOTEST=$$VALID2(PSOFILE,PSOFIELD)
+8 IF PSOTEST'>0
SET PSODIY=-1
QUIT
+9 DO FIELD^DID(PSOFILE,PSOFIELD,"","POINTER",LIST)
+10 QUIT
+11 ;
DIC(PSOFILE,DIC,X) ;
+1 ;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
+2 ;DIC,X: SEE VA FILEMAN PROGRAMMER MANUAL FOR ^DIC INPUT DEFINITIONS
+3 ;
+4 SET PSODIY=""
+5 IF +$GET(PSOFILE)'>0
SET PSODIY=-1
QUIT
+6 NEW PSOTEST
SET PSOTEST=$$VALID1(PSOFILE,DIC)
+7 IF PSOTEST'>0
SET PSODIY=-1
QUIT
+8 IF $GET(DIC(0))'=""
SET DIC(0)=$TRANSLATE(DIC(0),"L","")
IF $GET(DIC(0))=""
SET PSODIY=-1
QUIT
+9 DO ^DIC
+10 QUIT
+11 ;
VALID1(PSTFILE,PSTDIC) ;TEST FOR VALID DATA INPUT INTO PSOFILE AND DIC
+1 NEW PSVLOOP,PSVTEST,PSVALID
SET PSVALID=-1
+2 FOR PSVLOOP=1:1
SET PSVTEST=$PIECE($TEXT(FILE1+PSVLOOP),";;",2)_";;"_$PIECE($TEXT(FILE1+PSVLOOP),";;",3)
if $GET(PSVTEST)'>0!(PSVALID=1)
QUIT
Begin DoDot:1
+3 IF PSTFILE=$PIECE(PSVTEST,";;",1)
Begin DoDot:2
+4 IF '$GET(PSTDIC)
Begin DoDot:3
+5 IF PSTDIC=$PIECE(PSVTEST,";;",2)
SET PSVALID=1
End DoDot:3
QUIT
+6 IF PSTDIC=$PIECE(PSVTEST,";;",1)
SET PSVALID=1
End DoDot:2
QUIT
End DoDot:1
+7 QUIT PSVALID
+8 ;
VALID2(PSTFILE,PSTFIELD) ;TEST FOR VALID DATA INPUT INTO PSOFILE AND PSOFIELD
+1 NEW PSVLOOP,PSVTEST,PSVALID
SET PSVALID=-1
+2 FOR PSVLOOP=1:1
SET PSVTEST=$PIECE($TEXT(FILE2+PSVLOOP),";;",2)_";;"_$PIECE($TEXT(FILE2+PSVLOOP),";;",3)
if $GET(PSVTEST)'>0!(PSVALID=1)
QUIT
Begin DoDot:1
+3 IF PSTFILE=$PIECE(PSVTEST,";;",1)
Begin DoDot:2
+4 IF PSTFIELD=$PIECE(PSVTEST,";;",2)
SET PSVALID=1
End DoDot:2
QUIT
End DoDot:1
+5 QUIT PSVALID
+6 ;
VALID3(PSTFILE) ;TEST FOR VALID DATA INPUT INTO PSOFILE
+1 NEW PSVLOOP,PSVTEST,PSVALID
SET PSVALID=-1
+2 FOR PSVLOOP=1:1
SET PSVTEST=$PIECE($TEXT(FILE3+PSVLOOP),";;",2)
if $GET(PSVTEST)'>0!(PSVALID=1)
QUIT
Begin DoDot:1
+3 IF PSTFILE=PSVTEST
SET PSVALID=1
End DoDot:1
+4 QUIT PSVALID
+5 ;
FILE1 ;ACCESS FILE LIST FOR DIQ AND DIC
+1 ;;52;;^PSRX(
+2 ;;59;;^PS(59,
+3 QUIT
+4 ;
FILE2 ;ACCESS FILE LIST FOR STATUS
+1 ;;52;;100
+2 QUIT
+3 ;
FILE3 ;ACCESS FILE LIST FOR GET1
+1 ;;52
+2 ;;52.04
+3 ;;52.032
+4 ;;52.03
+5 ;;52.037
+6 ;;52.038
+7 ;;52.3
+8 ;;52.34
+9 ;;52.1
+10 ;;52.25
+11 ;;52.2
+12 ;;52.0107
+13 ;;52.0113
+14 ;;52.01
+15 ;;52.0401
+16 ;;52.052311
+17 QUIT
