55 lines
2.1 KiB
Mathematica
55 lines
2.1 KiB
Mathematica
PSNDI ;BIR/LDT - API FOR FILEMAN CALLS; 5 Sep 03
|
|
;;4.0; NATIONAL DRUG FILE;**80,109**; 30 Oct 98
|
|
;
|
|
DIC(PSNFILE,PSNPACK,DIC,X,DLAYGO,PSNSCRDT) ;
|
|
S PSNDIY=""
|
|
I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
|
|
N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
|
|
I 'PSNRTEST S PSNDIY=-1 Q
|
|
K DIC("S")
|
|
I +$G(PSNSCRDT)>0 N PSNSUBSC,PSNPIECE D SCREEN
|
|
I '$P(PSNRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSNDIY=-1
|
|
D ^DIC
|
|
Q
|
|
IX(PSNFILE,PSNPACK,DIC,D,X,DLAYGO,PSNSCRDT) ;
|
|
S PSNDIY=""
|
|
I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
|
|
N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
|
|
I 'PSNRTEST S PSNDIY=-1 Q
|
|
K DIC("S")
|
|
I +$G(PSNSCRDT)>0 N PSNSUBSC,PSNPIECE D SCREEN
|
|
I '$P(PSNRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSNDIY=-1
|
|
D IX^DIC
|
|
Q
|
|
DIE(PSNFILE,PSNPACK,DIE,DA,DR,DIDEL) ;
|
|
S PSNDIY=""
|
|
I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
|
|
N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
|
|
I 'PSNRTEST S PSNDIY=-1 Q
|
|
I '$P(PSNRTEST,"^",2) S PSNDIY=-1 Q
|
|
D ^DIE
|
|
Q
|
|
TEST(PSNTFILE) ;
|
|
N CNT,PSNAPP2,PSNFFLAG,PSNFLOOP,PSNFTEST,PSNLNODE,PSNRSLT S PSNRSLT="0^0",PSNFFLAG=0
|
|
F PSNFLOOP=1:1 S PSNFTEST=$P($T(FILE+PSNFLOOP),";;",2) Q:+$G(PSNFTEST)'>0!PSNFFLAG I +PSNFTEST=PSNTFILE S $P(PSNRSLT,"^")=1 S PSNLNODE=$T(FILE+PSNFLOOP) D
|
|
.F CNT=2:1:$L(PSNLNODE,";;") S PSNAPP2=$P(PSNLNODE,";;",CNT) Q:$P(PSNRSLT,"^",2)=1 I PSNAPP2=$G(PSNPACK) S PSNFFLAG=1,$P(PSNRSLT,"^",2)=1
|
|
Q PSNRSLT
|
|
FILE ;Package listed if Write access (DLAYGO) is allowed
|
|
;;50.416;;PSN
|
|
;;50.605;;PSN
|
|
;;56;;PSO;;PSN
|
|
;;
|
|
Q
|
|
;
|
|
FILE3 ;For Lookup calls, check for Inactive Date Screen
|
|
;;50.416;;2;;1
|
|
;;56;;0;;7
|
|
;;
|
|
Q
|
|
SCREEN ;Set screen if Inactive Date is passed in, and for File 50, addition screen if Application Packages Use is passed in
|
|
N PSNILOOP,PSNILOC,PSNINFLG,PSNINODE S PSNINFLG=0
|
|
F PSNILOOP=1:1 S PSNILOC=$P($T(FILE3+PSNILOOP),";;",2) Q:+$G(PSNILOC)'>0!PSNINFLG I +PSNILOC=PSNFILE S PSNINFLG=1 S PSNINODE=$T(FILE3+PSNILOOP) D
|
|
.S PSNSUBSC=$P(PSNINODE,";;",3),PSNPIECE=$P(PSNINODE,";;",4)
|
|
.I PSNSUBSC'="",PSNPIECE'="" S DIC("S")="I $P($G(^(PSNSUBSC)),""^"",PSNPIECE)=""""!(+$P($G(^(PSNSUBSC)),""^"",PSNPIECE)>+$G(PSNSCRDT))"
|
|
Q
|