source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSDI.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1PSSDI ;BIR/LDT/TSS - API FOR FILEMAN CALLS ;5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,97,104,108,118**;9/30/97;Build 8
3 ;
4DIC(PSSFILE,PSSAPP,DIC,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
5 N PSSX1 ;ADDED BY TS ON 09.20.2006
6 S PSSDIY=""
7 I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
8 N PSRTEST S PSRTEST=$$TEST(PSSFILE)
9 I 'PSRTEST S PSSDIY=-1 G Q
10 K DIC("S")
11 I +$G(PSSSCRDT)>0 N PSSSUBSC,PSSPIECE D SCREEN
12 I $D(PSSVACL),$O(PSSVACL(0))'="" D VACL I $D(PSSX1) S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1 K PSSX1
13 I $G(PSSSCRUS)'="",$G(PSSFILE)=50 N PSSAPLP D
14 .S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_"F PSSAPLP=1:1:$L(PSSSCRUS) I $P($G(^(2)),""^"",3)[$E(PSSSCRUS,PSSAPLP) Q"
15 I '$P(PSRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSSDIY=-1 G Q
16 I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
17 K DTOUT,DUOUT D ^DIC
18 G Q
19DO(PSSFILE,PSSAPP,DIC) ;
20 S PSSDIY=""
21 I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
22 N PSRTEST S PSRTEST=$$TEST(PSSFILE)
23 I 'PSRTEST S PSSDIY=-1 G Q
24 K DTOUT,DUOUT D DO^DIC1
25 Q
26IX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO) ;
27 S PSSDIY=""
28 I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
29 N PSRTEST S PSRTEST=$$TEST(PSSFILE)
30 I 'PSRTEST S PSSDIY=-1 G Q
31 I '$P(PSRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSSDIY=-1 G Q
32 I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
33 K DTOUT,DUOUT D IX^DIC
34 Q
35MIX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
36 N PSSX1 ;ADDED BY TS ON 09.20.2006
37 S PSSDIY=""
38 I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
39 N PSRTEST S PSRTEST=$$TEST(PSSFILE)
40 I 'PSRTEST S PSSDIY=-1 G Q
41 K DIC("S")
42 I +$G(PSSSCRDT)>0 N PSSSUBSC,PSSPIECE D SCREEN
43 I $D(PSSVACL),$O(PSSVACL(0))'="" D VACL I $D(PSSX1) S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1 K PSSX1
44 I $G(PSSSCRUS)'="",$G(PSSFILE)=50 N PSSAPLP D
45 .S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_"F PSSAPLP=1:1:$L(PSSSCRUS) I $P($G(^(2)),""^"",3)[$E(PSSSCRUS,PSSAPLP) Q"
46 I '$P(PSRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSSDIY=-1 G Q
47 I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
48 K DTOUT,DUOUT D MIX^DIC1
49 G Q
50FILE(PSSFILE,PSSAPP,DIC,DA,X,DINUM,DLAYGO) ;
51 S PSSDIY=""
52 I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
53 N PSRTEST S PSRTEST=$$TEST(PSSFILE)
54 I 'PSRTEST S PSSDIY=-1 G Q
55 I '$P(PSRTEST,"^",2) S PSSDIY=-1 G Q
56 K DTOUT,DUOUT,DO D FILE^DICN
57 Q
58DIE(PSSFILE,PSSAPP,DIE,DA,DR,DIDEL) ;
59 S PSSDIY=""
60 I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
61 N PSRTEST S PSRTEST=$$TEST(PSSFILE)
62 I 'PSRTEST S PSSDIY=-1 G Q
63 I '$P(PSRTEST,"^",2) S PSSDIY=-1 G Q
64 K DTOUT D ^DIE
65 Q
66EN1(PSSFILE,PSSAPP,DIC,L,FLDS,BY,FR,TO,DHD) ;
67 S PSSDIY=""
68 I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
69 N PSRTEST S PSRTEST=$$TEST(PSSFILE)
70 I 'PSRTEST S PSSDIY=-1 G Q
71 D EN1^DIP
72 Q
73EN(PSSFILE,PSSAPP,DIC,DR,DA,DIQ) ;
74 S PSSDIY=""
75 I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
76 N PSRTEST S PSRTEST=$$TEST(PSSFILE)
77 I 'PSRTEST S PSSDIY=-1 G Q
78 D EN^DIQ1
79 Q
80FNAME(PSSFNO,PSSFILE) ;
81 ;Return the label for the field of the File or Subfile passed in
82 ;PSSFNO - Field number
83 ;PSSFILE - File or Subfile number
84 Q $$FNAME^PSS50E($G(PSSFNO),$G(PSSFILE))
85 ;
86TEST(PSTFILE) ;
87 N CNT,PSSAPP2,PSFFLAG,PSFLOOP,PSFTEST,PSLNODE,PSRSLT S PSRSLT="0^0",PSFFLAG=0
88 F PSFLOOP=1:1 S PSFTEST=$P($T(FILE2+PSFLOOP),";;",2) Q:+$G(PSFTEST)'>0!PSFFLAG I +PSFTEST=PSTFILE S $P(PSRSLT,"^")=1 S PSLNODE=$T(FILE2+PSFLOOP) D
89 .F CNT=2:1:$L(PSLNODE,";;") S PSSAPP2=$P(PSLNODE,";;",CNT) Q:$P(PSRSLT,"^",2)=1 I PSSAPP2=$G(PSSAPP) S PSFFLAG=1,$P(PSRSLT,"^",2)=1
90 Q PSRSLT
91 ;
92FILE2 ;For DIC call, IF PACKAGE IS LISTED, PACKAGE HAS WRITE ACCESS
93 ;;50;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
94 ;;50.1;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
95 ;;50.0214;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
96 ;;50.037;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
97 ;;50.065;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
98 ;;50.0212;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
99 ;;50.0441;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
100 ;;50.01;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
101 ;;50.02;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
102 ;;50.0903;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
103 ;;50.0904;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
104 ;;50.4;;PSJ;;PSS
105 ;;50.606;;PSJ;;PSN;;PSS
106 ;;50.7;;PSJ;;PSO;;PSN;;PSS
107 ;;50.76;;PSJ;;PSO;;PSN;;PSS
108 ;;50.72;;PSJ;;PSO;;PSN;;PSS
109 ;;51;;PSJ;;PSS
110 ;;51.01;;PSJ;;PSS
111 ;;51.1;;PSJ;;PSS
112 ;;51.11;;PSJ;;PSS
113 ;;51.17;;PSJ;;PSS
114 ;;51.2;;PSJ;;PSS
115 ;;51.5;;PSS
116 ;;52.6;;PSJ;;PSN;;PSS
117 ;;52.61;;PSJ;;PSN;;PSS
118 ;;52.62;;PSJ;;PSN;;PSS
119 ;;52.63;;PSJ;;PSN;;PSS
120 ;;52.64;;PSJ;;PSN;;PSS
121 ;;52.7;;PSJ;;PSN;;PSS
122 ;;52.702;;PSJ;;PSN;;PSS
123 ;;52.703;;PSJ;;PSN;;PSS
124 ;;52.704;;PSJ;;PSN;;PSS
125 ;;54;;PSS;;PSO
126 ;;54.1;;PSS;;PSO
127 ;;9009032.3;;PSS
128 ;;9009032.5;;PSS
129 ;;
130 Q
131 ;
132FILE3 ;For Lookup calls, check for Inactive Date Screen
133 ;;50;;I;;1
134 ;;50.606;;0;;2
135 ;;50.7;;0;;4
136 ;;51.2;;0;;5
137 ;;52.6;;I;;1
138 ;;52.7;;I;;1
139 ;;
140 Q
141SCREEN ;Set screen if Inactive Date is passed in, and for File 50, addition screen if Application Packages Use is passed in
142 N PSSILOOP,PSSILOC,PSSINFLG,PSSINODE S PSSINFLG=0
143 F PSSILOOP=1:1 S PSSILOC=$P($T(FILE3+PSSILOOP),";;",2) Q:+$G(PSSILOC)'>0!PSSINFLG I +PSSILOC=PSSFILE S PSSINFLG=1 S PSSINODE=$T(FILE3+PSSILOOP) D
144 .S PSSSUBSC=$P(PSSINODE,";;",3),PSSPIECE=$P(PSSINODE,";;",4)
145 .I PSSSUBSC'="",PSSPIECE'="" S DIC("S")="I $P($G(^(PSSSUBSC)),""^"",PSSPIECE)=""""!(+$P($G(^(PSSSUBSC)),""^"",PSSPIECE)>+$G(PSSSCRDT))"
146 Q
147VACL S PSSVACL1=0,PSSX=$S($D(PSSVACL("R")):"=",1:"'=") K PSSX1
148 F S PSSVACL1=$O(PSSVACL(PSSVACL1)) Q:PSSVACL1="" I PSSVACL1'="R",PSSVACL1'="P" S PSSX1=$S($G(PSSX1)="":"I $P(^PSDRUG(+Y,0),U,2)"_PSSX_""""_PSSVACL1_"""",1:PSSX1_$S(PSSX="=":"!",1:"&")_"($P(^PSDRUG(+Y,0),U,2)"_PSSX_""""_PSSVACL1_""""_")")
149 Q
150Q K PSSVACL,PSSVACL1,PSSX,PSSX1,PSSFILE,PSSAPP,PSSINODE,PSSSCRUS Q
Note: See TracBrowser for help on using the repository browser.