| 1 | PSN158D ;BIR/DMA-post install routine to load data ; 20 Nov 2007 10:27 AM
|
---|
| 2 | ;;4.0; NATIONAL DRUG FILE;**158**; 30 Oct 98;Build 17
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^PSDRUG supported by DBIA #2192
|
---|
| 5 | ; Reference to PSN^PSSHUIDG supported by DBIA #3621
|
---|
| 6 | ; Reference to ^GMR(120.8) supported by DBIA #4606
|
---|
| 7 | ;
|
---|
| 8 | N CL,CLA,CMOP,CT,DA,DA1,DIA,DIC,DIE,DIK,DINUM,DR,FDA,FILE,FLDS,GE,GROOT,GROOT1,IENS,IN,INA,IND,INDX,INV,J,JJ,K,LI,LINE,NA,NAME,ND,NEW,NFI,POST,PR,PSN,PSN1,PSN11,PSN21,PSNDF,R1,ROOT,ROOT1,ROOT2,ROOT3,SUBS,VAC,VAIN,VAPN
|
---|
| 9 | N X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XUMF
|
---|
| 10 | N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
|
---|
| 11 | K ^TMP($J),^TMP("PSN",$J),^TMP("PSNN",$J)
|
---|
| 12 | ;
|
---|
| 13 | S PSNDF=1
|
---|
| 14 | S XUMF=1
|
---|
| 15 | ;TO ALLOW ADDS TO 56 ,50.416,50.605,50.606, AND 50.6
|
---|
| 16 | ;MORE ELEGANT CHANGE LATER
|
---|
| 17 | ;
|
---|
| 18 | S FILE=0,GROOT=$NA(@XPDGREF@("DATANT"))
|
---|
| 19 | ;load new entries first
|
---|
| 20 | F S FILE=$O(@GROOT@(FILE)) Q:'FILE S ROOT=$$ROOT^DILFD(FILE) I ROOT]"" S GROOT1=$NA(@GROOT@(FILE)) F JJ=1:2 Q:'$D(@GROOT1@(JJ)) S DIA=@GROOT1@(JJ),NEW=@GROOT1@(JJ+1) D
|
---|
| 21 | .S DA=+DIA K FDA,IENS
|
---|
| 22 | .I $$GET1^DIQ(FILE,DA,.01)]"" S FDA(FILE,DA_",",.01)=NEW D FILE^DIE("","FDA") Q
|
---|
| 23 | .S DINUM=DA,X=NEW,DIC=ROOT,DIC(0)="L",DIC("DR")="S Y=0" K DD,DO D FILE^DICN
|
---|
| 24 | ;
|
---|
| 25 | S FILE=0,GROOT=$NA(@XPDGREF@("DATAN"))
|
---|
| 26 | ;load new multiple entries next
|
---|
| 27 | F S FILE=$O(@GROOT@(FILE)) Q:'FILE S ROOT=$$ROOT^DILFD(FILE) I ROOT]"" S GROOT1=$NA(@GROOT@(FILE)) F JJ=1:2 Q:'$D(@GROOT1@(JJ)) S DIA=@GROOT1@(JJ),NEW=@GROOT1@(JJ+1) D
|
---|
| 28 | .S IENS=$P(DIA,"^")_",",FLDS=$P(DIA,"^",3),ROOT=FILE K FDA,IEN
|
---|
| 29 | .I FLDS["," D
|
---|
| 30 | ..;it should, but
|
---|
| 31 | ..S LI=$P(DIA,"^",3) F J=1:1:$L(LI,",")-1 S ROOT=+$P(^DD(ROOT,+$P(LI,",",J),0),"^",2)
|
---|
| 32 | ..S LI=$P(DIA,"^"),IENS="" F J=$L(LI,","):-1:1 S IENS=IENS_$P(LI,",",J)_","
|
---|
| 33 | ..S DA=+IENS
|
---|
| 34 | .;I $$GET1^DIQ(ROOT,IENS,.01)]"" S FDA(ROOT,IENS,.01)=NEW D FILE^DIE("","FDA") Q
|
---|
| 35 | .S FDA(ROOT,"+"_IENS,.01)=NEW,IEN(DA)=DA D UPDATE^DIE("","FDA","IEN")
|
---|
| 36 | .I FILE=50.68,$P(DIA,"^",3)="14,.01" S ^TMP("PSNN",$J,$P(DIA,"^"))=""
|
---|
| 37 | ;
|
---|
| 38 | S FILE=0,GROOT=$NA(@XPDGREF@("DATAO"))
|
---|
| 39 | ;now load the rest of the data
|
---|
| 40 | F S FILE=$O(@GROOT@(FILE)) Q:'FILE S ROOT=$$ROOT^DILFD(FILE) I ROOT]"" S GROOT1=$NA(@GROOT@(FILE)) F JJ=1:2 Q:'$D(@GROOT1@(JJ)) S DIA=@GROOT1@(JJ),NEW=@GROOT1@(JJ+1) D
|
---|
| 41 | .S IENS=$P(DIA,"^")_",",FLDS=$P(DIA,"^",3),ROOT=FILE K FDA,IEN
|
---|
| 42 | .I FLDS["," D
|
---|
| 43 | ..S LI=$P(DIA,"^",3) F J=1:1:$L(LI,",")-1 S ROOT=+$P(^DD(ROOT,+$P(LI,",",J),0),"^",2)
|
---|
| 44 | ..S LI=$P(DIA,"^"),IENS="" F J=$L(LI,","):-1:1 S IENS=IENS_$P(LI,",",J)_","
|
---|
| 45 | ..S FLDS=$P(FLDS,",",$L(FLDS,","))
|
---|
| 46 | .S FDA(ROOT,IENS,FLDS)=NEW D FILE^DIE("","FDA")
|
---|
| 47 | S JJ=0 F S JJ=$O(^TMP("PSNN",$J,JJ)) Q:'JJ S DA=$P(JJ,",",2),DA(1)=+JJ D ING^PSNXREF
|
---|
| 48 | ;
|
---|
| 49 | ;
|
---|
| 50 | WORD S ROOT1=$NA(@XPDGREF@("WORD")),CT=0,ROOT2=$NA(@ROOT1@(0))
|
---|
| 51 | F S CT=$O(@ROOT2) Q:'CT S ROOT2=$NA(@ROOT1@(CT)),NAME=@ROOT2,ROOT3=$NA(@ROOT2@("D")) K @NAME M @NAME=@ROOT3
|
---|
| 52 | ;
|
---|
| 53 | ;
|
---|
| 54 | MESSAGE K ^TMP($J) M ^TMP($J)=@XPDGREF@("MESSAGE") K ^TMP($J,0)
|
---|
| 55 | ;
|
---|
| 56 | GROUP K XMY S X=$G(@XPDGREF@("GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
|
---|
| 57 | S DA=0 F S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA S XMY(DA)=""
|
---|
| 58 | I $D(DUZ) S XMY(DUZ)=""
|
---|
| 59 | ;
|
---|
| 60 | S XMSUB="DATA UPDATE FOR NDF"
|
---|
| 61 | S XMDUZ="NDF MANAGER"
|
---|
| 62 | S XMTEXT="^TMP($J," N DIFROM D ^XMD
|
---|
| 63 | ;
|
---|
| 64 | K ^TMP($J) M ^TMP($J)=@XPDGREF@("MESSAGE2") K ^TMP($J,0)
|
---|
| 65 | ;
|
---|
| 66 | K XMY S X=$G(@XPDGREF@("GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
|
---|
| 67 | S DA=0 F S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA S XMY(DA)=""
|
---|
| 68 | I $D(DUZ) S XMY(DUZ)=""
|
---|
| 69 | ;
|
---|
| 70 | S XMSUB="UPDATED INTERACTIONS"
|
---|
| 71 | S XMDUZ="NDF MANAGER"
|
---|
| 72 | S XMTEXT="^TMP($J," N DIFROM D ^XMD
|
---|
| 73 | DRUGFILE ;
|
---|
| 74 | ;NOW UPDATE LOCAL DRUG FILE
|
---|
| 75 | K ^TMP($J)
|
---|
| 76 | S PSN=$$PATCH^XPDUTL("PSS*1.0*34"),PSN1=$$PATCH^XPDUTL("PSS*1.0*42")
|
---|
| 77 | S ROOT1=$NA(@XPDGREF@("GENERIC")),ROOT2=$NA(@XPDGREF@("PRODUCT")),ROOT3=$NA(@XPDGREF@("POE")),DA=0
|
---|
| 78 | S DA=0 F S DA=$O(^PSDRUG(DA)) Q:'DA S X=$G(^PSDRUG(DA,0)) I X]"" S NA=$P(X,"^"),CLA=$P(X,"^",2),INV=$P(X,"^",3)["I",X=$G(^("ND")),IN=$P($G(^("I"),9999999),"^"),INA=IN'>DT,GE=+X,PR=+$P(X,"^",3),CMOP=$P(X,"^",10),VAPN=$P(X,"^",2) I GE I PR D
|
---|
| 79 | .S VAIN=$P($G(^PSNDF(50.68,PR,7)),"^",3)
|
---|
| 80 | .I $D(@ROOT1@(GE))!$D(@ROOT2@(PR))!VAIN S X="" S:CMOP]"" X=" (CMOP "_CMOP_")" S $E(X,30)=VAPN,$E(X,65)=$$FMTE^XLFDT(VAIN,5),INDX=$S(INA:"I",INV:"X",1:"A") S:IN=9999999 IN="" S ^TMP($J,INDX,NA_"^"_DA_"^"_IN,1)=X,^TMP($J,"^",DA)="" D
|
---|
| 81 | ..S DIE="^PSDRUG(",DR="20////@;21////@;22////@;23////@;24////@;27////@;29////@;" D ^DIE K DIE,DR
|
---|
| 82 | ..I PSN I $P($G(^PSDRUG(DA,"DOS")),"^")]""!$O(^("DOS1",0))!$O(^PSDRUG(DA,"DOS2",0)) D LOAD K ^PSDRUG(DA,"DOS"),^("DOS1"),^("DOS2")
|
---|
| 83 | ..I $P($G(^PSDRUG(DA,3)),"^") S DIE=50,DR="213////0;" D ^DIE K DIE,DR I PSN1 S IND=$O(^PSDRUG(DA,4," "),-1),$P(^(IND,0),"^",6)="NDF Update"
|
---|
| 84 | .I PSN,$D(@ROOT3@(PR)) K ^PSDRUG(DA,"DOS"),^("DOS1"),^("DOS2")
|
---|
| 85 | .S ND=$G(^PSDRUG(DA,"ND")),PR=$P(ND,"^",3) I PR D
|
---|
| 86 | ..S NFI=$P($G(^PSNDF(50.68,PR,5)),"^") I $P(ND,"^",11)'=NFI S DIE=50,DR="29////"_NFI_";" D ^DIE
|
---|
| 87 | ..S VAC=$P($G(^PSNDF(50.68,PR,3)),"^") I VAC S VAC=$P(^PS(50.605,VAC,0),"^"),DIE=50,DR="2////"_VAC_";" D ^DIE
|
---|
| 88 | ..I $P($G(^PSDRUG(DA,3)),"^"),'$P($G(^PSNDF(50.68,PR,1)),"^",3) S DIE=50,DR="213////0;" D ^DIE K DIE,DR S IND=$O(^PSDRUG(DA,4," "),-1),$P(^(IND,0),"^",6)="NDF Update"
|
---|
| 89 | ;
|
---|
| 90 | K ^TMP("PSN",$J) S LINE=1 F INDX="A","X","I" D LOAD1
|
---|
| 91 | S XMDUZ="NDF MANAGER",XMSUB="DRUGS UNMATCHED FROM NATIONAL DRUG FILE",XMTEXT="^TMP(""PSN"",$J,"
|
---|
| 92 | K XMY S X=$G(@XPDGREF@("GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
|
---|
| 93 | S DA=0 F S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA S XMY(DA)=""
|
---|
| 94 | I $D(DUZ) S XMY(DUZ)=""
|
---|
| 95 | N DIFROM D ^XMD I $D(XMZ) S DA=XMZ,DIE=3.9,DR="1.7///P;" D ^DIE
|
---|
| 96 | ;package specific post install
|
---|
| 97 | I $D(@XPDGREF@("POST")) S POST=^("POST") S:POST'["^" POST="^"_POST I @("$T("_POST_")]]""""") D @POST
|
---|
| 98 | ;
|
---|
| 99 | ;call to HL7 drug update message
|
---|
| 100 | I $T(PSN^PSSHUIDG)]"" I $O(^TMP($J,"^",0)) S ZTRTN="PSN^PSSHUIDG",ZTIO="",ZTDTH=$H,ZTDESC="DRUG UPDATE MESSAGE",ZTSAVE("^TMP($J,""^"",")="" D ^%ZTLOAD
|
---|
| 101 | ;
|
---|
| 102 | REINDEX ;Make sure APC xref is correct
|
---|
| 103 | I $T(EN2^GMRAUIX0)']"" G MORE
|
---|
| 104 | N SUB,DA,DIK,GMRAIEN,CLASS
|
---|
| 105 | S SUB=0 F S SUB=$O(^GMR(120.8,SUB)) Q:'+SUB I $D(^GMR(120.8,SUB,3)) D
|
---|
| 106 | .S GMRAIEN=+$P($G(^GMR(120.8,SUB,0)),U) Q:'GMRAIEN
|
---|
| 107 | .S CLASS="" F S CLASS=$O(^GMR(120.8,"APC",GMRAIEN,CLASS)) Q:CLASS="" K ^GMR(120.8,"APC",GMRAIEN,CLASS,SUB)
|
---|
| 108 | .S DA(1)=SUB
|
---|
| 109 | .S DIK="^GMR(120.8,DA(1),3,"
|
---|
| 110 | .S DIK(1)=".01^ADRG3"
|
---|
| 111 | .D ENALL^DIK ;Reset the drug class xref
|
---|
| 112 | ;
|
---|
| 113 | MORE ;REINDEXING
|
---|
| 114 | ;now the APD
|
---|
| 115 | K ^PS(50.416,"APD") S DA=0 F S DA=$O(^PS(50.416,DA)),K=0 Q:'DA F S K=$O(^PS(50.416,DA,1,K)) Q:'K S X=^(K,0),^PS(50.416,"APD",X,DA)=""
|
---|
| 116 | ;now the interactions
|
---|
| 117 | K ^PS(56,"APD") S DA=0 F S DA=$O(^PS(56,DA)) Q:'DA K PSN1,PSN2 S PSN1=$P(^(DA,0),"^",2),PSN2=$P(^(0),"^",3) D
|
---|
| 118 | .S NA="" F S NA=$O(^PS(50.416,PSN1,1,"B",NA)) Q:NA="" S PSN1(NA)=""
|
---|
| 119 | .S PSN11=0 F S PSN11=$O(^PS(50.416,"APS",PSN1,PSN11)),NA="" Q:'PSN11 F S NA=$O(^PS(50.416,PSN11,1,"B",NA)) Q:NA="" S PSN1(NA)=""
|
---|
| 120 | .S NA="" F S NA=$O(^PS(50.416,PSN2,1,"B",NA)) Q:NA="" S PSN2(NA)=""
|
---|
| 121 | .S PSN21=0 F S PSN21=$O(^PS(50.416,"APS",PSN2,PSN21)),NA="" Q:'PSN21 F S NA=$O(^PS(50.416,PSN21,1,"B",NA)) Q:NA="" S PSN2(NA)=""
|
---|
| 122 | .S PSN1="" F S PSN1=$O(PSN1(PSN1)),PSN2="" Q:PSN1="" F S PSN2=$O(PSN2(PSN2)) Q:PSN2="" S ^PS(56,"APD",PSN1,PSN2,DA)="",^PS(56,"APD",PSN2,PSN1,DA)=""
|
---|
| 123 | ;
|
---|
| 124 | D ^PSNCLEAN
|
---|
| 125 | ;
|
---|
| 126 | QUIT K CL,CLA,CMOP,CT,DA,DA1,DIA,DIC,DIE,DIK,DINUM,DR,FDA,FILE,FLDS,GE,GROOT,GROOT1,IENS,IN,INA,IND,INDX,INV,J,JJ,K,LI,LINE,NA,NAME,ND,NEW,NFI,POST,PR,PSN,PSN1,PSN11,PSN21,PSNDF,R1,ROOT,ROOT1,ROOT2,ROOT3,SUBS,VAC,VAIN,VAPN
|
---|
| 127 | K X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XUMF,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
|
---|
| 128 | K ^TMP($J),^TMP("PSN",$J),^TMP("PSNN",$J)
|
---|
| 129 | Q
|
---|
| 130 | ;
|
---|
| 131 | LOAD ;GET DOSE STUFF
|
---|
| 132 | S J=2,X=$G(^PSDRUG(DA,"DOS")) I $P(X,"^"),$D(^PS(50.607,+$P(X,"^",2),0)) S ^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" STRENGTH: "_+X_"UNITS: "_$P(^PS(50.607,+$P(X,"^",2),0),"^"),J=J+1
|
---|
| 133 | I $O(^PSDRUG(DA,"DOS1",0)) S ^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" POSSIBLE DOSES",^(J+1)=" DISP UNITS/DOSE DOSE PACKAGE BCMA UNITS/DOSE",DA1=0,J=J+2 D
|
---|
| 134 | .F S DA1=$O(^PSDRUG(DA,"DOS1",DA1)) Q:'DA1 S X=^(DA1,0),^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" "_$J($P(X,"^"),4),$E(^(J),25)=$J($P(X,"^",2),4),$E(^(J),35)=$P(X,"^",3),$E(^(J),43)=$P(X,"^",4),J=J+1
|
---|
| 135 | I $O(^PSDRUG(DA,"DOS2",0)) S ^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" LOCAL POSSIBLE DOSES",^(J+1)=" DOSE PACKAGE BCMA UNITS/DOSE",DA1=0,J=J+2 D
|
---|
| 136 | .F S DA1=$O(^PSDRUG(DA,"DOS2",DA1)) Q:'DA1 S X=^(DA1,0),^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" "_$P(X,"^"),$E(^(J),55)=$P(X,"^",2),$E(^(J),71)=$P(X,"^",3),J=J+1
|
---|
| 137 | Q
|
---|
| 138 | ;
|
---|
| 139 | LOAD1 ;BUILD THE MESSAGE
|
---|
| 140 | S ^TMP("PSN",$J,LINE,0)=" ",LINE=LINE+1
|
---|
| 141 | S ^TMP("PSN",$J,LINE,0)="The following "_$S(INDX="A":"active",INDX="X":"investigational",1:"inactive")_" entries in your DRUG file (#50) have been",LINE=LINE+1
|
---|
| 142 | S J=0 F S J=$O(@XPDGREF@("TEXT",J)) Q:'J S ^TMP("PSN",$J,LINE,0)=@XPDGREF@("TEXT",J),LINE=LINE+1
|
---|
| 143 | ;I INDX'="I" S LINE=LINE-1,^(0)=$P(^TMP("PSN",$J,LINE-2,0),"IN"),^TMP("PSN",$J,LINE-1,0)=" "
|
---|
| 144 | S NA="" I $O(^TMP($J,INDX,NA))="" S ^TMP("PSN",$J,LINE,0)=" NONE",LINE=LINE+1 Q
|
---|
| 145 | F S NA=$O(^TMP($J,INDX,NA)) Q:NA="" S X=^(NA,1),^TMP("PSN",$J,LINE,0)=$P(NA,"^"),$E(^(0),55)=$P(NA,"^",2) S:INDX="I" $E(^(0),62)=$$FMTE^XLFDT($P(NA,"^",3),5) S LINE=LINE+1,^TMP("PSN",$J,LINE,0)=$P(X,"^"),LINE=LINE+1 S J=1 D
|
---|
| 146 | .F S J=$O(^TMP($J,INDX,NA,J)) Q:'J S ^TMP("PSN",$J,LINE,0)=^(J),LINE=LINE+1
|
---|
| 147 | Q
|
---|