- 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 Jan 18, 2025@03:28:08 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