| 1 | PSSPOIM ;BIR/RTR-Orderable Items by VA Generic Name only ; 09/01/98 7:11
|
|---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
|
|---|
| 3 | ;K ^TMP("PSSD",$J)
|
|---|
| 4 | I '$G(PSMATCH) G CANT
|
|---|
| 5 | ;VA Generic Name only that can match
|
|---|
| 6 | BEG F RRR=0:0 S RRR=$O(^PSDRUG(RRR)) Q:'RRR D
|
|---|
| 7 | .K NODE,PSONAME,PSOPTR
|
|---|
| 8 | .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
|
|---|
| 9 | .Q:PSONAME=""
|
|---|
| 10 | .I +PSOPTR Q
|
|---|
| 11 | .I '$P(NODE,"^") Q
|
|---|
| 12 | .;Next 5 lines of code could only apply if this report is run and
|
|---|
| 13 | .;there are Dispensed drugs that are already matched
|
|---|
| 14 | .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
|
|---|
| 15 | ..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
|
|---|
| 16 | ...I DOSE1=DOSE2 S ^TMP($J,"PSSUP",GG)=$P(^PSDRUG(GG,2),"^")
|
|---|
| 17 | .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
|
|---|
| 18 | .I COM,COMSUP Q
|
|---|
| 19 | .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
|
|---|
| 20 | .I +$P(NODE,"^"),+$P(NODE,"^",3) S DA=$P($G(NODE),"^"),X=$$VAGN^PSNAPIS(DA),VAG=X I VAG'=0,DOSE1'=0 D
|
|---|
| 21 | ..I $L(VAG)<41 S ^TMP("PSSD",$J,$P(DOSE1,"^",2),PSONAME)=""
|
|---|
| 22 | END K ^TMP($J,"PSSUP"),APPL,COM,COMSUP,FF,GG,NODE,ONO,POINAME,PSOPTR,PSPTR,RRR,SSS,SUPER Q
|
|---|
| 23 | CANT ;Generic name only, cannot match
|
|---|
| 24 | K ^TMP("PSSD",$J,"ZZZZ")
|
|---|
| 25 | F ZZ=0:0 S ZZ=$O(^PSDRUG(ZZ)) Q:'ZZ D I TMPFLAG S ^TMP("PSSD",$J,"ZZZZ",PSDNAME)=REASON
|
|---|
| 26 | .K PTDOS,DOSEF,REASON
|
|---|
| 27 | .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
|
|---|
| 28 | .I +PSOPRT Q
|
|---|
| 29 | .S PSQFLAG=0 I +$P(PSND,"^"),+$P(PSND,"^",3),GN1'=0,DSE'=0 D
|
|---|
| 30 | ..I DSE'=0,$D(^PS(50.606,$P(DSE,"^"),0)),$L(GN1)<41 S PSQFLAG=1
|
|---|
| 31 | .I PSQFLAG Q
|
|---|
| 32 | .S TMPFLAG=1
|
|---|
| 33 | .I $P(PSND,"^")="" S REASON="NDF link missing or incomplete" Q
|
|---|
| 34 | .I $P(PSND,"^",3)="" S REASON="No PSNDF VA Product Name Entry" Q
|
|---|
| 35 | .I GN1=0 S REASON="Invalid National Drug File entry" Q
|
|---|
| 36 | .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
|
|---|
| 37 | .I DSE=0 S REASON="No Dosage Form Entry in NDF" Q
|
|---|
| 38 | .I DSE=0 S REASON="Missing Dosage Form in NDF" Q
|
|---|
| 39 | .I DSE=0 S REASON="Invalid entry in Dosage Form File" Q
|
|---|
| 40 | .I $L(GN1)>40 S REASON="Generic name greater than 40 characters" Q
|
|---|
| 41 | .S REASON="Undertermined problem" Q
|
|---|
| 42 | DONE K DOSEFORM,DOSEPTR,PSAPP,PSDNAME,PSND,PSQFLAG,PSVA,TMPFLAG,ZZ Q
|
|---|
