- 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 Feb 18, 2025@23:51:14 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
