- PSNBLD ;BIR/CCH&WRT-Builds temporary file for matches ; 10/13/98 13:37
- ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- S PSNFL=0,PSNFLB=0 S:'$D(^PSNTRAN("END")) ^PSNTRAN("END")=""
- STWHN I $P(^PSNTRAN("END"),"^",1)']"" W !,"Automatic match by NDC Code process will begin",!!
- I $P(^PSNTRAN("END"),"^",1)']"" R "Are you sure you want to continue ? N// ",ANS:DTIME S:'$T ANS="^" S:ANS']"" ANS="N" G:"^Nn"[$E(ANS) KILL
- I $D(ANS),ANS?.E1C.E K ANS G PSNBLD
- I $D(ANS),"?"[$E(ANS) D AUTO^PSNHELP1 G PSNBLD
- I $D(ANS),"NnYy^"'[$E(ANS) G PSNBLD
- S PSNFLB=1 I $D(ANS) D:"Yy"[$E(ANS) ^PSNNDC S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV K ANS I $P(^PS(59.7,1,10),"^",3)=1 S NBR=0 D ^PSNCOMP,KILL Q
- CCK I $P(^PS(59.7,1,10),"^",3)=1 D BEG
- Q
- BEG W !!,"Enter ""B"" to start at the beginning or press return",!,"to continue with next ==>> Drug: " R ANS:DTIME S:'$T ANS="^" G:ANS["^" KILL
- I ANS?.E1C.E K ANS G BEG
- I ANS="" S NBR=$P(^PSNTRAN("END"),"^",1) S:'$D(^PSNTRAN(NBR,"END")) ^PSNTRAN(NBR,"END")=NBR K:$P(^PSNTRAN(NBR,"END"),"^",3)="" ^PSNTRAN(NBR,"END") S:$D(^PSNTRAN(NBR,"END")) $P(^PSNTRAN(NBR,"END"),"^",1)="" K ANS D ^PSNCOMP,KILL Q
- I "Bb"'[ANS D BLD1^PSNHELP G STWHN
- S NBR=$P(^PSNTRAN("END"),"^",1) K:$P(^PSNTRAN(NBR,"END"),"^",3)="" ^PSNTRAN(NBR,"END") S:$D(^PSNTRAN(NBR,"END")) $P(^PSNTRAN(NBR,"END"),"^",1)="" S NBR=0 K ANS D ^PSNCOMP
- KILL K PSNB,PSNDA,PSNSTDA,PSNUNDA,PSNDDA,ANS,DIC,II,MJL,JJ,NBR,PSNCLASS,PSNFL,PSNFLB,PSNFNM,PSNFORM,PSNNAM,PSNNAME,PSNNDA,PSNNDC,PSNNDF,PSNSP,PSNVAR,PSNSIZE,PSNTYPE,PSNSZ,PSNTRFL,PSNTYP,X,Y,KK,STOP,VAR,PSNDEA,PSNINACT
- K PSND,PSNDFM,PSNVC,PSNVCL,PSNENT,PSNF,PSNM,PSNLOC,^TMP($J,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,PSNP,END Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNBLD 1686 printed Feb 18, 2025@23:49:51 Page 2
- PSNBLD ;BIR/CCH&WRT-Builds temporary file for matches ; 10/13/98 13:37
- +1 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- +2 SET PSNFL=0
- SET PSNFLB=0
- if '$DATA(^PSNTRAN("END"))
- SET ^PSNTRAN("END")=""
- STWHN IF $PIECE(^PSNTRAN("END"),"^",1)']""
- WRITE !,"Automatic match by NDC Code process will begin",!!
- +1 IF $PIECE(^PSNTRAN("END"),"^",1)']""
- READ "Are you sure you want to continue ? N// ",ANS:DTIME
- if '$TEST
- SET ANS="^"
- if ANS']""
- SET ANS="N"
- if "^Nn"[$EXTRACT(ANS)
- GOTO KILL
- +2 IF $DATA(ANS)
- IF ANS?.E1C.E
- KILL ANS
- GOTO PSNBLD
- +3 IF $DATA(ANS)
- IF "?"[$EXTRACT(ANS)
- DO AUTO^PSNHELP1
- GOTO PSNBLD
- +4 IF $DATA(ANS)
- IF "NnYy^"'[$EXTRACT(ANS)
- GOTO PSNBLD
- +5 SET PSNFLB=1
- IF $DATA(ANS)
- if "Yy"[$EXTRACT(ANS)
- DO ^PSNNDC
- if $DATA(XRT0)
- SET XRTN=$TEXT(+0)
- if $DATA(XRT0)
- DO T1^%ZOSV
- KILL ANS
- IF $PIECE(^PS(59.7,1,10),"^",3)=1
- SET NBR=0
- DO ^PSNCOMP
- DO KILL
- QUIT
- CCK IF $PIECE(^PS(59.7,1,10),"^",3)=1
- DO BEG
- +1 QUIT
- BEG WRITE !!,"Enter ""B"" to start at the beginning or press return",!,"to continue with next ==>> Drug: "
- READ ANS:DTIME
- if '$TEST
- SET ANS="^"
- if ANS["^"
- GOTO KILL
- +1 IF ANS?.E1C.E
- KILL ANS
- GOTO BEG
- +2 IF ANS=""
- SET NBR=$PIECE(^PSNTRAN("END"),"^",1)
- if '$DATA(^PSNTRAN(NBR,"END"))
- SET ^PSNTRAN(NBR,"END")=NBR
- if $PIECE(^PSNTRAN(NBR,"END"),"^",3)=""
- KILL ^PSNTRAN(NBR,"END")
- if $DATA(^PSNTRAN(NBR,"END"))
- SET $PIECE(^PSNTRAN(NBR,"END"),"^",1)=""
- KILL ANS
- DO ^PSNCOMP
- DO KILL
- QUIT
- +3 IF "Bb"'[ANS
- DO BLD1^PSNHELP
- GOTO STWHN
- +4 SET NBR=$PIECE(^PSNTRAN("END"),"^",1)
- if $PIECE(^PSNTRAN(NBR,"END"),"^",3)=""
- KILL ^PSNTRAN(NBR,"END")
- if $DATA(^PSNTRAN(NBR,"END"))
- SET $PIECE(^PSNTRAN(NBR,"END"),"^",1)=""
- SET NBR=0
- KILL ANS
- DO ^PSNCOMP
- KILL KILL PSNB,PSNDA,PSNSTDA,PSNUNDA,PSNDDA,ANS,DIC,II,MJL,JJ,NBR,PSNCLASS,PSNFL,PSNFLB,PSNFNM,PSNFORM,PSNNAM,PSNNAME,PSNNDA,PSNNDC,PSNNDF,PSNSP,PSNVAR,PSNSIZE,PSNTYPE,PSNSZ,PSNTRFL,PSNTYP,X,Y,KK,STOP,VAR,PSNDEA,PSNINACT
- +1 KILL PSND,PSNDFM,PSNVC,PSNVCL,PSNENT,PSNF,PSNM,PSNLOC,^TMP($JOB,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,PSNP,END
- QUIT