| 1 | PSNDI ;BIR/LDT - API FOR FILEMAN CALLS; 5 Sep 03
|
|---|
| 2 | ;;4.0; NATIONAL DRUG FILE;**80,109**; 30 Oct 98
|
|---|
| 3 | ;
|
|---|
| 4 | DIC(PSNFILE,PSNPACK,DIC,X,DLAYGO,PSNSCRDT) ;
|
|---|
| 5 | S PSNDIY=""
|
|---|
| 6 | I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
|
|---|
| 7 | N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
|
|---|
| 8 | I 'PSNRTEST S PSNDIY=-1 Q
|
|---|
| 9 | K DIC("S")
|
|---|
| 10 | I +$G(PSNSCRDT)>0 N PSNSUBSC,PSNPIECE D SCREEN
|
|---|
| 11 | I '$P(PSNRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSNDIY=-1
|
|---|
| 12 | D ^DIC
|
|---|
| 13 | Q
|
|---|
| 14 | IX(PSNFILE,PSNPACK,DIC,D,X,DLAYGO,PSNSCRDT) ;
|
|---|
| 15 | S PSNDIY=""
|
|---|
| 16 | I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
|
|---|
| 17 | N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
|
|---|
| 18 | I 'PSNRTEST S PSNDIY=-1 Q
|
|---|
| 19 | K DIC("S")
|
|---|
| 20 | I +$G(PSNSCRDT)>0 N PSNSUBSC,PSNPIECE D SCREEN
|
|---|
| 21 | I '$P(PSNRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSNDIY=-1
|
|---|
| 22 | D IX^DIC
|
|---|
| 23 | Q
|
|---|
| 24 | DIE(PSNFILE,PSNPACK,DIE,DA,DR,DIDEL) ;
|
|---|
| 25 | S PSNDIY=""
|
|---|
| 26 | I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
|
|---|
| 27 | N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
|
|---|
| 28 | I 'PSNRTEST S PSNDIY=-1 Q
|
|---|
| 29 | I '$P(PSNRTEST,"^",2) S PSNDIY=-1 Q
|
|---|
| 30 | D ^DIE
|
|---|
| 31 | Q
|
|---|
| 32 | TEST(PSNTFILE) ;
|
|---|
| 33 | N CNT,PSNAPP2,PSNFFLAG,PSNFLOOP,PSNFTEST,PSNLNODE,PSNRSLT S PSNRSLT="0^0",PSNFFLAG=0
|
|---|
| 34 | 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
|
|---|
| 35 | .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
|
|---|
| 36 | Q PSNRSLT
|
|---|
| 37 | FILE ;Package listed if Write access (DLAYGO) is allowed
|
|---|
| 38 | ;;50.416;;PSN
|
|---|
| 39 | ;;50.605;;PSN
|
|---|
| 40 | ;;56;;PSO;;PSN
|
|---|
| 41 | ;;
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | FILE3 ;For Lookup calls, check for Inactive Date Screen
|
|---|
| 45 | ;;50.416;;2;;1
|
|---|
| 46 | ;;56;;0;;7
|
|---|
| 47 | ;;
|
|---|
| 48 | Q
|
|---|
| 49 | SCREEN ;Set screen if Inactive Date is passed in, and for File 50, addition screen if Application Packages Use is passed in
|
|---|
| 50 | N PSNILOOP,PSNILOC,PSNINFLG,PSNINODE S PSNINFLG=0
|
|---|
| 51 | 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
|
|---|
| 52 | .S PSNSUBSC=$P(PSNINODE,";;",3),PSNPIECE=$P(PSNINODE,";;",4)
|
|---|
| 53 | .I PSNSUBSC'="",PSNPIECE'="" S DIC("S")="I $P($G(^(PSNSUBSC)),""^"",PSNPIECE)=""""!(+$P($G(^(PSNSUBSC)),""^"",PSNPIECE)>+$G(PSNSCRDT))"
|
|---|
| 54 | Q
|
|---|
