Routine: PSNQA

PSNQA ;BIR/WRT-checks pointers to match on "ND" node and unmatches possible erroneous matches. ;01/12/98   5:18 PM

 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98

SETUP S PSNDZ=0 D CKDUZ,CKDT I PSNDZ=0 D SETUP1 K PSNDZ

CKDUZ I '$D(DUZ) W !!,"DUZ MUST BE DEFINED",! S PSNDZ=1

 I $D(DUZ(0)),DUZ(0)'="@" W "DUZ(0) MUST BE SET TO THE ""@"" SIGN",!! S PSNDZ=1

CKDT I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y

SETUP1 K ^TMP($J) W !,"Let me put you on hold for a second " D START,REDEX S:'$D(^TMP($J,"PSNQA",9,0)) ^TMP($J,"PSNQA",9,0)="NO ENTRIES FOUND" D MESS,KILL W !,"OK, I'm Done. PSN*3.15*3 has been installed and completed.",!

START F PSNDA=0:0 S PSNDA=$O(^PSDRUG(PSNDA)) Q:'PSNDA  U IO W:'(PSNDA#100) "." I $D(^PSDRUG(PSNDA,"ND")) S NODE=^PSDRUG(PSNDA,"ND") I $P(NODE,"^",2)]"" S VAPN=$P(NODE,"^",2) D GRAB

GRAB S IEN=$P(NODE,"^",1) I IEN>3032&(IEN<3175) D TOP S ^TMP($J,"PSN",$P(^PSDRUG(PSNDA,0),"^"),PSNDA)=$P(^PSDRUG(PSNDA,0),"^") D UNMTCH

UNMTCH S PSNID=$P(^PSDRUG(PSNDA,"ND"),"^",10),Y=PSNDA D SETNULL^PSNHELP1 S:$D(^PSDRUG(PSNDA,3)) $P(^PSDRUG(PSNDA,3),"^",1)=0 K:$D(^PSDRUG("AQ",PSNDA)) ^PSDRUG("AQ",PSNDA) K:PSNID]"" ^PSDRUG("AQ1",PSNID,PSNDA) K PSNID

 S DA=PSNDA S X="PSXREF" X ^%ZOSF("TEST") D:$T ^PSXREF K DA

KILL K PSNDA,IEN,ZXZX,NODE,VAPN,KK,NDA,NME

REDEX S NME="" F KK=0:0 S NME=$O(^TMP($J,"PSN",NME)) Q:NME=""  S NDA=$O(^TMP($J,"PSN",NME,0)) S NUM=$S('$D(NUM):9,1:NUM+1),^TMP($J,"PSNQA",NUM,0)=$P(^TMP($J,"PSN",NME,NDA),"^")

MESS S XMDUZ="NATIONAL DRUG FILE PACKAGE",XMSUB="ENTRIES IN ""DRUG"" FILE THAT NEED TO BE REMATCHED TO NDF",XMTEXT="^TMP($J,""PSNQA"",",XMY(DUZ)=""

 I $D(^XUSEC("PSNMGR")) F PSNDUZ=0:0 S PSNDUZ=$O(^XUSEC("PSNMGR",PSNDUZ)) Q:'PSNDUZ  S XMY(PSNDUZ)=""

 D ^XMD K ^TMP($J,"PSNQA"),^TMP($J,"PSN"),XMY,NUM,XMDUZ,XMTEXT,PSNDUZ,XMSUB

TOP S ^TMP($J,"PSN","*1",1)="Patch PSN*3.15*3 was installed and the following",^TMP($J,"PSN","*2",2)="entries in your local drug file need to be rematched"

 S ^TMP($J,"PSN","*3",3)="using the ""Rematch / Match Single Drugs"" option.",^TMP($J,"PSN","*4",4)="They have been unmatched to NDF for you.",^TMP($J,"PSN","*5",5)="  "

PSNQA     ;BIR/WRT-checks pointers to match on "ND" node and unmatches possible erroneous matches. ;01/12/98   5:18 PM

 +1       ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98

SETUP      SET PSNDZ=0

           DO CKDUZ

           DO CKDT

           IF PSNDZ=0

               DO SETUP1

               KILL PSNDZ

 +1        QUIT

CKDUZ      IF '$DATA(DUZ)

               WRITE !!,"DUZ MUST BE DEFINED",!

               SET PSNDZ=1

 +1        IF $DATA(DUZ(0))

               IF DUZ(0)'="@"

                   WRITE "DUZ(0) MUST BE SET TO THE ""@"" SIGN",!!

                   SET PSNDZ=1

 +2        QUIT

CKDT       IF '$DATA(DT)

               SET %DT=""

               SET X="T"

               DO ^%DT

               SET DT=Y

 +1        QUIT

SETUP1     KILL ^TMP($JOB)

           WRITE !,"Let me put you on hold for a second "

           DO START

           DO REDEX

           IF '$DATA(^TMP($JOB,"PSNQA",9,0))

               SET ^TMP($JOB,"PSNQA",9,0)="NO ENTRIES FOUND"

           DO MESS

           DO KILL

           WRITE !,"OK, I'm Done. PSN*3.15*3 has been installed and completed.",!

 +1        QUIT

START      FOR PSNDA=0:0

               SET PSNDA=$ORDER(^PSDRUG(PSNDA))

               IF 'PSNDA

                   QUIT

               USE IO

               IF '(PSNDA#100)

                   WRITE "."

               IF $DATA(^PSDRUG(PSNDA,"ND"))

                   SET NODE=^PSDRUG(PSNDA,"ND")

                   IF $PIECE(NODE,"^",2)]""

                       SET VAPN=$PIECE(NODE,"^",2)

                       DO GRAB

 +1        QUIT

