source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSAUTL.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: 923 bytes
Line 
1PSSAUTL ;BIR/LTL-Utility Routine for FM functions ; 09/02/97 8:28
2 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
3DALINK ;check for Primary already linked to DA location
4 I $O(^PSD(58.8,"P",X,0)) W $C(7),!!,$P($G(^PSD(58.8,+$O(^PSD(58.8,"P",X,0)),0)),U)," is already linked to ",$$INVNAME^PRCPUX1(X) K X Q
5 Q
6FI N PSA S PSA=$O(^PSDRUG("AB",+X,0)) S:PSA=DA PSA=$O(^(DA)) W:$G(PSA) $C(7),!!,$P($G(^PSDRUG(+$O(^PSDRUG("AB",+X,"")),0)),U)," is already linked to",!!,"Item #",X," ",$$DESCR^PRCPUX1(0,X) S:$G(PSA) X="" Q
7 ;
8ITEM(PSA) ;return Item Master # ^PRC(441
9 ;PSA = NDC from ^PSDRUG(
10 S PSA(1)=$O(^PRC(441,"F",PSA,0))
11 D:'PSA(1)
12 .S:$L($P(PSA,"-"))<6 PSA(1)=$O(^PRC(441,"F",0_PSA,0))
13 .S:'PSA(1)&($L($P(PSA,"-"))=4) PSA(1)=$O(^PRC(441,"F","00"_PSA,0))
14 .I 'PSA(1),'$E(PSA),$L($P(PSA,"-"))>4 S PSA(1)=$O(^PRC(441,"F",$E(PSA,2,14),0))
15 .I 'PSA(1),'$E(PSA,1,2),$L($P(PSA,"-"))=6 S PSA(1)=$O(^PRC(441,"F",$E(PSA,3,14),0))
16 Q PSA(1)
Note: See TracBrowser for help on using the repository browser.