- PSSDI ;BIR/LDT/TSS - API FOR FILEMAN CALLS ;5 Sep 03
- ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,97,104,108,118,133**;9/30/97;Build 1
- ;
- DIC(PSSFILE,PSSAPP,DIC,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
- N PSSX1 ;ADDED BY TS ON 09.20.2006
- S PSSDIY=""
- I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
- N PSRTEST S PSRTEST=$$TEST(PSSFILE)
- I 'PSRTEST S PSSDIY=-1 G Q
- K DIC("S")
- I +$G(PSSSCRDT)>0 N PSSSUBSC,PSSPIECE D SCREEN
- I $D(PSSVACL),$O(PSSVACL(0))'="",$G(PSSFILE)=50 D VACL I $D(PSSX1) S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1 K PSSX1
- I $G(PSSSCRUS)'="",$G(PSSFILE)=50 N PSSAPLP D
- .S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_"F PSSAPLP=1:1:$L(PSSSCRUS) I $P($G(^(2)),""^"",3)[$E(PSSSCRUS,PSSAPLP) Q"
- I '$P(PSRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSSDIY=-1 G Q
- I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
- K DTOUT,DUOUT D ^DIC
- G Q
- DO(PSSFILE,PSSAPP,DIC) ;
- S PSSDIY=""
- I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
- N PSRTEST S PSRTEST=$$TEST(PSSFILE)
- I 'PSRTEST S PSSDIY=-1 G Q
- K DTOUT,DUOUT D DO^DIC1
- Q
- IX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO) ;
- S PSSDIY=""
- I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
- N PSRTEST S PSRTEST=$$TEST(PSSFILE)
- I 'PSRTEST S PSSDIY=-1 G Q
- I '$P(PSRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSSDIY=-1 G Q
- I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
- K DTOUT,DUOUT D IX^DIC
- Q
- MIX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
- N PSSX1 ;ADDED BY TS ON 09.20.2006
- S PSSDIY=""
- I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
- N PSRTEST S PSRTEST=$$TEST(PSSFILE)
- I 'PSRTEST S PSSDIY=-1 G Q
- K DIC("S")
- I +$G(PSSSCRDT)>0 N PSSSUBSC,PSSPIECE D SCREEN
- I $D(PSSVACL),$O(PSSVACL(0))'="",$G(PSSFILE)=50 D VACL I $D(PSSX1) S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1 K PSSX1
- I $G(PSSSCRUS)'="",$G(PSSFILE)=50 N PSSAPLP D
- .S DIC("S")=$S($G(DIC("S"))'="":DIC("S")_" ",1:"")_"F PSSAPLP=1:1:$L(PSSSCRUS) I $P($G(^(2)),""^"",3)[$E(PSSSCRUS,PSSAPLP) Q"
- I '$P(PSRTEST,"^",2) K DLAYGO I $G(DIC(0))'="" S DIC(0)=$TR(DIC(0),"L","") I $G(DIC(0))="" S PSSDIY=-1 G Q
- I $G(DIC(0))="",$G(X)="" S PSSDIY=-1 G Q
- K DTOUT,DUOUT D MIX^DIC1
- G Q
- FILE(PSSFILE,PSSAPP,DIC,DA,X,DINUM,DLAYGO) ;
- S PSSDIY=""
- I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
- N PSRTEST S PSRTEST=$$TEST(PSSFILE)
- I 'PSRTEST S PSSDIY=-1 G Q
- I '$P(PSRTEST,"^",2) S PSSDIY=-1 G Q
- K DTOUT,DUOUT,DO D FILE^DICN
- Q
- DIE(PSSFILE,PSSAPP,DIE,DA,DR,DIDEL) ;
- S PSSDIY=""
- I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
- N PSRTEST S PSRTEST=$$TEST(PSSFILE)
- I 'PSRTEST S PSSDIY=-1 G Q
- I '$P(PSRTEST,"^",2) S PSSDIY=-1 G Q
- K DTOUT D ^DIE
- Q
- EN1(PSSFILE,PSSAPP,DIC,L,FLDS,BY,FR,TO,DHD) ;
- S PSSDIY=""
- I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
- N PSRTEST S PSRTEST=$$TEST(PSSFILE)
- I 'PSRTEST S PSSDIY=-1 G Q
- D EN1^DIP
- Q
- EN(PSSFILE,PSSAPP,DIC,DR,DA,DIQ) ;
- S PSSDIY=""
- I +$G(PSSFILE)'>0 S PSSDIY=-1 G Q
- N PSRTEST S PSRTEST=$$TEST(PSSFILE)
- I 'PSRTEST S PSSDIY=-1 G Q
- D EN^DIQ1
- Q
- FNAME(PSSFNO,PSSFILE) ;
- ;Return the label for the field of the File or Subfile passed in
- ;PSSFNO - Field number
- ;PSSFILE - File or Subfile number
- Q $$FNAME^PSS50E($G(PSSFNO),$G(PSSFILE))
- ;
- TEST(PSTFILE) ;
- N CNT,PSSAPP2,PSFFLAG,PSFLOOP,PSFTEST,PSLNODE,PSRSLT S PSRSLT="0^0",PSFFLAG=0
- F PSFLOOP=1:1 S PSFTEST=$P($T(FILE2+PSFLOOP),";;",2) Q:+$G(PSFTEST)'>0!PSFFLAG I +PSFTEST=PSTFILE S $P(PSRSLT,"^")=1 S PSLNODE=$T(FILE2+PSFLOOP) D
- .F CNT=3:1:$L(PSLNODE,";;") S PSSAPP2=$P(PSLNODE,";;",CNT) Q:$P(PSRSLT,"^",2)=1 I PSSAPP2=$G(PSSAPP) S PSFFLAG=1,$P(PSRSLT,"^",2)=1
- Q PSRSLT
- ;
- FILE2 ;For DIC call, IF PACKAGE IS LISTED, PACKAGE HAS WRITE ACCESS
- ;;50;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.1;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.0214;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.037;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.065;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.0212;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.0441;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.01;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.02;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.0903;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.0904;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- ;;50.4;;PSJ;;PSS
- ;;50.606;;PSJ;;PSN;;PSS
- ;;50.7;;PSJ;;PSO;;PSN;;PSS
- ;;50.76;;PSJ;;PSO;;PSN;;PSS
- ;;50.72;;PSJ;;PSO;;PSN;;PSS
- ;;51;;PSJ;;PSS
- ;;51.01;;PSJ;;PSS
- ;;51.1;;PSJ;;PSS
- ;;51.11;;PSJ;;PSS
- ;;51.17;;PSJ;;PSS
- ;;51.2;;PSJ;;PSS
- ;;51.5;;PSS
- ;;52.6;;PSJ;;PSN;;PSS
- ;;52.61;;PSJ;;PSN;;PSS
- ;;52.62;;PSJ;;PSN;;PSS
- ;;52.63;;PSJ;;PSN;;PSS
- ;;52.64;;PSJ;;PSN;;PSS
- ;;52.7;;PSJ;;PSN;;PSS
- ;;52.702;;PSJ;;PSN;;PSS
- ;;52.703;;PSJ;;PSN;;PSS
- ;;52.704;;PSJ;;PSN;;PSS
- ;;54;;PSS;;PSO
- ;;54.1;;PSS;;PSO
- ;;9009032.3;;PSS
- ;;9009032.5;;PSS
- ;;
- Q
- ;
- FILE3 ;For Lookup calls, check for Inactive Date Screen
- ;;50;;I;;1
- ;;50.606;;0;;2
- ;;50.7;;0;;4
- ;;51.2;;0;;5
- ;;52.6;;I;;1
- ;;52.7;;I;;1
- ;;
- Q
- SCREEN ;Set screen if Inactive Date is passed in, and for File 50, addition screen if Application Packages Use is passed in
- N PSSILOOP,PSSILOC,PSSINFLG,PSSINODE S PSSINFLG=0
- F PSSILOOP=1:1 S PSSILOC=$P($T(FILE3+PSSILOOP),";;",2) Q:+$G(PSSILOC)'>0!PSSINFLG I +PSSILOC=PSSFILE S PSSINFLG=1 S PSSINODE=$T(FILE3+PSSILOOP) D
- .S PSSSUBSC=$P(PSSINODE,";;",3),PSSPIECE=$P(PSSINODE,";;",4)
- .I PSSSUBSC'="",PSSPIECE'="" S DIC("S")="I $P($G(^(PSSSUBSC)),""^"",PSSPIECE)=""""!(+$P($G(^(PSSSUBSC)),""^"",PSSPIECE)>+$G(PSSSCRDT))"
- Q
- VACL S PSSVACL1=0,PSSX=$S($D(PSSVACL("R")):"=",1:"'=") K PSSX1
- F S PSSVACL1=$O(PSSVACL(PSSVACL1)) Q:PSSVACL1="" I PSSVACL1'="R",PSSVACL1'="P" S PSSX1=$S($G(PSSX1)="":"I $P(^PSDRUG(+Y,0),U,2)"_PSSX_""""_PSSVACL1_"""",1:PSSX1_$S(PSSX="=":"!",1:"&")_"($P(^PSDRUG(+Y,0),U,2)"_PSSX_""""_PSSVACL1_""""_")")
- Q
- Q K PSSVACL,PSSVACL1,PSSX,PSSX1,PSSFILE,PSSAPP,PSSINODE,PSSSCRUS Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDI 5820 printed Feb 18, 2025@23:56:52 Page 2
- PSSDI ;BIR/LDT/TSS - API FOR FILEMAN CALLS ;5 Sep 03
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,97,104,108,118,133**;9/30/97;Build 1
- +2 ;
- DIC(PSSFILE,PSSAPP,DIC,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
- +1 ;ADDED BY TS ON 09.20.2006
- NEW PSSX1
- +2 SET PSSDIY=""
- +3 IF +$GET(PSSFILE)'>0
- SET PSSDIY=-1
- GOTO Q
- +4 NEW PSRTEST
- SET PSRTEST=$$TEST(PSSFILE)
- +5 IF 'PSRTEST
- SET PSSDIY=-1
- GOTO Q
- +6 KILL DIC("S")
- +7 IF +$GET(PSSSCRDT)>0
- NEW PSSSUBSC,PSSPIECE
- DO SCREEN
- +8 IF $DATA(PSSVACL)
- IF $ORDER(PSSVACL(0))'=""
- IF $GET(PSSFILE)=50
- DO VACL
- IF $DATA(PSSX1)
- SET DIC("S")=$SELECT($GET(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1
- KILL PSSX1
- +9 IF $GET(PSSSCRUS)'=""
- IF $GET(PSSFILE)=50
- NEW PSSAPLP
- Begin DoDot:1
- +10 SET DIC("S")=$SELECT($GET(DIC("S"))'="":DIC("S")_" ",1:"")_"F PSSAPLP=1:1:$L(PSSSCRUS) I $P($G(^(2)),""^"",3)[$E(PSSSCRUS,PSSAPLP) Q"
- End DoDot:1
- +11 IF '$PIECE(PSRTEST,"^",2)
- KILL DLAYGO
- IF $GET(DIC(0))'=""
- SET DIC(0)=$TRANSLATE(DIC(0),"L","")
- IF $GET(DIC(0))=""
- SET PSSDIY=-1
- GOTO Q
- +12 IF $GET(DIC(0))=""
- IF $GET(X)=""
- SET PSSDIY=-1
- GOTO Q
- +13 KILL DTOUT,DUOUT
- DO ^DIC
- +14 GOTO Q
- DO(PSSFILE,PSSAPP,DIC) ;
- +1 SET PSSDIY=""
- +2 IF +$GET(PSSFILE)'>0
- SET PSSDIY=-1
- GOTO Q
- +3 NEW PSRTEST
- SET PSRTEST=$$TEST(PSSFILE)
- +4 IF 'PSRTEST
- SET PSSDIY=-1
- GOTO Q
- +5 KILL DTOUT,DUOUT
- DO DO^DIC1
- +6 QUIT
- IX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO) ;
- +1 SET PSSDIY=""
- +2 IF +$GET(PSSFILE)'>0
- SET PSSDIY=-1
- GOTO Q
- +3 NEW PSRTEST
- SET PSRTEST=$$TEST(PSSFILE)
- +4 IF 'PSRTEST
- SET PSSDIY=-1
- GOTO Q
- +5 IF '$PIECE(PSRTEST,"^",2)
- KILL DLAYGO
- IF $GET(DIC(0))'=""
- SET DIC(0)=$TRANSLATE(DIC(0),"L","")
- IF $GET(DIC(0))=""
- SET PSSDIY=-1
- GOTO Q
- +6 IF $GET(DIC(0))=""
- IF $GET(X)=""
- SET PSSDIY=-1
- GOTO Q
- +7 KILL DTOUT,DUOUT
- DO IX^DIC
- +8 QUIT
- MIX(PSSFILE,PSSAPP,DIC,D,X,DLAYGO,PSSSCRDT,PSSSCRUS,PSSVACL) ;
- +1 ;ADDED BY TS ON 09.20.2006
- NEW PSSX1
- +2 SET PSSDIY=""
- +3 IF +$GET(PSSFILE)'>0
- SET PSSDIY=-1
- GOTO Q
- +4 NEW PSRTEST
- SET PSRTEST=$$TEST(PSSFILE)
- +5 IF 'PSRTEST
- SET PSSDIY=-1
- GOTO Q
- +6 KILL DIC("S")
- +7 IF +$GET(PSSSCRDT)>0
- NEW PSSSUBSC,PSSPIECE
- DO SCREEN
- +8 IF $DATA(PSSVACL)
- IF $ORDER(PSSVACL(0))'=""
- IF $GET(PSSFILE)=50
- DO VACL
- IF $DATA(PSSX1)
- SET DIC("S")=$SELECT($GET(DIC("S"))'="":DIC("S")_" ",1:"")_PSSX1
- KILL PSSX1
- +9 IF $GET(PSSSCRUS)'=""
- IF $GET(PSSFILE)=50
- NEW PSSAPLP
- Begin DoDot:1
- +10 SET DIC("S")=$SELECT($GET(DIC("S"))'="":DIC("S")_" ",1:"")_"F PSSAPLP=1:1:$L(PSSSCRUS) I $P($G(^(2)),""^"",3)[$E(PSSSCRUS,PSSAPLP) Q"
- End DoDot:1
- +11 IF '$PIECE(PSRTEST,"^",2)
- KILL DLAYGO
- IF $GET(DIC(0))'=""
- SET DIC(0)=$TRANSLATE(DIC(0),"L","")
- IF $GET(DIC(0))=""
- SET PSSDIY=-1
- GOTO Q
- +12 IF $GET(DIC(0))=""
- IF $GET(X)=""
- SET PSSDIY=-1
- GOTO Q
- +13 KILL DTOUT,DUOUT
- DO MIX^DIC1
- +14 GOTO Q
- FILE(PSSFILE,PSSAPP,DIC,DA,X,DINUM,DLAYGO) ;
- +1 SET PSSDIY=""
- +2 IF +$GET(PSSFILE)'>0
- SET PSSDIY=-1
- GOTO Q
- +3 NEW PSRTEST
- SET PSRTEST=$$TEST(PSSFILE)
- +4 IF 'PSRTEST
- SET PSSDIY=-1
- GOTO Q
- +5 IF '$PIECE(PSRTEST,"^",2)
- SET PSSDIY=-1
- GOTO Q
- +6 KILL DTOUT,DUOUT,DO
- DO FILE^DICN
- +7 QUIT
- DIE(PSSFILE,PSSAPP,DIE,DA,DR,DIDEL) ;
- +1 SET PSSDIY=""
- +2 IF +$GET(PSSFILE)'>0
- SET PSSDIY=-1
- GOTO Q
- +3 NEW PSRTEST
- SET PSRTEST=$$TEST(PSSFILE)
- +4 IF 'PSRTEST
- SET PSSDIY=-1
- GOTO Q
- +5 IF '$PIECE(PSRTEST,"^",2)
- SET PSSDIY=-1
- GOTO Q
- +6 KILL DTOUT
- DO ^DIE
- +7 QUIT
- EN1(PSSFILE,PSSAPP,DIC,L,FLDS,BY,FR,TO,DHD) ;
- +1 SET PSSDIY=""
- +2 IF +$GET(PSSFILE)'>0
- SET PSSDIY=-1
- GOTO Q
- +3 NEW PSRTEST
- SET PSRTEST=$$TEST(PSSFILE)
- +4 IF 'PSRTEST
- SET PSSDIY=-1
- GOTO Q
- +5 DO EN1^DIP
- +6 QUIT
- EN(PSSFILE,PSSAPP,DIC,DR,DA,DIQ) ;
- +1 SET PSSDIY=""
- +2 IF +$GET(PSSFILE)'>0
- SET PSSDIY=-1
- GOTO Q
- +3 NEW PSRTEST
- SET PSRTEST=$$TEST(PSSFILE)
- +4 IF 'PSRTEST
- SET PSSDIY=-1
- GOTO Q
- +5 DO EN^DIQ1
- +6 QUIT
- FNAME(PSSFNO,PSSFILE) ;
- +1 ;Return the label for the field of the File or Subfile passed in
- +2 ;PSSFNO - Field number
- +3 ;PSSFILE - File or Subfile number
- +4 QUIT $$FNAME^PSS50E($GET(PSSFNO),$GET(PSSFILE))
- +5 ;
- TEST(PSTFILE) ;
- +1 NEW CNT,PSSAPP2,PSFFLAG,PSFLOOP,PSFTEST,PSLNODE,PSRSLT
- SET PSRSLT="0^0"
- SET PSFFLAG=0
- +2 FOR PSFLOOP=1:1
- SET PSFTEST=$PIECE($TEXT(FILE2+PSFLOOP),";;",2)
- if +$GET(PSFTEST)'>0!PSFFLAG
- QUIT
- IF +PSFTEST=PSTFILE
- SET $PIECE(PSRSLT,"^")=1
- SET PSLNODE=$TEXT(FILE2+PSFLOOP)
- Begin DoDot:1
- +3 FOR CNT=3:1:$LENGTH(PSLNODE,";;")
- SET PSSAPP2=$PIECE(PSLNODE,";;",CNT)
- if $PIECE(PSRSLT,"^",2)=1
- QUIT
- IF PSSAPP2=$GET(PSSAPP)
- SET PSFFLAG=1
- SET $PIECE(PSRSLT,"^",2)=1
- End DoDot:1
- +4 QUIT PSRSLT
- +5 ;
- FILE2 ;For DIC call, IF PACKAGE IS LISTED, PACKAGE HAS WRITE ACCESS
- +1 ;;50;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +2 ;;50.1;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +3 ;;50.0214;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +4 ;;50.037;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +5 ;;50.065;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +6 ;;50.0212;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +7 ;;50.0441;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +8 ;;50.01;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +9 ;;50.02;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +10 ;;50.0903;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +11 ;;50.0904;;PSX;;PSD;;PSJ;;PSN;;PSO;;PSGW;;PSS
- +12 ;;50.4;;PSJ;;PSS
- +13 ;;50.606;;PSJ;;PSN;;PSS
- +14 ;;50.7;;PSJ;;PSO;;PSN;;PSS
- +15 ;;50.76;;PSJ;;PSO;;PSN;;PSS
- +16 ;;50.72;;PSJ;;PSO;;PSN;;PSS
- +17 ;;51;;PSJ;;PSS
- +18 ;;51.01;;PSJ;;PSS
- +19 ;;51.1;;PSJ;;PSS
- +20 ;;51.11;;PSJ;;PSS
- +21 ;;51.17;;PSJ;;PSS
- +22 ;;51.2;;PSJ;;PSS
- +23 ;;51.5;;PSS
- +24 ;;52.6;;PSJ;;PSN;;PSS
- +25 ;;52.61;;PSJ;;PSN;;PSS
- +26 ;;52.62;;PSJ;;PSN;;PSS
- +27 ;;52.63;;PSJ;;PSN;;PSS
- +28 ;;52.64;;PSJ;;PSN;;PSS
- +29 ;;52.7;;PSJ;;PSN;;PSS
- +30 ;;52.702;;PSJ;;PSN;;PSS
- +31 ;;52.703;;PSJ;;PSN;;PSS
- +32 ;;52.704;;PSJ;;PSN;;PSS
- +33 ;;54;;PSS;;PSO
- +34 ;;54.1;;PSS;;PSO
- +35 ;;9009032.3;;PSS
- +36 ;;9009032.5;;PSS
- +37 ;;
- +38 QUIT
- +39 ;
- FILE3 ;For Lookup calls, check for Inactive Date Screen
- +1 ;;50;;I;;1
- +2 ;;50.606;;0;;2
- +3 ;;50.7;;0;;4
- +4 ;;51.2;;0;;5
- +5 ;;52.6;;I;;1
- +6 ;;52.7;;I;;1
- +7 ;;
- +8 QUIT
- SCREEN ;Set screen if Inactive Date is passed in, and for File 50, addition screen if Application Packages Use is passed in
- +1 NEW PSSILOOP,PSSILOC,PSSINFLG,PSSINODE
- SET PSSINFLG=0
- +2 FOR PSSILOOP=1:1
- SET PSSILOC=$PIECE($TEXT(FILE3+PSSILOOP),";;",2)
- if +$GET(PSSILOC)'>0!PSSINFLG
- QUIT
- IF +PSSILOC=PSSFILE
- SET PSSINFLG=1
- SET PSSINODE=$TEXT(FILE3+PSSILOOP)
- Begin DoDot:1
- +3 SET PSSSUBSC=$PIECE(PSSINODE,";;",3)
- SET PSSPIECE=$PIECE(PSSINODE,";;",4)
- +4 IF PSSSUBSC'=""
- IF PSSPIECE'=""
- SET DIC("S")="I $P($G(^(PSSSUBSC)),""^"",PSSPIECE)=""""!(+$P($G(^(PSSSUBSC)),""^"",PSSPIECE)>+$G(PSSSCRDT))"
- End DoDot:1
- +5 QUIT
- VACL SET PSSVACL1=0
- SET PSSX=$SELECT($DATA(PSSVACL("R")):"=",1:"'=")
- KILL PSSX1
- +1 FOR
- SET PSSVACL1=$ORDER(PSSVACL(PSSVACL1))
- if PSSVACL1=""
- QUIT
- IF PSSVACL1'="R"
- IF PSSVACL1'="P"
- SET PSSX1=$SELECT($GET(PSSX1)="":"I $P(^PSDRUG(+Y,0),U,2)"_PSSX_""""_PSSVACL1_"""",1:PSSX1_$SELECT(PSSX="=":"!",1:"&")_"($P(^PSDRUG(+Y,0),U,2)"_PSSX_""""_PSSVACL1_""""_")")
- +2 QUIT
- Q KILL PSSVACL,PSSVACL1,PSSX,PSSX1,PSSFILE,PSSAPP,PSSINODE,PSSSCRUS
- QUIT