- 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 Jan 18, 2025@03:24:55 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