source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSPOIC.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: 4.0 KB
Line 
1PSSPOIC ;BIR/RTR-Orderable items by VA Name after Primary ; 09/01/98 7:10
2 ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
3 I '$G(PSMATCH) G CANT
4 ;VA Generic Name after Primary checks that can auto-match
5BEG F PPP=0:0 S PPP=$O(^PSDRUG(PPP)) Q:'PPP D
6 .S NDNOD=$G(^PSDRUG(PPP,"ND")),PSODNAME=$P($G(^(0)),"^"),PRIPTR=$P($G(^(2)),"^",6),PSOIPTR=$P($G(^(2)),"^") S DA=$P($G(PSNDO),"^"),K=$P($G(PSNDO),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOFO=X
7 .Q:PSODNAME=""
8 .I $D(^TMP("PSS",$J,PSODNAME)) Q
9 .I +PSOIPTR Q
10 .K ^TMP($J,"PSSPP") I +$P(NDNOD,"^"),+$P(NDNOD,"^",3) F AA=0:0 S AA=$O(^PSDRUG("AND",+NDNOD,AA)) Q:'AA S OTHNAME=$P($G(^PSDRUG(AA,0)),"^") I $D(^TMP("PSS",$J,OTHNAME)) D
11 ..S ONOD=$G(^PSDRUG(AA,"ND")) I +$P(ONOD,"^"),+$P(ONOD,"^",3),DOFO'=0 S DA=$P($G(ONOD),"^"),K=$P($G(ONOD),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOFO1=X I DOFO1'=0 D
12 ...I DOFO=DOFO1 S ^TMP($J,"PSSPP",AA)=^TMP("PSS",$J,OTHNAME)
13 .S (COMM,COMMSUP)=0 I $O(^TMP($J,"PSSPP",0)) S COMM=1 S WW=$O(^TMP($J,"PSSPP",0)),POII=^TMP($J,"PSSPP",WW) F WW=0:0 S WW=$O(^TMP($J,"PSSPP",WW)) Q:'WW I POII'=^TMP($J,"PSSPP",WW) S COMMSUP=1
14 .I COMM,COMMSUP Q
15 .I COMM,'COMMSUP S ZZZ=$O(^TMP($J,"PSSPP",0)),ZZZ=^TMP($J,"PSSPP",ZZZ) S ^TMP("PSSD",$J,ZZZ,PSODNAME)="" Q
16 .I +$P(NDNOD,"^"),+$P(NDNOD,"^",3) S DA=$P($G(NDNOD),"^"),K=$P($G(NDNOD),"^",3),X=$$PSJDF^PSNAPIS(DA,K),D1F1=X I D1F1'=0 D
17 ..S DA=$P($G(NDNOD),"^"),X=$$VAGN^PSNAPIS(DA),VAGN=X I $L(VAGN)<41 D
18 ...S ^TMP("PSSD",$J,VAGN_" "_$P(D1F1,"^",2),PSODNAME)=""
19END K ^TMP($J,"PSSPP"),AA,APPU,COMM,COMMSUP,NDNOD,ONOD,OTHNAME,POII,PPP,PSOIPTR,PRIPTR,PSODF,PSODNAME,WW,ZZZ Q
20CANT ;Generic Name after Primary, can't match
21 F LLL=0:0 S LLL=$O(^PSDRUG(LLL)) Q:'LLL D I TMPFLG S ^TMP("PSSD",$J,"ZZZZ",PSNAME)=RSN
22 .K RSN,DOSFO,POTDOS
23 .S PSNDO=$G(^PSDRUG(LLL,"ND")),PSNAME=$P($G(^(0)),"^"),PSPTR=$P($G(^(2)),"^"),PSPRIM=$P($G(^(2)),"^",6) S DA=$P($G(PSNDO),"^"),K=$P($G(PSNDO),"^",3),X=$$PSJDF^PSNAPIS(DA,K),FRM1=X,TMPFLG=0
24 .I +PSPTR Q
25 .;If Primary, ZZZZ or PSS
26 .I $D(^TMP("PSS",$J,PSNAME)) Q
27 .K ^TMP($J,"PSSO") I +$P(PSNDO,"^"),+$P(PSNDO,"^",3) F BB=0:0 S BB=$O(^PSDRUG("AND",+PSNDO,BB)) Q:'BB S OTHER=$P($G(^PSDRUG(BB,0)),"^") I $D(^TMP("PSS",$J,OTHER)) D
28 ..S OTNO=$G(^PSDRUG(BB,"ND")) I +$P(OTNO,"^"),+$P(OTNO,"^",3),FRM1'=0 S DA=$P($G(OTNO),"^"),K=$P($G(OTNO),"^",3),X=$$PSJDF^PSNAPIS(DA,K),FRM2=X I FRM2'=0 D
29 ...I FRM1=FRM2 D
30 ....S SAME=0,POINAME=^TMP("PSS",$J,OTHER) F III=0:0 S III=$O(^TMP($J,"PSSO",III)) Q:'III I POINAME=^(III) S SAME=1
31 ....I 'SAME S ^TMP($J,"PSSO",BB)=^TMP("PSS",$J,OTHER)
32 .S PSCOMMD=0 I $O(^TMP($J,"PSSO",0)) S TTT=$O(^TMP($J,"PSSO",0)),ORDNAM=^TMP($J,"PSSO",TTT) F TTT=0:0 S TTT=$O(^TMP($J,"PSSO",TTT)) Q:'TTT I ORDNAM'=^TMP($J,"PSSO",TTT) S PSCOMMD=1
33 .I $O(^TMP($J,"PSSO",0)),'PSCOMMD K ^TMP("PSSD",$J,"ZZZZ",PSNAME) Q
34 .S CNT=0 I $O(^TMP($J,"PSSO",0)),'$D(^TMP("PSSD",$J,"ZZZZ",PSNAME)) S (CNT,TMPFLG)=1 F NN=0:0 S NN=$O(^TMP($J,"PSSO",NN)) Q:'NN S ^TMP("PSSD",$J,"ZZZZ",PSNAME,CNT)=^TMP($J,"PSSO",NN) S CNT=CNT+1
35 .I CNT S RSN="Multiple Orderable Items" Q
36 .S QFLAG=0 I +$P(PSNDO,"^"),+$P(PSNDO,"^",3) S DA=$P($G(PSNDO),"^"),X=$$VAGN^PSNAPIS(DA),VAGN1=X I VAGN1'=0 S DOSFO=$P(FRM1,"^") D
37 ..I DOSFO,$D(^PS(50.606,DOSFO,0)),$L(VAGN1)<41 S QFLAG=1
38 .I QFLAG K ^TMP("PSSD",$J,"ZZZZ",PSNAME) Q
39 .I $D(^TMP("PSSD",$J,"ZZZZ",PSNAME)) Q
40 .S TMPFLG=1
41 .I $P(PSNDO,"^")="" S RSN="NDF link missing or incomplete" Q
42 .I $P(PSNDO,"^",3)="" S RSN="No PSNDF VA Product Name Entry" Q
43 .I VAGN1=0 S RSN="Invalid National Drug File Entry" Q
44 .S PVA=$P($G(PSNDO),"^",3),DA=$P($G(PSNDO),"^"),K=PVA,X=$$PROD0^PSNAPIS(DA,K) I X']"" S RSN="Invalid PSNDF VA Product Name Entry" Q
45 .S DA=$P($G(PSNDO),"^"),K=PVA,X=$$PSJDF^PSNAPIS(DA,K),FRM0=X I FRM0=0 S RSN="No Dosage Form entry in NDF" Q
46 .I FRM0=0 S RSN="Missing Dosage Form in NDF" Q
47 .I FRM0=0 S RSN="Invalid Entry in Dosage Form File" Q
48 .I $L(VAGN1)>40 S RSN="Generic name exceeds 40 characters" Q
49 .S RSN="Undetermined problem" Q
50DONE K ^TMP($J,"PSSO"),^TMP("PSS",$J),APL,BB,CNT,DOSFRM,DOSPNT,SAME,LLL,III,NN,ORDNAM,OTHER,OTNO,POINAME,PSCOMMD,PSNAME,PSPTR,PSPRIM,POTDOS,PSNDO,DOSFO,PVA,QFLAG,RSN,TTT,TMPFLG Q
Note: See TracBrowser for help on using the repository browser.