42 lines
2.6 KiB
Mathematica
42 lines
2.6 KiB
Mathematica
PSN4POST ;BIR/DMA-post install routine to convert data in file 50 ;23 Jul 98 / 1:27 PM
|
|
;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
|
|
;
|
|
N ROOT,ROOT1,DA,I,J,K,X,Y,A1,A2,B,IN,IN1,LINE
|
|
S ROOT=$NA(@XPDGREF@("LINE")),ROOT1=$NA(@XPDGREF@("CONV")),I=1
|
|
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)
|
|
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
|
|
.I $D(@ROOT1@(A,B)) S X=^(B),$P(^PSDRUG(DA,"ND"),"^",3)=X
|
|
.E S $P(^PSDRUG(DA,"ND"),"^",1,5)="^^^^",X=$P(^("ND"),"^",10),$P(^("ND"),"^",10)="" I X]"" K ^PSDRUG("AQ1",X,DA)
|
|
.S $P(^PS(59.7,1,10),"^",4)=DA
|
|
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
|
|
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
|
|
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
|
|
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
|
|
S $P(^PS(59.7,1,10),"^",5)=1
|
|
S $P(^PS(59.7,1,10),"^",1)="4.0"
|
|
;
|
|
;LOAD AND INDEX NATIONAL INTERACTIONS
|
|
S ROOT=$NA(@XPDGREF@("INTER")),DA=0
|
|
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)=""
|
|
;NOW TRY TO UPDATE SEVERITIES
|
|
S ROOT=$NA(@XPDGREF@("OLD")),J=0
|
|
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
|
|
;NOW LOAD AND INDEX LOCAL INTERACTIONS
|
|
S ROOT=$NA(@XPDGREF@("LOCAL"))
|
|
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
|
|
.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
|
|
..S ^PS(56,"AE",A,B,IN)="",^PS(56,"AE",B,A,IN)=""
|
|
.I IN1,$P(^PS(56,IN1,0),"^",4)=2,$P(X,"^",4)=1 S $P(^PS(56,IN1,0),"^",4)=1,^("L")=1
|
|
;
|
|
;REINDEX "APD"
|
|
S DA=0 F S DA=$O(^PS(56,DA)) Q:'DA D ^PSNDDI1
|
|
;NOW HOUSEKEEPING
|
|
S LAST=$O(^PS(56," "),-1),DA=0 F I=0:1 S DA=$O(^PS(56,DA)) Q:'DA
|
|
S $P(^PS(56,0),"^",3,4)=LAST_"^"_I
|
|
;
|
|
ALERG ;NOW REDO ALLERGIES - SEE DBIA 2545
|
|
N IEN,VPT
|
|
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,"
|
|
;
|
|
Q
|