source: FOIAVistA/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNDI.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1PSNDI ;BIR/LDT - API FOR FILEMAN CALLS; 5 Sep 03
2 ;;4.0; NATIONAL DRUG FILE;**80,109**; 30 Oct 98
3 ;
4DIC(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
14IX(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
24DIE(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
32TEST(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
37FILE ;Package listed if Write access (DLAYGO) is allowed
38 ;;50.416;;PSN
39 ;;50.605;;PSN
40 ;;56;;PSO;;PSN
41 ;;
42 Q
43 ;
44FILE3 ;For Lookup calls, check for Inactive Date Screen
45 ;;50.416;;2;;1
46 ;;56;;0;;7
47 ;;
48 Q
49SCREEN ;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
Note: See TracBrowser for help on using the repository browser.