PSSDI ;BIR/LDT/TSS - API FOR FILEMAN CALLS ;5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85,91,97,104,108,118,133**;9/30/97;Build 1
;
DIC(PSSFILE,PSSAPP,DIC,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
N PSSX1 ;ADDED BY TS ON 09.20.2006
S PSSDIY=""
I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
N PSRTEST S PSRTEST=$$TEST(PSSFILE)
I 'PSRTEST S PSSDIY=-1 G Q
K DIC("S")
I +$G(PSSSCRDT)>0 N PSSSUBSC,PSSPIECE D SCREEN
I $D(PSSVACL),$O(PSSVACL(0))'="",$G(PSSFILE)=50 D VACL I $D(PSSX1) S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1 K PSSX1
I $G(PSSSCRUS)'="",$G(PSSFILE)=50 N PSSAPLP D
.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"
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
I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
K DTOUT,DUOUT D ^DIC
G Q
DO(PSSFILE,PSSAPP,DIC) ;
S PSSDIY=""
I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
N PSRTEST S PSRTEST=$$TEST(PSSFILE)
I 'PSRTEST S PSSDIY=-1 G Q
K DTOUT,DUOUT D DO^DIC1
Q
IX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO) ;
S PSSDIY=""
I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
N PSRTEST S PSRTEST=$$TEST(PSSFILE)
I 'PSRTEST S PSSDIY=-1 G Q
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
I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
K DTOUT,DUOUT D IX^DIC
Q
MIX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
N PSSX1 ;ADDED BY TS ON 09.20.2006
S PSSDIY=""
I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
N PSRTEST S PSRTEST=$$TEST(PSSFILE)
I 'PSRTEST S PSSDIY=-1 G Q
K DIC("S")
I +$G(PSSSCRDT)>0 N PSSSUBSC,PSSPIECE D SCREEN
I $D(PSSVACL),$O(PSSVACL(0))'="",$G(PSSFILE)=50 D VACL I $D(PSSX1) S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1 K PSSX1
I $G(PSSSCRUS)'="",$G(PSSFILE)=50 N PSSAPLP D
.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"
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
I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
K DTOUT,DUOUT D MIX^DIC1
G Q
FILE(PSSFILE,PSSAPP,DIC,DA,X,DINUM,DLAYGO) ;
S PSSDIY=""
I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
N PSRTEST S PSRTEST=$$TEST(PSSFILE)
I 'PSRTEST S PSSDIY=-1 G Q
I '$P(PSRTEST,"^",2) S PSSDIY=-1 G Q
K DTOUT,DUOUT,DO D FILE^DICN
Q
DIE(PSSFILE,PSSAPP,DIE,DA,DR,DIDEL) ;
S PSSDIY=""
I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
N PSRTEST S PSRTEST=$$TEST(PSSFILE)
I 'PSRTEST S PSSDIY=-1 G Q
I '$P(PSRTEST,"^",2) S PSSDIY=-1 G Q
K DTOUT D ^DIE
Q
EN1(PSSFILE,PSSAPP,DIC,L,FLDS,BY,FR,TO,DHD) ;
S PSSDIY=""
I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
N PSRTEST S PSRTEST=$$TEST(PSSFILE)
I 'PSRTEST S PSSDIY=-1 G Q
D EN1^DIP
Q
EN(PSSFILE,PSSAPP,DIC,DR,DA,DIQ) ;
S PSSDIY=""
I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
N PSRTEST S PSRTEST=$$TEST(PSSFILE)
I 'PSRTEST S PSSDIY=-1 G Q
D EN^DIQ1
Q
FNAME(PSSFNO,PSSFILE) ;
;Return the label for the field of the File or Subfile passed in
;PSSFNO - Field number
;PSSFILE - File or Subfile number
Q $$FNAME^PSS50E($G(PSSFNO),$G(PSSFILE))
;
TEST(PSTFILE) ;
N CNT,PSSAPP2,PSFFLAG,PSFLOOP,PSFTEST,PSLNODE,PSRSLT S PSRSLT="0^0",PSFFLAG=0
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
.F CNT=3:1:$L(PSLNODE,";;") S PSSAPP2=$P(PSLNODE,";;",CNT) Q:$P(PSRSLT,"^",2)=1 I PSSAPP2=$G(PSSAPP) S PSFFLAG=1,$P(PSRSLT,"^",2)=1
Q PSRSLT
;
FILE2 ;For DIC call, IF PACKAGE IS LISTED, PACKAGE HAS WRITE ACCESS
;;50;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.1;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.0214;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.037;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.065;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.0212;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.0441;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.01;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.02;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.0903;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.0904;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
;;50.4;;PSJ;;PSS
;;50.606;;PSJ;;PSN;;PSS
;;50.7;;PSJ;;PSO;;PSN;;PSS
;;50.76;;PSJ;;PSO;;PSN;;PSS
;;50.72;;PSJ;;PSO;;PSN;;PSS
;;51;;PSJ;;PSS
;;51.01;;PSJ;;PSS
;;51.1;;PSJ;;PSS
;;51.11;;PSJ;;PSS
;;51.17;;PSJ;;PSS
;;51.2;;PSJ;;PSS
;;51.5;;PSS
;;52.6;;PSJ;;PSN;;PSS
;;52.61;;PSJ;;PSN;;PSS
;;52.62;;PSJ;;PSN;;PSS
;;52.63;;PSJ;;PSN;;PSS
;;52.64;;PSJ;;PSN;;PSS
;;52.7;;PSJ;;PSN;;PSS
;;52.702;;PSJ;;PSN;;PSS
;;52.703;;PSJ;;PSN;;PSS
;;52.704;;PSJ;;PSN;;PSS
;;54;;PSS;;PSO
;;54.1;;PSS;;PSO
;;9009032.3;;PSS
;;9009032.5;;PSS
;;
Q
;
FILE3 ;For Lookup calls, check for Inactive Date Screen
;;50;;I;;1
;;50.606;;0;;2
;;50.7;;0;;4
;;51.2;;0;;5
;;52.6;;I;;1
;;52.7;;I;;1
;;
Q
SCREEN ;Set screen if Inactive Date is passed in, and for File 50, addition screen if Application Packages Use is passed in
N PSSILOOP,PSSILOC,PSSINFLG,PSSINODE S PSSINFLG=0
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
.S PSSSUBSC=$P(PSSINODE,";;",3),PSSPIECE=$P(PSSINODE,";;",4)
.I PSSSUBSC'="",PSSPIECE'="" S DIC("S")="I $P($G(^(PSSSUBSC)),""^"",PSSPIECE)=""""!(+$P($G(^(PSSSUBSC)),""^"",PSSPIECE)>+$G(PSSSCRDT))"
Q
VACL S PSSVACL1=0,PSSX=$S($D(PSSVACL("R")):"=",1:"'=") K PSSX1
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_""""_")")
Q
Q K PSSVACL,PSSVACL1,PSSX,PSSX1,PSSFILE,PSSAPP,PSSINODE,PSSSCRUS Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDI 5820 printed Dec 13, 2024@02:30:50 Page 2
PSSDI ;BIR/LDT/TSS - API FOR FILEMAN CALLS ;5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,97,104,108,118,133**;9/30/97;Build 1
+2 ;
DIC(PSSFILE,PSSAPP,DIC,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
+1 ;ADDED BY TS ON 09.20.2006
NEW PSSX1
+2 SET PSSDIY=""
+3 IF +$GET(PSSFILE)'>0
SET PSSDIY=-1
GOTO Q
+4 NEW PSRTEST
SET PSRTEST=$$TEST(PSSFILE)
+5 IF 'PSRTEST
SET PSSDIY=-1
GOTO Q
+6 KILL DIC("S")
+7 IF +$GET(PSSSCRDT)>0
NEW PSSSUBSC,PSSPIECE
DO SCREEN
+8 IF $DATA(PSSVACL)
IF $ORDER(PSSVACL(0))'=""
IF $GET(PSSFILE)=50
DO VACL
IF $DATA(PSSX1)
SET DIC("S")=$SELECT($GET(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1
KILL PSSX1
+9 IF $GET(PSSSCRUS)'=""
IF $GET(PSSFILE)=50
NEW PSSAPLP
Begin DoDot:1
+10 SET DIC("S")=$SELECT($GET(DIC("S"))'="":DIC("S")_" ",1:"")_"F PSSAPLP=1:1:$L(PSSSCRUS) I $P($G(^(2)),""^"",3)[$E(PSSSCRUS,PSSAPLP) Q"
End DoDot:1
+11 IF '$PIECE(PSRTEST,"^",2)
KILL DLAYGO
IF $GET(DIC(0))'=""
SET DIC(0)=$TRANSLATE(DIC(0),"L","")
IF $GET(DIC(0))=""
SET PSSDIY=-1
GOTO Q
+12 IF $GET(DIC(0))=""
IF $GET(X)=""
SET PSSDIY=-1
GOTO Q
+13 KILL DTOUT,DUOUT
DO ^DIC
+14 GOTO Q
DO(PSSFILE,PSSAPP,DIC) ;
+1 SET PSSDIY=""
+2 IF +$GET(PSSFILE)'>0
SET PSSDIY=-1
GOTO Q
+3 NEW PSRTEST
SET PSRTEST=$$TEST(PSSFILE)
+4 IF 'PSRTEST
SET PSSDIY=-1
GOTO Q
+5 KILL DTOUT,DUOUT
DO DO^DIC1
+6 QUIT
IX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO) ;
+1 SET PSSDIY=""
+2 IF +$GET(PSSFILE)'>0
SET PSSDIY=-1
GOTO Q
+3 NEW PSRTEST
SET PSRTEST=$$TEST(PSSFILE)
+4 IF 'PSRTEST
SET PSSDIY=-1
GOTO Q
+5 IF '$PIECE(PSRTEST,"^",2)
KILL DLAYGO
IF $GET(DIC(0))'=""
SET DIC(0)=$TRANSLATE(DIC(0),"L","")
IF $GET(DIC(0))=""
SET PSSDIY=-1
GOTO Q
+6 IF $GET(DIC(0))=""
IF $GET(X)=""
SET PSSDIY=-1
GOTO Q
+7 KILL DTOUT,DUOUT
DO IX^DIC
+8 QUIT
MIX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
+1 ;ADDED BY TS ON 09.20.2006
NEW PSSX1
+2 SET PSSDIY=""
+3 IF +$GET(PSSFILE)'>0
SET PSSDIY=-1
GOTO Q
+4 NEW PSRTEST
SET PSRTEST=$$TEST(PSSFILE)
+5 IF 'PSRTEST
SET PSSDIY=-1
GOTO Q
+6 KILL DIC("S")
+7 IF +$GET(PSSSCRDT)>0
NEW PSSSUBSC,PSSPIECE
DO SCREEN
+8 IF $DATA(PSSVACL)
IF $ORDER(PSSVACL(0))'=""
IF $GET(PSSFILE)=50
DO VACL
IF $DATA(PSSX1)
SET DIC("S")=$SELECT($GET(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1
KILL PSSX1
+9 IF $GET(PSSSCRUS)'=""
IF $GET(PSSFILE)=50
NEW PSSAPLP
Begin DoDot:1
+10 SET DIC("S")=$SELECT($GET(DIC("S"))'="":DIC("S")_" ",1:"")_"F PSSAPLP=1:1:$L(PSSSCRUS) I $P($G(^(2)),""^"",3)[$E(PSSSCRUS,PSSAPLP) Q"
End DoDot:1
+11 IF '$PIECE(PSRTEST,"^",2)
KILL DLAYGO
IF $GET(DIC(0))'=""
SET DIC(0)=$TRANSLATE(DIC(0),"L","")
IF $GET(DIC(0))=""
SET PSSDIY=-1
GOTO Q
+12 IF $GET(DIC(0))=""
IF $GET(X)=""
SET PSSDIY=-1
GOTO Q
+13 KILL DTOUT,DUOUT
DO MIX^DIC1
+14 GOTO Q
FILE(PSSFILE,PSSAPP,DIC,DA,X,DINUM,DLAYGO) ;
+1 SET PSSDIY=""
+2 IF +$GET(PSSFILE)'>0
SET PSSDIY=-1
GOTO Q
+3 NEW PSRTEST
SET PSRTEST=$$TEST(PSSFILE)
+4 IF 'PSRTEST
SET PSSDIY=-1
GOTO Q
+5 IF '$PIECE(PSRTEST,"^",2)
SET PSSDIY=-1
GOTO Q
+6 KILL DTOUT,DUOUT,DO
DO FILE^DICN
+7 QUIT
DIE(PSSFILE,PSSAPP,DIE,DA,DR,DIDEL) ;
+1 SET PSSDIY=""
+2 IF +$GET(PSSFILE)'>0
SET PSSDIY=-1
GOTO Q
+3 NEW PSRTEST
SET PSRTEST=$$TEST(PSSFILE)
+4 IF 'PSRTEST
SET PSSDIY=-1
GOTO Q
+5 IF '$PIECE(PSRTEST,"^",2)
SET PSSDIY=-1
GOTO Q
+6 KILL DTOUT
DO ^DIE
+7 QUIT
EN1(PSSFILE,PSSAPP,DIC,L,FLDS,BY,FR,TO,DHD) ;
+1 SET PSSDIY=""
+2 IF +$GET(PSSFILE)'>0
SET PSSDIY=-1
GOTO Q
+3 NEW PSRTEST
SET PSRTEST=$$TEST(PSSFILE)
+4 IF 'PSRTEST
SET PSSDIY=-1
GOTO Q
+5 DO EN1^DIP
+6 QUIT
EN(PSSFILE,PSSAPP,DIC,DR,DA,DIQ) ;
+1 SET PSSDIY=""
+2 IF +$GET(PSSFILE)'>0
SET PSSDIY=-1
GOTO Q
+3 NEW PSRTEST
SET PSRTEST=$$TEST(PSSFILE)
+4 IF 'PSRTEST
SET PSSDIY=-1
GOTO Q
+5 DO EN^DIQ1
+6 QUIT
FNAME(PSSFNO,PSSFILE) ;
+1 ;Return the label for the field of the File or Subfile passed in
+2 ;PSSFNO - Field number
+3 ;PSSFILE - File or Subfile number
+4 QUIT $$FNAME^PSS50E($GET(PSSFNO),$GET(PSSFILE))
+5 ;
TEST(PSTFILE) ;
+1 NEW CNT,PSSAPP2,PSFFLAG,PSFLOOP,PSFTEST,PSLNODE,PSRSLT
SET PSRSLT="0^0"
SET PSFFLAG=0
+2 FOR PSFLOOP=1:1
SET PSFTEST=$PIECE($TEXT(FILE2+PSFLOOP),";;",2)
if +$GET(PSFTEST)'>0!PSFFLAG
QUIT
IF +PSFTEST=PSTFILE
SET $PIECE(PSRSLT,"^")=1
SET PSLNODE=$TEXT(FILE2+PSFLOOP)
Begin DoDot:1
+3 FOR CNT=3:1:$LENGTH(PSLNODE,";;")
SET PSSAPP2=$PIECE(PSLNODE,";;",CNT)
if $PIECE(PSRSLT,"^",2)=1
QUIT
IF PSSAPP2=$GET(PSSAPP)
SET PSFFLAG=1
SET $PIECE(PSRSLT,"^",2)=1
End DoDot:1
+4 QUIT PSRSLT
+5 ;
FILE2 ;For DIC call, IF PACKAGE IS LISTED, PACKAGE HAS WRITE ACCESS
+1 ;;50;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+2 ;;50.1;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+3 ;;50.0214;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+4 ;;50.037;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+5 ;;50.065;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+6 ;;50.0212;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+7 ;;50.0441;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+8 ;;50.01;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+9 ;;50.02;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+10 ;;50.0903;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+11 ;;50.0904;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
+12 ;;50.4;;PSJ;;PSS
+13 ;;50.606;;PSJ;;PSN;;PSS
+14 ;;50.7;;PSJ;;PSO;;PSN;;PSS
+15 ;;50.76;;PSJ;;PSO;;PSN;;PSS
+16 ;;50.72;;PSJ;;PSO;;PSN;;PSS
+17 ;;51;;PSJ;;PSS
+18 ;;51.01;;PSJ;;PSS
+19 ;;51.1;;PSJ;;PSS
+20 ;;51.11;;PSJ;;PSS
+21 ;;51.17;;PSJ;;PSS
+22 ;;51.2;;PSJ;;PSS
+23 ;;51.5;;PSS
+24 ;;52.6;;PSJ;;PSN;;PSS
+25 ;;52.61;;PSJ;;PSN;;PSS
+26 ;;52.62;;PSJ;;PSN;;PSS
+27 ;;52.63;;PSJ;;PSN;;PSS
+28 ;;52.64;;PSJ;;PSN;;PSS
+29 ;;52.7;;PSJ;;PSN;;PSS
+30 ;;52.702;;PSJ;;PSN;;PSS
+31 ;;52.703;;PSJ;;PSN;;PSS
+32 ;;52.704;;PSJ;;PSN;;PSS
+33 ;;54;;PSS;;PSO
+34 ;;54.1;;PSS;;PSO
+35 ;;9009032.3;;PSS
+36 ;;9009032.5;;PSS
+37 ;;
+38 QUIT
+39 ;
FILE3 ;For Lookup calls, check for Inactive Date Screen
+1 ;;50;;I;;1
+2 ;;50.606;;0;;2
+3 ;;50.7;;0;;4
+4 ;;51.2;;0;;5
+5 ;;52.6;;I;;1
+6 ;;52.7;;I;;1
+7 ;;
+8 QUIT
SCREEN ;Set screen if Inactive Date is passed in, and for File 50, addition screen if Application Packages Use is passed in
+1 NEW PSSILOOP,PSSILOC,PSSINFLG,PSSINODE
SET PSSINFLG=0
+2 FOR PSSILOOP=1:1
SET PSSILOC=$PIECE($TEXT(FILE3+PSSILOOP),";;",2)
if +$GET(PSSILOC)'>0!PSSINFLG
QUIT
IF +PSSILOC=PSSFILE
SET PSSINFLG=1
SET PSSINODE=$TEXT(FILE3+PSSILOOP)
Begin DoDot:1
+3 SET PSSSUBSC=$PIECE(PSSINODE,";;",3)
SET PSSPIECE=$PIECE(PSSINODE,";;",4)
+4 IF PSSSUBSC'=""
IF PSSPIECE'=""
SET DIC("S")="I $P($G(^(PSSSUBSC)),""^"",PSSPIECE)=""""!(+$P($G(^(PSSSUBSC)),""^"",PSSPIECE)>+$G(PSSSCRDT))"
End DoDot:1
+5 QUIT
VACL SET PSSVACL1=0
SET PSSX=$SELECT($DATA(PSSVACL("R")):"=",1:"'=")
KILL PSSX1
+1 FOR
SET PSSVACL1=$ORDER(PSSVACL(PSSVACL1))
if PSSVACL1=""
QUIT
IF PSSVACL1'="R"
IF PSSVACL1'="P"
SET PSSX1=$SELECT($GET(PSSX1)="":"I $P(^PSDRUG(+Y,0),U,2)"_PSSX_""""_PSSVACL1_"""",1:PSSX1_$SELECT(PSSX="=":"!",1:"&")_"($P(^PSDRUG(+Y,0),U,2)"_PSSX_""""_PSSVACL1_""""_")")
+2 QUIT
Q KILL PSSVACL,PSSVACL1,PSSX,PSSX1,PSSFILE,PSSAPP,PSSINODE,PSSSCRUS
QUIT
