Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSSDI

PSSDI.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. DIC(PSSFILE,PSSAPP,DIC,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
  1. N PSSX1 ;ADDED BY TS ON 09.20.2006
  1. S PSSDIY=""
  1. I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
  1. N PSRTEST S PSRTEST=$$TEST(PSSFILE)
  1. I 'PSRTEST S PSSDIY=-1 G Q
  1. K DIC("S")
  1. I +$G(PSSSCRDT)>0 N PSSSUBSC,PSSPIECE D SCREEN
  1. 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
  1. I $G(PSSSCRUS)'="",$G(PSSFILE)=50 N PSSAPLP D
  1. .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"
  1. 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
  1. I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
  1. K DTOUT,DUOUT D ^DIC
  1. G Q
  1. DO(PSSFILE,PSSAPP,DIC) ;
  1. S PSSDIY=""
  1. I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
  1. N PSRTEST S PSRTEST=$$TEST(PSSFILE)
  1. I 'PSRTEST S PSSDIY=-1 G Q
  1. K DTOUT,DUOUT D DO^DIC1
  1. Q
  1. IX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO) ;
  1. S PSSDIY=""
  1. I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
  1. N PSRTEST S PSRTEST=$$TEST(PSSFILE)
  1. I 'PSRTEST S PSSDIY=-1 G Q
  1. 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
  1. I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
  1. K DTOUT,DUOUT D IX^DIC
  1. Q
  1. MIX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
  1. N PSSX1 ;ADDED BY TS ON 09.20.2006
  1. S PSSDIY=""
  1. I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
  1. N PSRTEST S PSRTEST=$$TEST(PSSFILE)
  1. I 'PSRTEST S PSSDIY=-1 G Q
  1. K DIC("S")
  1. I +$G(PSSSCRDT)>0 N PSSSUBSC,PSSPIECE D SCREEN
  1. 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
  1. I $G(PSSSCRUS)'="",$G(PSSFILE)=50 N PSSAPLP D
  1. .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"
  1. 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
  1. I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
  1. K DTOUT,DUOUT D MIX^DIC1
  1. G Q
  1. FILE(PSSFILE,PSSAPP,DIC,DA,X,DINUM,DLAYGO) ;
  1. S PSSDIY=""
  1. I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
  1. N PSRTEST S PSRTEST=$$TEST(PSSFILE)
  1. I 'PSRTEST S PSSDIY=-1 G Q
  1. I '$P(PSRTEST,"^",2) S PSSDIY=-1 G Q
  1. K DTOUT,DUOUT,DO D FILE^DICN
  1. Q
  1. DIE(PSSFILE,PSSAPP,DIE,DA,DR,DIDEL) ;
  1. S PSSDIY=""
  1. I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
  1. N PSRTEST S PSRTEST=$$TEST(PSSFILE)
  1. I 'PSRTEST S PSSDIY=-1 G Q
  1. I '$P(PSRTEST,"^",2) S PSSDIY=-1 G Q
  1. K DTOUT D ^DIE
  1. Q
  1. EN1(PSSFILE,PSSAPP,DIC,L,FLDS,BY,FR,TO,DHD) ;
  1. S PSSDIY=""
  1. I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
  1. N PSRTEST S PSRTEST=$$TEST(PSSFILE)
  1. I 'PSRTEST S PSSDIY=-1 G Q
  1. D EN1^DIP
  1. Q
  1. EN(PSSFILE,PSSAPP,DIC,DR,DA,DIQ) ;
  1. S PSSDIY=""
  1. I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
  1. N PSRTEST S PSRTEST=$$TEST(PSSFILE)
  1. I 'PSRTEST S PSSDIY=-1 G Q
  1. D EN^DIQ1
  1. Q
  1. FNAME(PSSFNO,PSSFILE) ;
  1. ;Return the label for the field of the File or Subfile passed in
  1. ;PSSFNO - Field number
  1. ;PSSFILE - File or Subfile number
  1. Q $$FNAME^PSS50E($G(PSSFNO),$G(PSSFILE))
  1. ;
  1. TEST(PSTFILE) ;
  1. N CNT,PSSAPP2,PSFFLAG,PSFLOOP,PSFTEST,PSLNODE,PSRSLT S PSRSLT="0^0",PSFFLAG=0
  1. 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
  1. .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
  1. Q PSRSLT
  1. ;
  1. FILE2 ;For DIC call, IF PACKAGE IS LISTED, PACKAGE HAS WRITE ACCESS
  1. ;;50;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.1;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.0214;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.037;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.065;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.0212;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.0441;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.01;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.02;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.0903;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.0904;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
  1. ;;50.4;;PSJ;;PSS
  1. ;;50.606;;PSJ;;PSN;;PSS
  1. ;;50.7;;PSJ;;PSO;;PSN;;PSS
  1. ;;50.76;;PSJ;;PSO;;PSN;;PSS
  1. ;;50.72;;PSJ;;PSO;;PSN;;PSS
  1. ;;51;;PSJ;;PSS
  1. ;;51.01;;PSJ;;PSS
  1. ;;51.1;;PSJ;;PSS
  1. ;;51.11;;PSJ;;PSS
  1. ;;51.17;;PSJ;;PSS
  1. ;;51.2;;PSJ;;PSS
  1. ;;51.5;;PSS
  1. ;;52.6;;PSJ;;PSN;;PSS
  1. ;;52.61;;PSJ;;PSN;;PSS
  1. ;;52.62;;PSJ;;PSN;;PSS
  1. ;;52.63;;PSJ;;PSN;;PSS
  1. ;;52.64;;PSJ;;PSN;;PSS
  1. ;;52.7;;PSJ;;PSN;;PSS
  1. ;;52.702;;PSJ;;PSN;;PSS
  1. ;;52.703;;PSJ;;PSN;;PSS
  1. ;;52.704;;PSJ;;PSN;;PSS
  1. ;;54;;PSS;;PSO
  1. ;;54.1;;PSS;;PSO
  1. ;;9009032.3;;PSS
  1. ;;9009032.5;;PSS
  1. ;;
  1. Q
  1. ;
  1. FILE3 ;For Lookup calls, check for Inactive Date Screen
  1. ;;50;;I;;1
  1. ;;50.606;;0;;2
  1. ;;50.7;;0;;4
  1. ;;51.2;;0;;5
  1. ;;52.6;;I;;1
  1. ;;52.7;;I;;1
  1. ;;
  1. Q
  1. SCREEN ;Set screen if Inactive Date is passed in, and for File 50, addition screen if Application Packages Use is passed in
  1. N PSSILOOP,PSSILOC,PSSINFLG,PSSINODE S PSSINFLG=0
  1. 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
  1. .S PSSSUBSC=$P(PSSINODE,";;",3),PSSPIECE=$P(PSSINODE,";;",4)
  1. .I PSSSUBSC'="",PSSPIECE'="" S DIC("S")="I $P($G(^(PSSSUBSC)),""^"",PSSPIECE)=""""!(+$P($G(^(PSSSUBSC)),""^"",PSSPIECE)>+$G(PSSSCRDT))"
  1. Q
  1. VACL S PSSVACL1=0,PSSX=$S($D(PSSVACL("R")):"=",1:"'=") K PSSX1
  1. 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_""""_")")
  1. Q
  1. Q K PSSVACL,PSSVACL1,PSSX,PSSX1,PSSFILE,PSSAPP,PSSINODE,PSSSCRUS Q