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
Q
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
Q
CKDT I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
Q
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.",!
Q
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
Q
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
Q
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
Q
KILL K PSNDA,IEN,ZXZX,NODE,VAPN,KK,NDA,NME
Q
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),"^")
Q
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
Q
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)=" "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNQA 2140 printed Dec 13, 2024@02:24:57 Page 2
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