GRAB       SET IEN=$PIECE(NODE,"^",1)

           IF IEN>3032&(IEN<3175)

               DO TOP

               SET ^TMP($JOB,"PSN",$PIECE(^PSDRUG(PSNDA,0),"^"),PSNDA)=$PIECE(^PSDRUG(PSNDA,0),"^")

               DO UNMTCH

 +1        QUIT

UNMTCH     SET PSNID=$PIECE(^PSDRUG(PSNDA,"ND"),"^",10)

           SET Y=PSNDA

           DO SETNULL^PSNHELP1

           IF $DATA(^PSDRUG(PSNDA,3))

               SET $PIECE(^PSDRUG(PSNDA,3),"^",1)=0

           IF $DATA(^PSDRUG("AQ",PSNDA))

               KILL ^PSDRUG("AQ",PSNDA)

           IF PSNID]""

               KILL ^PSDRUG("AQ1",PSNID,PSNDA)

           KILL PSNID

 +1        SET DA=PSNDA

           SET X="PSXREF"

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               DO ^PSXREF

           KILL DA

 +2        QUIT

KILL       KILL PSNDA,IEN,ZXZX,NODE,VAPN,KK,NDA,NME

 +1        QUIT

REDEX      SET NME=""

           FOR KK=0:0

               SET NME=$ORDER(^TMP($JOB,"PSN",NME))

               IF NME=""

                   QUIT

               SET NDA=$ORDER(^TMP($JOB,"PSN",NME,0))

               SET NUM=$SELECT('$DATA(NUM):9,1:NUM+1)

               SET ^TMP($JOB,"PSNQA",NUM,0)=$PIECE(^TMP($JOB,"PSN",NME,NDA),"^")

 +1        QUIT

MESS       SET XMDUZ="NATIONAL DRUG FILE PACKAGE"

           SET XMSUB="ENTRIES IN ""DRUG"" FILE THAT NEED TO BE REMATCHED TO NDF"

           SET XMTEXT="^TMP($J,""PSNQA"","

           SET XMY(DUZ)=""

 +1        IF $DATA(^XUSEC("PSNMGR"))

               FOR PSNDUZ=0:0

                   SET PSNDUZ=$ORDER(^XUSEC("PSNMGR",PSNDUZ))

                   IF 'PSNDUZ

                       QUIT

                   SET XMY(PSNDUZ)=""

 +2        DO ^XMD

           KILL ^TMP($JOB,"PSNQA"),^TMP($JOB,"PSN"),XMY,NUM,XMDUZ,XMTEXT,PSNDUZ,XMSUB

 +3        QUIT

TOP        SET ^TMP($JOB,"PSN","*1",1)="Patch PSN*3.15*3 was installed and the following"

           SET ^TMP($JOB,"PSN","*2",2)="entries in your local drug file need to be rematched"

 +1        SET ^TMP($JOB,"PSN","*3",3)="using the ""Rematch / Match Single Drugs"" option."

           SET ^TMP($JOB,"PSN","*4",4)="They have been unmatched to NDF for you."

           SET ^TMP($JOB,"PSN","*5",5)="  "

 +2        QUIT

PSNQA.m