source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSPOIM.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PSSPOIM ;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
6BEG 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)=""
22END K ^TMP($J,"PSSUP"),APPL,COM,COMSUP,FF,GG,NODE,ONO,POINAME,PSOPTR,PSPTR,RRR,SSS,SUPER Q
23CANT ;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
42DONE K DOSEFORM,DOSEPTR,PSAPP,PSDNAME,PSND,PSQFLAG,PSVA,TMPFLAG,ZZ Q
Note: See TracBrowser for help on using the repository browser.