source: WorldVistAEHR/trunk/r/NATIONAL_DRUG_FILE-PSN/PSN4POST.m@ 1361

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1PSN4POST ;BIR/DMA-post install routine to convert data in file 50 ;23 Jul 98 / 1:27 PM
2 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
3 ;
4 N ROOT,ROOT1,DA,I,J,K,X,Y,A1,A2,B,IN,IN1,LINE
5 S ROOT=$NA(@XPDGREF@("LINE")),ROOT1=$NA(@XPDGREF@("CONV")),I=1
6 F J=1:1 Q:'$D(@ROOT@(J)) S LINE=^(J) F I=1:1:$L(LINE,"|")-1 S X=$P(LINE,"|",I),@ROOT1@($P(X,"^"),$P(X,"^",2))=$P(X,"^",3)
7 S DA=+$P($G(^PS(59.7,1,10)),"^",4) F S DA=$O(^PSDRUG(DA)) Q:'DA S X=$G(^(DA,"ND")),A=+X,B=+$P(X,"^",3) I A,B D
8 .I $D(@ROOT1@(A,B)) S X=^(B),$P(^PSDRUG(DA,"ND"),"^",3)=X
9 .E S $P(^PSDRUG(DA,"ND"),"^",1,5)="^^^^",X=$P(^("ND"),"^",10),$P(^("ND"),"^",10)="" I X]"" K ^PSDRUG("AQ1",X,DA)
10 .S $P(^PS(59.7,1,10),"^",4)=DA
11 I $P(^PS(59.7,1,10),"^")'="4.0" S ^PS(50.606,245,0)="AEROSOL,VAG",DIK="^PS(50.606,",DA=245 D IX^DIK
12 I $P(^PS(59.7,1,10),"^")'="4.0" S ^PS(50.606,246,0)="CAP/INJ",DIK="^PS(50.606,",DA=246 D IX^DIK
13 I $P(^PS(59.7,1,10),"^")'="4.0" S NUM=$O(^PS(51.2," "),-1),NUM=NUM+1,^PS(51.2,NUM,0)="ORAL/SUBCUTANEOUS^^PO SC",DIK="^PS(51.2,",DA=NUM D IX^DIK
14 I $P(^PS(59.7,1,10),"^")'="4.0" S NUM=$O(^PS(51.2," "),-1),NUM=NUM+1,^PS(51.2,NUM,0)="INTRAPLEURAL",DIK="^PS(51.2,",DA=NUM D IX^DIK
15 S $P(^PS(59.7,1,10),"^",5)=1
16 S $P(^PS(59.7,1,10),"^",1)="4.0"
17 ;
18 ;LOAD AND INDEX NATIONAL INTERACTIONS
19 S ROOT=$NA(@XPDGREF@("INTER")),DA=0
20 F S DA=$O(@ROOT@(DA)) Q:'DA S X=^(DA),^PS(56,DA,0)=X,^PS(56,"B",$E($P(X,"^"),1,30),DA)="",^PS(56,"C",$P(X,"/"),DA)="",^PS(56,"C",$P($P(X,"^"),"/",2),DA)="",A=$P(X,"^",2),B=$P(X,"^",3),^PS(56,"AE",A,B,DA)="",^PS(56,"AE",B,A,DA)=""
21 ;NOW TRY TO UPDATE SEVERITIES
22 S ROOT=$NA(@XPDGREF@("OLD")),J=0
23 F S J=$O(@ROOT@(J)) Q:'J S X=^(J),DA=$O(^PS(56,"AE",$P(X,"^",2),$P(X,"^",3),0)) I DA S Y=^PS(56,DA,0) I $P(Y,"^",4)=2,$P(X,"^",4)=1 S $P(^(0),"^",4)=1,^("L")=1
24 ;NOW LOAD AND INDEX LOCAL INTERACTIONS
25 S ROOT=$NA(@XPDGREF@("LOCAL"))
26 F DA=1:1 Q:'$D(@ROOT@(DA)) S X=^(DA),A=$P(X,"^",2),B=$P(X,"^",3),IN1=$O(^PS(56,"AE",A,B,0)) D
27 .I 'IN1 S IN=$O(^PS(56," "),-1)+1 S:IN<15000 IN=15000 S ^PS(56,IN,0)=X,^("L")=1,^PS(56,"B",$E($P(X,"^"),1,30),IN)="",A1=$P($P(X,"^"),"/"),A2=$P($P(X,"^"),"/",2) S:A1]"" ^PS(56,"C",A1,IN)="" S:A2]"" ^PS(56,"C",A2,IN)="" D
28 ..S ^PS(56,"AE",A,B,IN)="",^PS(56,"AE",B,A,IN)=""
29 .I IN1,$P(^PS(56,IN1,0),"^",4)=2,$P(X,"^",4)=1 S $P(^PS(56,IN1,0),"^",4)=1,^("L")=1
30 ;
31 ;REINDEX "APD"
32 S DA=0 F S DA=$O(^PS(56,DA)) Q:'DA D ^PSNDDI1
33 ;NOW HOUSEKEEPING
34 S LAST=$O(^PS(56," "),-1),DA=0 F I=0:1 S DA=$O(^PS(56,DA)) Q:'DA
35 S $P(^PS(56,0),"^",3,4)=LAST_"^"_I
36 ;
37ALERG ;NOW REDO ALLERGIES - SEE DBIA 2545
38 N IEN,VPT
39 S IEN=0 F S IEN=$O(^GMR(120.8,IEN)) Q:'IEN S VPT=$P($G(^(IEN,0)),"^",3) I VPT["PSNDF" S $P(^(0),"^",3)=+VPT_";PSNDF(50.6,"
40 ;
41 Q
Note: See TracBrowser for help on using the repository browser.