| [613] | 1 | PSSDI ;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 | ;
|
|---|
| 4 | DIC(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
|
|---|
| 19 | DO(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
|
|---|
| 26 | IX(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
|
|---|
| 35 | MIX(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
|
|---|
| 50 | FILE(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
|
|---|
| 58 | DIE(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
|
|---|
| 66 | EN1(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
|
|---|
| 73 | EN(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
|
|---|
| 80 | FNAME(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 | ;
|
|---|
| 86 | TEST(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 | ;
|
|---|
| 92 | FILE2 ;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 | ;
|
|---|
| 132 | FILE3 ;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
|
|---|
| 141 | SCREEN ;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
|
|---|
| 147 | VACL 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
|
|---|
| 150 | Q K PSSVACL,PSSVACL1,PSSX,PSSX1,PSSFILE,PSSAPP,PSSINODE,PSSSCRUS Q
|
|---|
