| 1 | PSN4POST ;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 | ;
|
|---|
| 37 | ALERG ;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
|
|---|
