PSNDI ;BIR/LDT - API FOR FILEMAN CALLS; 5 Sep 03
;;4.0;NATIONAL DRUG FILE;**80,109,157,406**; 30 Oct 98;Build 7
;
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")
N STNDRD S STNDRD=$$SCREEN^HDISVF01(PSNFILE)
I STNDRD=1 D XSCREEN(PSNFILE)
I STNDRD'=1 N PSNSUBSC,PSNPIECE D NONSTD
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")
N STNDRD S STNDRD=$$SCREEN^HDISVF01(PSNFILE)
I STNDRD=1 D XSCREEN(PSNFILE)
I STNDRD'=1 N PSNSUBSC,PSNPIECE D NONSTD
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) ; Test to check if file is listed in the API
N CNT,PSNAPP2,PSNFFLAG,PSNFLOOP,PSNFTEST,PSNLNODE,PSNRSLT S PSNRSLT="0^0",PSNFFLAG=0
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
.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
Q PSNRSLT
;
NONSTD ;
I +$G(PSNSCRDT)>0 D SCREEN
Q
;
SCREEN ;Set screen if Inactive Date is passed in
N PSNILOOP,PSNILOC,PSNINFLG,PSNINODE S PSNINFLG=0
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
.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
;
XSCREEN(PSNTFILE) ; Set screen for standardized files
I +$G(PSNSCRDT)>0 S DIC("S")="I '$$SCREEN^XTID("_PSNTFILE_",.01,+Y_"","",+$G(PSNSCRDT))"
Q
;
FILE1 ;Package listed if Write access (DLAYGO) is allowed
;;50.416;;PSN
;;50.605;;PSN
;;50.6;;PSN
;;50.67;;PSN
;;56;;PSN;;PSS
;;
Q
;
FILE2 ;For Lookup calls, check for Inactive Date Screen
;;50.67;;0;;7
;;56;;0;;7
;;50.416;;2;;1
;;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNDI 2561 printed Oct 16, 2024@18:24:37 Page 2
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
+2 ;
DIC(PSNFILE,PSNPACK,DIC,X,DLAYGO,PSNSCRDT) ;
+1 SET PSNDIY=""
+2 IF +$GET(PSNFILE)'>0
SET PSNDIY=-1
QUIT
+3 NEW PSNRTEST
SET PSNRTEST=$$TEST(PSNFILE)
+4 IF 'PSNRTEST
SET PSNDIY=-1
QUIT
+5 KILL DIC("S")
+6 NEW STNDRD
SET STNDRD=$$SCREEN^HDISVF01(PSNFILE)
+7 IF STNDRD=1
DO XSCREEN(PSNFILE)
+8 IF STNDRD'=1
NEW PSNSUBSC,PSNPIECE
DO NONSTD
+9 IF '$PIECE(PSNRTEST,"^",2)
KILL DLAYGO
IF $GET(DIC(0))'=""
SET DIC(0)=$TRANSLATE(DIC(0),"L","")
IF $GET(DIC(0))=""
SET PSNDIY=-1
+10 DO ^DIC
+11 QUIT
+12 ;
IX(PSNFILE,PSNPACK,DIC,D,X,DLAYGO,PSNSCRDT) ;
+1 SET PSNDIY=""
+2 IF +$GET(PSNFILE)'>0
SET PSNDIY=-1
QUIT
+3 NEW PSNRTEST
SET PSNRTEST=$$TEST(PSNFILE)
+4 IF 'PSNRTEST
SET PSNDIY=-1
QUIT
+5 KILL DIC("S")
+6 NEW STNDRD
SET STNDRD=$$SCREEN^HDISVF01(PSNFILE)
+7 IF STNDRD=1
DO XSCREEN(PSNFILE)
+8 IF STNDRD'=1
NEW PSNSUBSC,PSNPIECE
DO NONSTD
+9 IF '$PIECE(PSNRTEST,"^",2)
KILL DLAYGO
IF $GET(DIC(0))'=""
SET DIC(0)=$TRANSLATE(DIC(0),"L","")
IF $GET(DIC(0))=""
SET PSNDIY=-1
+10 DO IX^DIC
+11 QUIT
+12 ;
DIE(PSNFILE,PSNPACK,DIE,DA,DR,DIDEL) ;
+1 SET PSNDIY=""
+2 IF +$GET(PSNFILE)'>0
SET PSNDIY=-1
QUIT
+3 NEW PSNRTEST
SET PSNRTEST=$$TEST(PSNFILE)
+4 IF 'PSNRTEST
SET PSNDIY=-1
QUIT
+5 IF '$PIECE(PSNRTEST,"^",2)
SET PSNDIY=-1
QUIT
+6 DO ^DIE
+7 QUIT
+8 ;
TEST(PSNTFILE) ; Test to check if file is listed in the API
+1 NEW CNT,PSNAPP2,PSNFFLAG,PSNFLOOP,PSNFTEST,PSNLNODE,PSNRSLT
SET PSNRSLT="0^0"
SET PSNFFLAG=0
+2 FOR PSNFLOOP=1:1
SET PSNFTEST=$PIECE($TEXT(FILE1+PSNFLOOP),";;",2)
if +$GET(PSNFTEST)'>0!PSNFFLAG
QUIT
IF +PSNFTEST=PSNTFILE
SET $PIECE(PSNRSLT,"^")=1
SET PSNLNODE=$TEXT(FILE1+PSNFLOOP)
Begin DoDot:1
+3 FOR CNT=3:1:$LENGTH(PSNLNODE,";;")
SET PSNAPP2=$PIECE(PSNLNODE,";;",CNT)
if $PIECE(PSNRSLT,"^",2)=1
QUIT
IF PSNAPP2=$GET(PSNPACK)
SET PSNFFLAG=1
SET $PIECE(PSNRSLT,"^",2)=1
End DoDot:1
+4 QUIT PSNRSLT
+5 ;
NONSTD ;
+1 IF +$GET(PSNSCRDT)>0
DO SCREEN
+2 QUIT
+3 ;
SCREEN ;Set screen if Inactive Date is passed in
+1 NEW PSNILOOP,PSNILOC,PSNINFLG,PSNINODE
SET PSNINFLG=0
+2 FOR PSNILOOP=1:1
SET PSNILOC=$PIECE($TEXT(FILE2+PSNILOOP),";;",2)
if +$GET(PSNILOC)'>0!PSNINFLG
QUIT
IF +PSNILOC=PSNFILE
SET PSNINFLG=1
SET PSNINODE=$TEXT(FILE2+PSNILOOP)
Begin DoDot:1
+3 SET PSNSUBSC=$PIECE(PSNINODE,";;",3)
SET PSNPIECE=$PIECE(PSNINODE,";;",4)
+4 IF PSNSUBSC'=""
IF PSNPIECE'=""
SET DIC("S")="I $P($G(^(PSNSUBSC)),""^"",PSNPIECE)=""""!(+$P($G(^(PSNSUBSC)),""^"",PSNPIECE)>+$G(PSNSCRDT))"
End DoDot:1
+5 QUIT
+6 ;
XSCREEN(PSNTFILE) ; Set screen for standardized files
+1 IF +$GET(PSNSCRDT)>0
SET DIC("S")="I '$$SCREEN^XTID("_PSNTFILE_",.01,+Y_"","",+$G(PSNSCRDT))"
+2 QUIT
+3 ;
FILE1 ;Package listed if Write access (DLAYGO) is allowed
+1 ;;50.416;;PSN
+2 ;;50.605;;PSN
+3 ;;50.6;;PSN
+4 ;;50.67;;PSN
+5 ;;56;;PSN;;PSS
+6 ;;
+7 QUIT
+8 ;
FILE2 ;For Lookup calls, check for Inactive Date Screen
+1 ;;50.67;;0;;7
+2 ;;56;;0;;7
+3 ;;50.416;;2;;1
+4 ;;
+5 QUIT
