source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSODI.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1PSODI ;BHM/AGV - API FOR FILEMAN CALLS ;04/19/06 10:30 am
2 ;;7.0;OUTPATIENT PHARMACY;**245,267**;DEC 1997;Build 3
3 ;
4DIQ(PSOFILE,DIC,DR,DA,DIQ) ;PROCESS FIELDS
5 ;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
6 ;DIC,DR,DA,DIQ: SEE VA FILEMAN PROGRAMMER MANUAL FOR EN^DIQ1 INPUT DEFINITIONS
7 ;
8 S PSODIY=""
9 I +$G(PSOFILE)'>0 S PSODIY=-1 Q
10 N PSOTEST S PSOTEST=$$VALID1(PSOFILE,DIC)
11 I PSOTEST'>0 S PSODIY=-1 Q
12 D EN^DIQ1
13 Q
14 ;
15GET1(PSOFILE,PSOIEN,PSOFIELD,PSOFLAGS,PSOWORD) ;RETRIEVE FIELD DATA
16 ;PSOFILE: FILE OR SUBFILE NUMBER
17 ;PSOIEN: IEN FOR DATA RETURN
18 ;PSOFIELD: FIELD FOR DATA RETURN
19 ;FLAGS: CONTROLS THE PROCESSING OF DATA RETURNED
20 ;PSOWORD: REQUIRED FOR RETURN OF WORD PROCESSING FIELDS
21 ;
22 N PSORET,DIERR,DIRUT,DIROUT,DUOUT,DTOUT,DIHELP,DIMSG
23 I $G(PSOFILE)="" S PSORET="0^FILEMAN UNABLE TO PROCESS REQUEST" Q PSORET
24 I $G(PSOIEN)="" S PSOIEN=""
25 I $G(PSOFIELD)="" S PSOFIELD=""
26 I $G(PSOFLAGS)="" S PSOFLAGS=""
27 I $G(PSOWORD)="" S PSOWORD=""
28 N PSOTEST S PSOTEST=$$VALID3(PSOFILE)
29 I PSOTEST'>0 S PSORET="0^FILE ACCESS ERROR" Q PSORET
30 S PSORET=$$GET1^DIQ(PSOFILE,PSOIEN,PSOFIELD,PSOFLAGS,PSOWORD,"DIERR")
31 I $D(DIERR) S PSORET="0^FILEMAN UNABLE TO PROCESS REQUEST" Q PSORET
32 Q "1^"_PSORET
33 ;
34STATUS(PSOFILE,PSOFIELD,LIST) ;PROCESS FIELDS
35 ;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
36 ;PSOFIELD: FIELD NUMBER FROM FILE
37 ;LIST: SUBSCRIPT USED IN LOCAL ARRAY
38 ;
39 Q:'$G(PSOFILE) Q:'$G(PSOFIELD) Q:$G(LIST)=""
40 S PSODIY=""
41 N PSOTEST S PSOTEST=$$VALID2(PSOFILE,PSOFIELD)
42 I PSOTEST'>0 S PSODIY=-1 Q
43 D FIELD^DID(PSOFILE,PSOFIELD,"","POINTER",LIST)
44 Q
45 ;
46DIC(PSOFILE,DIC,X) ;
47 ;PSOFILE: FILE NUMBER USED FOR VALIDATION OF ACCESS
48 ;DIC,X: SEE VA FILEMAN PROGRAMMER MANUAL FOR ^DIC INPUT DEFINITIONS
49 ;
50 S PSODIY=""
51 I +$G(PSOFILE)'>0 S PSODIY=-1 Q
52 N PSOTEST S PSOTEST=$$VALID1(PSOFILE,DIC)
53 I PSOTEST'>0 S PSODIY=-1 Q
54 I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSODIY=-1 Q
55 D ^DIC
56 Q
57 ;
58VALID1(PSTFILE,PSTDIC) ;TEST FOR VALID DATA INPUT INTO PSOFILE AND DIC
59 N PSVLOOP,PSVTEST,PSVALID S PSVALID=-1
60 F PSVLOOP=1:1 S PSVTEST=$P($T(FILE1+PSVLOOP),";;",2)_";;"_$P($T(FILE1+PSVLOOP),";;",3) Q:$G(PSVTEST)'>0!(PSVALID=1) D
61 .I PSTFILE=$P(PSVTEST,";;",1) D Q
62 ..I '$G(PSTDIC) D Q
63 ...I PSTDIC=$P(PSVTEST,";;",2) S PSVALID=1
64 ..I PSTDIC=$P(PSVTEST,";;",1) S PSVALID=1
65 Q PSVALID
66 ;
67VALID2(PSTFILE,PSTFIELD) ;TEST FOR VALID DATA INPUT INTO PSOFILE AND PSOFIELD
68 N PSVLOOP,PSVTEST,PSVALID S PSVALID=-1
69 F PSVLOOP=1:1 S PSVTEST=$P($T(FILE2+PSVLOOP),";;",2)_";;"_$P($T(FILE2+PSVLOOP),";;",3) Q:$G(PSVTEST)'>0!(PSVALID=1) D
70 .I PSTFILE=$P(PSVTEST,";;",1) D Q
71 ..I PSTFIELD=$P(PSVTEST,";;",2) S PSVALID=1
72 Q PSVALID
73 ;
74VALID3(PSTFILE) ;TEST FOR VALID DATA INPUT INTO PSOFILE
75 N PSVLOOP,PSVTEST,PSVALID S PSVALID=-1
76 F PSVLOOP=1:1 S PSVTEST=$P($T(FILE3+PSVLOOP),";;",2) Q:$G(PSVTEST)'>0!(PSVALID=1) D
77 .I PSTFILE=PSVTEST S PSVALID=1
78 Q PSVALID
79 ;
80FILE1 ;ACCESS FILE LIST FOR DIQ AND DIC
81 ;;52;;^PSRX(
82 ;;59;;^PS(59,
83 Q
84 ;
85FILE2 ;ACCESS FILE LIST FOR STATUS
86 ;;52;;100
87 Q
88 ;
89FILE3 ;ACCESS FILE LIST FOR GET1
90 ;;52
91 ;;52.04
92 ;;52.032
93 ;;52.03
94 ;;52.037
95 ;;52.038
96 ;;52.3
97 ;;52.34
98 ;;52.1
99 ;;52.25
100 ;;52.2
101 ;;52.0107
102 ;;52.0113
103 ;;52.01
104 ;;52.0401
105 ;;52.052311
106 Q
Note: See TracBrowser for help on using the repository browser.