PSNDATA ;BIR/DMA-post install routine to load data ;31 Aug 99 / 11:32 AM
;;4.0; NATIONAL DRUG FILE;**1,6,8,9,10,12,14,15,17,18,21,23,24,25,28,31,34**; 30 Oct 98
; Reference to ^PSDRUG supported by DBIA #2352
; Reference to ^PSDRUG supported by DBIA #3077
N CT,DA,DIA,DIC,DIE,DIK,DR,FILE,FLDS,GROOT,GROOT1,IENS,J,JJ,K,NAME,NEW,POST,R1,ROOT,ROOT1,ROOT2,ROOT3,SUBS,X,XMDUZ,XMSUB,XMTEXT,XMY
;
S PSNDF=1
;TO ALLOW ADDS TO 56
;MORE ELEGANT CHANGE LATER
;
S X=$P($T(+2),"**",2),X=$P(X,",",$L(X,",")) I X I $$PATCH^XPDUTL("PSN*4.0*"_X) D BMES^XPDUTL("This patch has already been installed") S XPDQUIT=2 Q
S FILE=0,GROOT=$NA(@XPDGREF@("DATANT"))
;load new entries first
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
.S DA=+DIA K FDA,IENS
.I $$GET1^DIQ(FILE,DA,.01)]"" S FDA(FILE,DA_",",.01)=NEW D FILE^DIE("","FDA") Q
.S DINUM=DA,X=NEW,DIC=ROOT,DIC(0)="L",DLAYGO=FILE,DIC("DR")="S Y=0" K DD,DO D FILE^DICN
;
S FILE=0,GROOT=$NA(@XPDGREF@("DATAN"))
;load new multiple entries next
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
.S IENS=$P(DIA,"^")_",",FLDS=$P(DIA,"^",3),ROOT=FILE K FDA,IEN
.I FLDS["," D
..;it should, but
..S LI=$P(DIA,"^",3) F J=1:1:$L(LI,",")-1 S ROOT=+$P(^DD(ROOT,+$P(LI,",",J),0),"^",2)
..S LI=$P(DIA,"^"),IENS="" F J=$L(LI,","):-1:1 S IENS=IENS_$P(LI,",",J)_","
..S DA=+IENS
.;I $$GET1^DIQ(ROOT,IENS,.01)]"" S FDA(ROOT,IENS,.01)=NEW D FILE^DIE("","FDA") Q
.S FDA(ROOT,"+"_IENS,.01)=NEW,IEN(DA)=DA D UPDATE^DIE("","FDA","IEN")
;
S FILE=0,GROOT=$NA(@XPDGREF@("DATAO"))
;now load the rest of the data
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
.S IENS=$P(DIA,"^")_",",FLDS=$P(DIA,"^",3),ROOT=FILE K FDA,IEN
.I FLDS["," D
..S LI=$P(DIA,"^",3) F J=1:1:$L(LI,",")-1 S ROOT=+$P(^DD(ROOT,+$P(LI,",",J),0),"^",2)
..S LI=$P(DIA,"^"),IENS="" F J=$L(LI,","):-1:1 S IENS=IENS_$P(LI,",",J)_","
..S FLDS=$E(FLDS,",",$L(FLDS))
.S FDA(ROOT,IENS,FLDS)=NEW D FILE^DIE("","FDA")
;
;
WORD S ROOT1=$NA(@XPDGREF@("WORD")),CT=0,ROOT2=$NA(@ROOT1@(0))
F S CT=$O(@ROOT2) Q:'CT S ROOT2=$NA(@ROOT1@(CT)),NAME=@ROOT2,ROOT3=$NA(@ROOT2@("D")) K @NAME M @NAME=@ROOT3
;
;
MESSAGE K ^TMP($J) M ^TMP($J)=@XPDGREF@("MESSAGE") K ^TMP($J,0)
;
GROUP K XMY S X=$G(@XPDGREF@("GROUP")),XMY("G."_X_"@"_^XMB("NETNAME"))=""
S DA=0 F S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA S XMY(DA)=""
I $D(DUZ) S XMY(DUZ)=""
;
S XMSUB="DATA UPDATE FOR NDF"
S XMDUZ="NDF MANAGER"
S XMTEXT="^TMP($J," N DIFROM D ^XMD
;
;NOW UPDATE LOCAL DRUG FILE
K ^TMP($J)
S PSN=$$PATCH^XPDUTL("PSS*1.0*34")
S ROOT1=$NA(@XPDGREF@("GENERIC")),ROOT2=$NA(@XPDGREF@("PRODUCT")),ROOT3=$NA(@XPDGREF@("POE")),DA=0
F S DA=$O(^PSDRUG(DA)) Q:'DA S X=$G(^(DA,"ND")),GE=+X,PR=+$P(X,"^",3) D
.I $D(@ROOT1@(GE))!$D(@ROOT2@(PR)) S $P(^PSDRUG(DA,"ND"),"^",1,5)="^^^^",X=$P(^("ND"),"^",10),$P(^("ND"),"^",10)="",^TMP($J,$P(^(0),"^"))="" I X]"" K ^PSDRUG("AQ1",X,DA)
.I PSN,$D(@ROOT3@(PR)) K ^PSDRUG(DA,"DOS"),^("DOS1"),^("DOS2")
I $D(^TMP($J)) S DA="",LINE=0 K ^TMP("PSN",$J) D
.F J=1:1 S X=$P($T(TEXT+J),";",3,30) Q:X="" S LINE=LINE+1,^TMP("PSN",$J,LINE,0)=X
.F S DA=$O(^TMP($J,DA)) Q:DA="" S LINE=LINE+1,^TMP("PSN",$J,LINE,0)=DA
.S XMDUZ="NDF MANAGER",XMSUB="DRUGS UNMATCHED FROM NATIONAL DRUG FILE",XMTEXT="^TMP(""PSN"",$J,"
.K XMY S X=$G(@XPDGREF@("GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
.S DA=0 F S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA S XMY(DA)=""
.I $D(DUZ) S XMY(DUZ)=""
.N DIFROM D ^XMD I $D(XMZ) S DA=XMZ,DIE=3.9,DR="1.7///P;" D ^DIE
;package specific post install
I $D(@XPDGREF@("POST")) S POST=^("POST") S:POST'["^" POST="^"_POST I @("$T("_POST_")]]""""") D @POST
;
QUIT K CT,DA,DIA,DIC,DIE,DIK,DINUM,DLAYGO,DR,FILE,FLDS,GE,GROOT,GROOT1,IENS,J,JJ,K,LI,LINE,NAME,NEW,POST,PR,PSN,PSNDF,R1,ROOT,ROOT1,ROOT2,ROOT3,SUBS,X,XMDUZ,XMSUB,XMTEXT,XMY,^TMP($J),^TMP("PSN",$J)
Q
;
TEXT ;
;;The following entries in your local drug file have been unmatched
;;from the national drug file. Until you rematch these entries to
;;NDF, they will not transmit to CMOP, drug-drug interaction checks
;;will not check for these products, and class-class checks will not
;;look at these products. It is critical that you rematch these
;;products immediately. You may also need to rematch your orderable
;;item.
;;
PSNDATA ;BIR/DMA-post install routine to load data ;31 Aug 99 / 11:32 AM
+1 ;;4.0; NATIONAL DRUG FILE;**1,6,8,9,10,12,14,15,17,18,21,23,24,25,28,31,34**; 30 Oct 98
+2 ; Reference to ^PSDRUG supported by DBIA #2352
+3 ; Reference to ^PSDRUG supported by DBIA #3077
+4 NEW CT,DA,DIA,DIC,DIE,DIK,DR,FILE,FLDS,GROOT,GROOT1,IENS,J,JJ,K,NAME,NEW,POST,R1,ROOT,ROOT1,ROOT2,ROOT3,SUBS,X,XMDUZ,XMSUB,XMTEXT,XMY
+5 ;
+6 SET PSNDF=1
+7 ;TO ALLOW ADDS TO 56
+8 ;MORE ELEGANT CHANGE LATER
+9 ;
+10 SET X=$PIECE($TEXT(+2),"**",2)
SET X=$PIECE(X,",",$LENGTH(X,","))
IF X
IF $$PATCH^XPDUTL("PSN*4.0*"_X)
DO BMES^XPDUTL("This patch has already been installed")
SET XPDQUIT=2
QUIT
+11 SET FILE=0
SET GROOT=$NAME(@XPDGREF@("DATANT"))
+12 ;load new entries first
+13 FOR
SET FILE=$ORDER(@GROOT@(FILE))
IF 'FILE
QUIT
SET ROOT=$$ROOT^DILFD(FILE)
IF ROOT]""
SET GROOT1=$NAME(@GROOT@(FILE))
FOR JJ=1:2
IF '$DATA(@GROOT1@(JJ))
QUIT
SET DIA=@GROOT1@(JJ)
SET NEW=@GROOT1@(JJ+1)
Begin DoDot:1
+14 SET DA=+DIA
KILL FDA,IENS
+15 IF $$GET1^DIQ(FILE,DA,.01)]""
SET FDA(FILE,DA_",",.01)=NEW
DO FILE^DIE("","FDA")
QUIT
+16 SET DINUM=DA
SET X=NEW
SET DIC=ROOT
SET DIC(0)="L"
SET DLAYGO=FILE
SET DIC("DR")="S Y=0"
KILL DD,DO
DO FILE^DICN
End DoDot:1
+17 ;
+18 SET FILE=0
SET GROOT=$NAME(@XPDGREF@("DATAN"))
+19 ;load new multiple entries next
+20 FOR
SET FILE=$ORDER(@GROOT@(FILE))
IF 'FILE
QUIT
SET ROOT=$$ROOT^DILFD(FILE)
IF ROOT]""
SET GROOT1=$NAME(@GROOT@(FILE))
FOR JJ=1:2
IF '$DATA(@GROOT1@(JJ))
QUIT
SET DIA=@GROOT1@(JJ)
SET NEW=@GROOT1@(JJ+1)
Begin DoDot:1
+21 SET IENS=$PIECE(DIA,"^")_","
SET FLDS=$PIECE(DIA,"^",3)
SET ROOT=FILE
KILL FDA,IEN
+22 IF FLDS[","
Begin DoDot:2
+23 ;it should, but
+24 SET LI=$PIECE(DIA,"^",3)
FOR J=1:1:$LENGTH(LI,",")-1
SET ROOT=+$PIECE(^DD(ROOT,+$PIECE(LI,",",J),0),"^",2)
+25 SET LI=$PIECE(DIA,"^")
SET IENS=""
FOR J=$LENGTH(LI,","):-1:1
SET IENS=IENS_$PIECE(LI,",",J)_","
+26 SET DA=+IENS
End DoDot:2
+27 ;I $$GET1^DIQ(ROOT,IENS,.01)]"" S FDA(ROOT,IENS,.01)=NEW D FILE^DIE("","FDA") Q
+28 SET FDA(ROOT,"+"_IENS,.01)=NEW
SET IEN(DA)=DA
DO UPDATE^DIE("","FDA","IEN")
End DoDot:1
+29 ;
+30 SET FILE=0
SET GROOT=$NAME(@XPDGREF@("DATAO"))
+31 ;now load the rest of the data
+32 FOR
SET FILE=$ORDER(@GROOT@(FILE))
IF 'FILE
QUIT
SET ROOT=$$ROOT^DILFD(FILE)
IF ROOT]""
SET GROOT1=$NAME(@GROOT@(FILE))
FOR JJ=1:2
IF '$DATA(@GROOT1@(JJ))
QUIT
SET DIA=@GROOT1@(JJ)
SET NEW=@GROOT1@(JJ+1)
Begin DoDot:1
+33 SET IENS=$PIECE(DIA,"^")_","
SET FLDS=$PIECE(DIA,"^",3)
SET ROOT=FILE
KILL FDA,IEN
+34 IF FLDS[","
Begin DoDot:2
+35 SET LI=$PIECE(DIA,"^",3)
FOR J=1:1:$LENGTH(LI,",")-1
SET ROOT=+$PIECE(^DD(ROOT,+$PIECE(LI,",",J),0),"^",2)
+36 SET LI=$PIECE(DIA,"^")
SET IENS=""
FOR J=$LENGTH(LI,","):-1:1
SET IENS=IENS_$PIECE(LI,",",J)_","
+37 SET FLDS=$EXTRACT(FLDS,",",$LENGTH(FLDS))
End DoDot:2
+38 SET FDA(ROOT,IENS,FLDS)=NEW
DO FILE^DIE("","FDA")
End DoDot:1
+39 ;
+40 ;
WORD SET ROOT1=$NAME(@XPDGREF@("WORD"))
SET CT=0
SET ROOT2=$NAME(@ROOT1@(0))
+1 FOR
SET CT=$ORDER(@ROOT2)
IF 'CT
QUIT
SET ROOT2=$NAME(@ROOT1@(CT))
SET NAME=@ROOT2
SET ROOT3=$NAME(@ROOT2@("D"))
KILL @NAME
MERGE @NAME=@ROOT3
+2 ;
+3 ;
MESSAGE KILL ^TMP($JOB)
MERGE ^TMP($JOB)=@XPDGREF@("MESSAGE")
KILL ^TMP($JOB,0)
+1 ;
GROUP KILL XMY
SET X=$GET(@XPDGREF@("GROUP"))
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+1 SET DA=0
FOR
SET DA=$ORDER(^XUSEC("PSNMGR",DA))
IF 'DA
QUIT
SET XMY(DA)=""
+2 IF $DATA(DUZ)
SET XMY(DUZ)=""
+3 ;
+4 SET XMSUB="DATA UPDATE FOR NDF"
+5 SET XMDUZ="NDF MANAGER"
+6 SET XMTEXT="^TMP($J,"
NEW DIFROM
DO ^XMD
+7 ;
+8 ;NOW UPDATE LOCAL DRUG FILE
+9 KILL ^TMP($JOB)
+10 SET PSN=$$PATCH^XPDUTL("PSS*1.0*34")
+11 SET ROOT1=$NAME(@XPDGREF@("GENERIC"))
SET ROOT2=$NAME(@XPDGREF@("PRODUCT"))
SET ROOT3=$NAME(@XPDGREF@("POE"))
SET DA=0
+12 FOR
SET DA=$ORDER(^PSDRUG(DA))
IF 'DA
QUIT
SET X=$GET(^(DA,"ND"))
SET GE=+X
SET PR=+$PIECE(X,"^",3)
Begin DoDot:1
+13 IF $DATA(@ROOT1@(GE))!$DATA(@ROOT2@(PR))
SET $PIECE(^PSDRUG(DA,"ND"),"^",1,5)="^^^^"
SET X=$PIECE(^("ND"),"^",10)
SET $PIECE(^("ND"),"^",10)=""
SET ^TMP($JOB,$PIECE(^(0),"^"))=""
IF X]""
KILL ^PSDRUG("AQ1",X,DA)
+14 IF PSN
IF $DATA(@ROOT3@(PR))
KILL ^PSDRUG(DA,"DOS"),^("DOS1"),^("DOS2")
End DoDot:1
+15 IF $DATA(^TMP($JOB))
SET DA=""
SET LINE=0
KILL ^TMP("PSN",$JOB)
Begin DoDot:1
+16 FOR J=1:1
SET X=$PIECE($TEXT(TEXT+J),";",3,30)
IF X=""
QUIT
SET LINE=LINE+1
SET ^TMP("PSN",$JOB,LINE,0)=X
+17 FOR
SET DA=$ORDER(^TMP($JOB,DA))
IF DA=""
QUIT
SET LINE=LINE+1
SET ^TMP("PSN",$JOB,LINE,0)=DA
+18 SET XMDUZ="NDF MANAGER"
SET XMSUB="DRUGS UNMATCHED FROM NATIONAL DRUG FILE"
SET XMTEXT="^TMP(""PSN"",$J,"
+19 KILL XMY
SET X=$GET(@XPDGREF@("GROUP"))
IF X]""
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+20 SET DA=0
FOR
SET DA=$ORDER(^XUSEC("PSNMGR",DA))
IF 'DA
QUIT
SET XMY(DA)=""
+21 IF $DATA(DUZ)
SET XMY(DUZ)=""
+22 NEW DIFROM
DO ^XMD
IF $DATA(XMZ)
SET DA=XMZ
SET DIE=3.9
SET DR="1.7///P;"
DO ^DIE
End DoDot:1
+23 ;package specific post install
+24 IF $DATA(@XPDGREF@("POST"))
SET POST=^("POST")
IF POST'["^"
SET POST="^"_POST
IF @("$T("_POST_")]]""""")
DO @POST
+25 ;
QUIT KILL CT,DA,DIA,DIC,DIE,DIK,DINUM,DLAYGO,DR,FILE,FLDS,GE,GROOT,GROOT1,IENS,J,JJ,K,LI,LINE,NAME,NEW,POST,PR,PSN,PSNDF,R1,ROOT,ROOT1,ROOT2,ROOT3,SUBS,X,XMDUZ,XMSUB,XMTEXT,XMY,^TMP($JOB),^TMP("PSN",$JOB)
+1 QUIT
+2 ;
TEXT ;
+1 ;;The following entries in your local drug file have been unmatched
+2 ;;from the national drug file. Until you rematch these entries to
+3 ;;NDF, they will not transmit to CMOP, drug-drug interaction checks
+4 ;;will not check for these products, and class-class checks will not
+5 ;;look at these products. It is critical that you rematch these
+6 ;;products immediately. You may also need to rematch your orderable
+7 ;;item.
+8 ;;
