PSSPOIM ;BIR/RTR-Orderable Items by VA Generic Name only ; 09/01/98 7:11
;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
;K ^TMP("PSSD",$J)
I '$G(PSMATCH) G CANT
;VA Generic Name only that can match
BEG F RRR=0:0 S RRR=$O(^PSDRUG(RRR)) Q:'RRR D
.K NODE,PSONAME,PSOPTR
.S NODE=$G(^PSDRUG(RRR,"ND")),PSONAME=$P($G(^(0)),"^"),PSOPTR=$P($G(^(2)),"^"),DA=$P(NODE,"^"),K=$P(NODE,"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSE1=X
.Q:PSONAME=""
.I +PSOPTR Q
.I '$P(NODE,"^") Q
.;Next 5 lines of code could only apply if this report is run and
.;there are Dispensed drugs that are already matched
.K ^TMP($J,"PSSUP") I +$P(NODE,"^"),+$P(NODE,"^",3) F GG=0:0 S GG=$O(^PSDRUG("AND",+NODE,GG)) Q:'GG I +$P($G(^PSDRUG(GG,2)),"^"),$D(^PS(50.7,$P(^PSDRUG(GG,2),"^"),0)) D
..S ONO=$G(^PSDRUG(GG,"ND")) I +$P(ONO,"^"),+$P(ONO,"^",3),DOSE1'=0 S DA=$P($G(ONO),"^"),K=$P($G(ONO),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSE2=X I DOSE2'=0 D
...I DOSE1=DOSE2 S ^TMP($J,"PSSUP",GG)=$P(^PSDRUG(GG,2),"^")
.S (COM,COMSUP)=0 I $O(^TMP($J,"PSSUP",0)) S COM=1 S FF=$O(^TMP($J,"PSSUP",0)),SUPER=^TMP($J,"PSSUP",FF) F FF=0:0 S FF=$O(^TMP($J,"PSSUP",FF)) Q:'FF I SUPER'=^TMP($J,"PSSUP",FF) S COMSUP=1
.I COM,COMSUP Q
.I COM,'COMSUP S SSS=$O(^TMP($J,"PSSUP",0)),SSS=^TMP($J,"PSSUP",SSS) S ^TMP("PSSD",$J,$P($G(^PS(50.7,SUPER,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^PS(50.7,SSS,0)),"^",2),0)),"^"),PSONAME)="" Q
.I +$P(NODE,"^"),+$P(NODE,"^",3) S DA=$P($G(NODE),"^"),X=$$VAGN^PSNAPIS(DA),VAG=X I VAG'=0,DOSE1'=0 D
..I $L(VAG)<41 S ^TMP("PSSD",$J,$P(DOSE1,"^",2),PSONAME)=""
END K ^TMP($J,"PSSUP"),APPL,COM,COMSUP,FF,GG,NODE,ONO,POINAME,PSOPTR,PSPTR,RRR,SSS,SUPER Q
CANT ;Generic name only, cannot match
K ^TMP("PSSD",$J,"ZZZZ")
F ZZ=0:0 S ZZ=$O(^PSDRUG(ZZ)) Q:'ZZ D I TMPFLAG S ^TMP("PSSD",$J,"ZZZZ",PSDNAME)=REASON
.K PTDOS,DOSEF,REASON
.S PSND=$G(^PSDRUG(ZZ,"ND")),PSDNAME=$P($G(^(0)),"^"),PSOPRT=$P($G(^(2)),"^"),TMPFLAG=0 S DA=$P($G(PSND),"^"),K=$P($G(PSND),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DSE=X,X=$$VAGN^PSNAPIS(DA),GN1=X
.I +PSOPRT Q
.S PSQFLAG=0 I +$P(PSND,"^"),+$P(PSND,"^",3),GN1'=0,DSE'=0 D
..I DSE'=0,$D(^PS(50.606,$P(DSE,"^"),0)),$L(GN1)<41 S PSQFLAG=1
.I PSQFLAG Q
.S TMPFLAG=1
.I $P(PSND,"^")="" S REASON="NDF link missing or incomplete" Q
.I $P(PSND,"^",3)="" S REASON="No PSNDF VA Product Name Entry" Q
.I GN1=0 S REASON="Invalid National Drug File entry" Q
.S PSVA=$P(PSND,"^",3),DA=$P(PSND,"^"),K=PSVA,X=$$PROD0^PSNAPIS(DA,K) I X']"" S REASON="Invalid PSNDF VA Product Name Entry" Q
.I DSE=0 S REASON="No Dosage Form Entry in NDF" Q
.I DSE=0 S REASON="Missing Dosage Form in NDF" Q
.I DSE=0 S REASON="Invalid entry in Dosage Form File" Q
.I $L(GN1)>40 S REASON="Generic name greater than 40 characters" Q
.S REASON="Undertermined problem" Q
DONE K DOSEFORM,DOSEPTR,PSAPP,PSDNAME,PSND,PSQFLAG,PSVA,TMPFLAG,ZZ Q
PSSPOIM ;BIR/RTR-Orderable Items by VA Generic Name only ; 09/01/98 7:11
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
+2 ;K ^TMP("PSSD",$J)
+3 IF '$GET(PSMATCH)
GOTO CANT
+4 ;VA Generic Name only that can match
BEG FOR RRR=0:0
SET RRR=$ORDER(^PSDRUG(RRR))
IF 'RRR
QUIT
Begin DoDot:1
+1 KILL NODE,PSONAME,PSOPTR
+2 SET NODE=$GET(^PSDRUG(RRR,"ND"))
SET PSONAME=$PIECE($GET(^(0)),"^")
SET PSOPTR=$PIECE($GET(^(2)),"^")
SET DA=$PIECE(NODE,"^")
SET K=$PIECE(NODE,"^",3)
SET X=$$PSJDF^PSNAPIS(DA,K)
SET DOSE1=X
+3 IF PSONAME=""
QUIT
+4 IF +PSOPTR
QUIT
+5 IF '$PIECE(NODE,"^")
QUIT
+6 ;Next 5 lines of code could only apply if this report is run and
+7 ;there are Dispensed drugs that are already matched
+8 KILL ^TMP($JOB,"PSSUP")
IF +$PIECE(NODE,"^")
IF +$PIECE(NODE,"^",3)
FOR GG=0:0
SET GG=$ORDER(^PSDRUG("AND",+NODE,GG))
IF 'GG
QUIT
IF +$PIECE($GET(^PSDRUG(GG,2)),"^")
IF $DATA(^PS(50.7,$PIECE(^PSDRUG(GG,2),"^"),0))
Begin DoDot:2
+9 SET ONO=$GET(^PSDRUG(GG,"ND"))
IF +$PIECE(ONO,"^")
IF +$PIECE(ONO,"^",3)
IF DOSE1'=0
SET DA=$PIECE($GET(ONO),"^")
SET K=$PIECE($GET(ONO),"^",3)
SET X=$$PSJDF^PSNAPIS(DA,K)
SET DOSE2=X
IF DOSE2'=0
Begin DoDot:3
+10 IF DOSE1=DOSE2
SET ^TMP($JOB,"PSSUP",GG)=$PIECE(^PSDRUG(GG,2),"^")
End DoDot:3
End DoDot:2
+11 SET (COM,COMSUP)=0
IF $ORDER(^TMP($JOB,"PSSUP",0))
SET COM=1
SET FF=$ORDER(^TMP($JOB,"PSSUP",0))
SET SUPER=^TMP($JOB,"PSSUP",FF)
FOR FF=0:0
SET FF=$ORDER(^TMP($JOB,"PSSUP",FF))
IF 'FF
QUIT
IF SUPER'=^TMP($JOB,"PSSUP",FF)
SET COMSUP=1
+12 IF COM
IF COMSUP
QUIT
+13 IF COM
IF 'COMSUP
SET SSS=$ORDER(^TMP($JOB,"PSSUP",0))
SET SSS=^TMP($JOB,"PSSUP",SSS)
SET ^TMP("PSSD",$JOB,$PIECE($GET(^PS(50.7,SUPER,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^PS(50.7,SSS,0)),"^",2),0)),"^"),PSONAME)=""
QUIT
+14 IF +$PIECE(NODE,"^")
IF +$PIECE(NODE,"^",3)
SET DA=$PIECE($GET(NODE),"^")
SET X=$$VAGN^PSNAPIS(DA)
SET VAG=X
IF VAG'=0
IF DOSE1'=0
Begin DoDot:2
+15 IF $LENGTH(VAG)<41
SET ^TMP("PSSD",$JOB,$PIECE(DOSE1,"^",2),PSONAME)=""
End DoDot:2
End DoDot:1
END KILL ^TMP($JOB,"PSSUP"),APPL,COM,COMSUP,FF,GG,NODE,ONO,POINAME,PSOPTR,PSPTR,RRR,SSS,SUPER
QUIT
CANT ;Generic name only, cannot match
+1 KILL ^TMP("PSSD",$JOB,"ZZZZ")
+2 FOR ZZ=0:0
SET ZZ=$ORDER(^PSDRUG(ZZ))
IF 'ZZ
QUIT
Begin DoDot:1
+3 KILL PTDOS,DOSEF,REASON
+4 SET PSND=$GET(^PSDRUG(ZZ,"ND"))
SET PSDNAME=$PIECE($GET(^(0)),"^")
SET PSOPRT=$PIECE($GET(^(2)),"^")
SET TMPFLAG=0
SET DA=$PIECE($GET(PSND),"^")
SET K=$PIECE($GET(PSND),"^",3)
SET X=$$PSJDF^PSNAPIS(DA,K)
SET DSE=X
SET X=$$VAGN^PSNAPIS(DA)
SET GN1=X
+5 IF +PSOPRT
QUIT
+6 SET PSQFLAG=0
IF +$PIECE(PSND,"^")
IF +$PIECE(PSND,"^",3)
IF GN1'=0
IF DSE'=0
Begin DoDot:2
+7 IF DSE'=0
IF $DATA(^PS(50.606,$PIECE(DSE,"^"),0))
IF $LENGTH(GN1)<41
SET PSQFLAG=1
End DoDot:2
+8 IF PSQFLAG
QUIT
+9 SET TMPFLAG=1
+10 IF $PIECE(PSND,"^")=""
SET REASON="NDF link missing or incomplete"
QUIT
+11 IF $PIECE(PSND,"^",3)=""
SET REASON="No PSNDF VA Product Name Entry"
QUIT
+12 IF GN1=0
SET REASON="Invalid National Drug File entry"
QUIT
+13 SET PSVA=$PIECE(PSND,"^",3)
SET DA=$PIECE(PSND,"^")
SET K=PSVA
SET X=$$PROD0^PSNAPIS(DA,K)
IF X']""
SET REASON="Invalid PSNDF VA Product Name Entry"
QUIT
+14 IF DSE=0
SET REASON="No Dosage Form Entry in NDF"
QUIT
+15 IF DSE=0
SET REASON="Missing Dosage Form in NDF"
QUIT
+16 IF DSE=0
SET REASON="Invalid entry in Dosage Form File"
QUIT
+17 IF $LENGTH(GN1)>40
SET REASON="Generic name greater than 40 characters"
QUIT
+18 SET REASON="Undertermined problem"
QUIT
End DoDot:1
IF TMPFLAG
SET ^TMP("PSSD",$JOB,"ZZZZ",PSDNAME)=REASON
DONE KILL DOSEFORM,DOSEPTR,PSAPP,PSDNAME,PSND,PSQFLAG,PSVA,TMPFLAG,ZZ
QUIT
