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