Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSNDI

PSNDI.m

Go to the documentation of this file.
  1. PSNDI ;BIR/LDT - API FOR FILEMAN CALLS; 5 Sep 03
  1. ;;4.0;NATIONAL DRUG FILE;**80,109,157,406**; 30 Oct 98;Build 7
  1. ;
  1. DIC(PSNFILE,PSNPACK,DIC,X,DLAYGO,PSNSCRDT) ;
  1. S PSNDIY=""
  1. I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
  1. N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
  1. I 'PSNRTEST S PSNDIY=-1 Q
  1. K DIC("S")
  1. N STNDRD S STNDRD=$$SCREEN^HDISVF01(PSNFILE)
  1. I STNDRD=1 D XSCREEN(PSNFILE)
  1. I STNDRD'=1 N PSNSUBSC,PSNPIECE D NONSTD
  1. I '$P(PSNRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSNDIY=-1
  1. D ^DIC
  1. Q
  1. ;
  1. IX(PSNFILE,PSNPACK,DIC,D,X,DLAYGO,PSNSCRDT) ;
  1. S PSNDIY=""
  1. I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
  1. N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
  1. I 'PSNRTEST S PSNDIY=-1 Q
  1. K DIC("S")
  1. N STNDRD S STNDRD=$$SCREEN^HDISVF01(PSNFILE)
  1. I STNDRD=1 D XSCREEN(PSNFILE)
  1. I STNDRD'=1 N PSNSUBSC,PSNPIECE D NONSTD
  1. I '$P(PSNRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSNDIY=-1
  1. D IX^DIC
  1. Q
  1. ;
  1. DIE(PSNFILE,PSNPACK,DIE,DA,DR,DIDEL) ;
  1. S PSNDIY=""
  1. I +$G(PSNFILE)'>0 S PSNDIY=-1 Q
  1. N PSNRTEST S PSNRTEST=$$TEST(PSNFILE)
  1. I 'PSNRTEST S PSNDIY=-1 Q
  1. I '$P(PSNRTEST,"^",2) S PSNDIY=-1 Q
  1. D ^DIE
  1. Q
  1. ;
  1. TEST(PSNTFILE) ; Test to check if file is listed in the API
  1. N CNT,PSNAPP2,PSNFFLAG,PSNFLOOP,PSNFTEST,PSNLNODE,PSNRSLT S PSNRSLT="0^0",PSNFFLAG=0
  1. F PSNFLOOP=1:1 S PSNFTEST=$P($T(FILE1+PSNFLOOP),";;",2) Q:+$G(PSNFTEST)'>0!PSNFFLAG I +PSNFTEST=PSNTFILE S $P(PSNRSLT,"^")=1 S PSNLNODE=$T(FILE1+PSNFLOOP) D
  1. .F CNT=3:1:$L(PSNLNODE,";;") S PSNAPP2=$P(PSNLNODE,";;",CNT) Q:$P(PSNRSLT,"^",2)=1 I PSNAPP2=$G(PSNPACK) S PSNFFLAG=1,$P(PSNRSLT,"^",2)=1
  1. Q PSNRSLT
  1. ;
  1. NONSTD ;
  1. I +$G(PSNSCRDT)>0 D SCREEN
  1. Q
  1. ;
  1. SCREEN ;Set screen if Inactive Date is passed in
  1. N PSNILOOP,PSNILOC,PSNINFLG,PSNINODE S PSNINFLG=0
  1. F PSNILOOP=1:1 S PSNILOC=$P($T(FILE2+PSNILOOP),";;",2) Q:+$G(PSNILOC)'>0!PSNINFLG I +PSNILOC=PSNFILE S PSNINFLG=1 S PSNINODE=$T(FILE2+PSNILOOP) D
  1. .S PSNSUBSC=$P(PSNINODE,";;",3),PSNPIECE=$P(PSNINODE,";;",4)
  1. .I PSNSUBSC'="",PSNPIECE'="" S DIC("S")="I $P($G(^(PSNSUBSC)),""^"",PSNPIECE)=""""!(+$P($G(^(PSNSUBSC)),""^"",PSNPIECE)>+$G(PSNSCRDT))"
  1. Q
  1. ;
  1. XSCREEN(PSNTFILE) ; Set screen for standardized files
  1. I +$G(PSNSCRDT)>0 S DIC("S")="I '$$SCREEN^XTID("_PSNTFILE_",.01,+Y_"","",+$G(PSNSCRDT))"
  1. Q
  1. ;
  1. FILE1 ;Package listed if Write access (DLAYGO) is allowed
  1. ;;50.416;;PSN
  1. ;;50.605;;PSN
  1. ;;50.6;;PSN
  1. ;;50.67;;PSN
  1. ;;56;;PSN;;PSS
  1. ;;
  1. Q
  1. ;
  1. FILE2 ;For Lookup calls, check for Inactive Date Screen
  1. ;;50.67;;0;;7
  1. ;;56;;0;;7
  1. ;;50.416;;2;;1
  1. ;;
  1. Q