- 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 ;;
