PSNBLD.m

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

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