BJPN10PS ;GDIT/HS/BEE-Prenatal Care Module 1.0 Post Install ; 08 May 2012 12:00 PM
;;1.0;PRENATAL CARE MODULE;;Dec 06, 2012;Build 61
;
Q
;
PST ;
;
NEW BI,TEXT,PIEN,DIC,X,Y,DIK,IEN
;
;Resolve file 80 descrepancies between sites
S IEN=0 F S IEN=$O(^BJPN(90680.02,IEN)) Q:'IEN D
. NEW MPIEN
. S MPIEN=0 F S MPIEN=$O(^BJPN(90680.02,IEN,1,MPIEN)) Q:'MPIEN D
.. NEW DA,IENS,XCD,BUPD,DIC,X,Y
.. S DA(1)=IEN,DA=MPIEN,IENS=$$IENS^DILF(.DA)
.. S XCD=$$GET1^DIQ(90680.21,IENS,.03,"E")
.. Q:XCD=""
.. ;
.. ;ICD Code
.. ;
.. ;First look for passed in value
.. S X=XCD,DIC="^ICD9(",DIC(0)="XM"
.. D ^DIC
.. ;
.. ;If no match, look for + of value
.. I +Y="-1" D
... S X=+XCD,DIC="^ICD9(",DIC(0)="XM"
... D ^DIC
.. ;
.. ;If no match look in "BA" index - Exact match
.. I +Y="-1" D
... NEW IEN
... S IEN="" F S IEN=$O(^ICD9("BA",XCD,IEN)) Q:'IEN D I Y>0 Q
... I $$GET1^DIQ(80,IEN_",",".01","I")'=XCD S Y="-1" Q
... S Y=IEN
.. ;
.. ;If no match look in "BA" index - + subscript, exact match
.. I +Y="-1" D
... NEW IEN,CD
... S IEN="" F S IEN=$O(^ICD9("BA",+XCD,IEN)) Q:'IEN D I Y>0 Q
.... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
.... I CD=XCD S Y=IEN
.... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
.... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
.. ;
.. ;If no match look in "BA" index - + subscript, + match
.. I +Y="-1" D
... NEW IEN,CD
... S IEN="" F S IEN=$O(^ICD9("BA",+XCD,IEN)) Q:'IEN D I Y>0 Q
.... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
.... I CD=+XCD S Y=IEN
.... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
.... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
.. ;
.. ;If no match look in "BA" index - subscript and " ", exact match
.. I +Y="-1" D
... NEW IEN
... S IEN="" F S IEN=$O(^ICD9("BA",XCD_" ",IEN)) Q:'IEN D I Y>0 Q
.... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
.... I CD=XCD S Y=IEN
.... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
.... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
.. ;
.. ;If no match look in "BA" index - + subscript and " ", exact match
.. I +Y="-1" D
... NEW IEN
... S IEN="" F S IEN=$O(^ICD9("BA",XCD_" ",IEN)) Q:'IEN D I Y>0 Q
.... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
.... I CD=XCD S Y=IEN
.... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
.... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
.. ;
.. ;If no match look in "BA" index - + subscript and " ", any match
.. I +Y="-1" D
... NEW IEN
... S IEN="" F S IEN=$O(^ICD9("BA",+XCD_" ",IEN)) Q:'IEN D I Y>0 Q
.... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
.... I CD=+XCD S Y=IEN
.... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
.... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
.. I +Y="-1" Q
.. ;
.. ;Hard set entry
.. S $P(^BJPN(90680.02,IEN,1,MPIEN,0),U)=+Y
. ;
. ;Re-index that SNOMED Code ICD entry
. K DA S DA(1)=IEN
. K ^BJPN(90680.02,IEN,1,"B")
. S DIK="^BJPN(90680.02,"_DA(1)_",1,",DIK(1)=".01" D ENALL^DIK
;
;Perform conversion (if reload)
D CONV
;
;Re-index entries (in case of re-install)
K ^AUPNVOB("AA"),^AUPNVOB("AC"),^AUPNVOB("AE"),^AUPNVOB("AF")
S DIK="^AUPNVOB(",DIK(1)=".02" D ENALL^DIK
;
; UPDATE THE VUECENTRIC REGISTERED OBJECTS FILE
W !,"Registering the Vucentric Objects..."
F BI=1:1 S TEXT=$P($T(OBJ+BI),";",3,99) Q:($P(TEXT,";")="END") D
.W !,$P(TEXT,";")
. ;
. NEW DIC,X,Y,OBJUPD,ERROR,WP8,WP9,WP10
. ;
. ;PROGID (#.01)
. S DIC="^CIAVOBJ(19930.2,",DIC(0)="LOX",X=$P(TEXT,";")
. D ^DIC I +Y<0 Q
. S OIEN=+Y
. ;
. ;NAME (#1)
. S OBJUPD(19930.2,OIEN_",",1)=$P(TEXT,";",2)
. ;
. ;VERSION (#2)
. S OBJUPD(19930.2,OIEN_",",2)=$P(TEXT,";",3)
. ;
. ;SOURCE (#3)
. S OBJUPD(19930.2,OIEN_",",3)=$P(TEXT,";",4)
. ;
. ;SERIALIZABLE (#8)
. S WP8(1)=$P(TEXT,";",5)
. D WP^DIE(19930.2,OIEN_",",8,"","WP8")
. ;
. ;INITIALIZATION (#9)
. S WP9(1)=$P(TEXT,";",6)
. D WP^DIE(19930.2,OIEN_",",9,"","WP9")
. ;
. ;REQUIRED (#10)
. S WP10(1)=$P(TEXT,";",7)
. D WP^DIE(19930.2,OIEN_",",10,"","WP10")
. ;
. ;PROPEDIT (#11)
. S OBJUPD(19930.2,OIEN_",",11)=$P(TEXT,";",8)
. ;
. ;MULTIPLE (#12)
. S OBJUPD(19930.2,OIEN_",",12)=$P(TEXT,";",9)
. ;
. ;DISABLED (#13)
. S OBJUPD(19930.2,OIEN_",",13)=$P(TEXT,";",10)
. ;
. ;ALLKEYS (#14)
. S OBJUPD(19930.2,OIEN_",",14)=$P(TEXT,";",11)
. ;
. ;HIDDEN (#15)
. S OBJUPD(19930.2,OIEN_",",15)=$P(TEXT,";",12)
. ;
. ;SIDEBYSIDE (#16)
. S OBJUPD(19930.2,OIEN_",",16)=$P(TEXT,";",13)
. ;
. ;SERVICE (#17)
. S OBJUPD(19930.2,OIEN_",",17)=$P(TEXT,";",14)
. ;
. ;REGRESS (#18)
. S OBJUPD(19930.2,OIEN_",",18)=$P(TEXT,";",15)
. ;
. ;NOREGISTER (#19)
. S OBJUPD(19930.2,OIEN_",",19)=$P(TEXT,";",16)
. ;
. ;DOTNET (#22)
. S OBJUPD(19930.2,OIEN_",",22)=$P(TEXT,";",17)
. ;
. ;ALIAS (#23)
. S OBJUPD(19930.2,OIEN_",",23)=$P(TEXT,";",18)
. ;
. ;TECHNICAL DESCRIPTION (#98)
. S OBJUPD(19930.2,OIEN_",",98)=$P(TEXT,";",19)
. ;
. ;DESCRIPTION (#99)
. S OBJUPD(19930.2,OIEN_",",99)=$P(TEXT,";",20)
. ;
. ;CLSID (#.5)
. S OBJUPD(19930.2,OIEN_",",.5)=$P(TEXT,";",21)
. ;
. ;HEIGHT (#4)
. S OBJUPD(19930.2,OIEN_",",4)=$P(TEXT,";",22)
. ;
. ;WIDTH (#5)
. S OBJUPD(19930.2,OIEN_",",5)=$P(TEXT,";",23)
. ;
. ;Update entry
.D FILE^DIE("","OBJUPD","ERROR")
;
;Locate PIP entry
S DIC(0)="MU",X="IHS.PN.EHR.PRENATALPROBLEMLIST",DIC="^CIAVOBJ(19930.2,"
D ^DIC I +Y<0 G XPST
S PIEN=+Y
;
;Enter USER values for Problem List Entry
F BI=1:1 S TEXT=$P($T(PPUSE+BI),";",3,99) Q:($P(TEXT,";")="END") D
. ;
. NEW DIC,X,Y,DA,OIEN
. ;
. ;Locate IEN for this entry
. S DIC="^CIAVOBJ(19930.2,",X=$P(TEXT,";"),DIC(0)="OX"
. D ^DIC I +Y<0 W !!,"<MISSING VUECENTRIC OBJECT: ",X,">" Q
. S OIEN=+Y
. ;
. S DA(1)=PIEN,DIC="^CIAVOBJ(19930.2,"_DA(1)_",9,",DIC(0)="LOX",X=$P(TEXT,";")
. D ^DIC
;
;Locate Pick List entry
S DIC(0)="MU",X="IHS.PN.EHR.PRENATALPICKLIST",DIC="^CIAVOBJ(19930.2,"
D ^DIC I +Y<0 G XPST
S PIEN=+Y
;
;Enter USER values for Pick List Entry
F BI=1:1 S TEXT=$P($T(PKUSE+BI),";",3,99) Q:($P(TEXT,";")="END") D
. ;
. NEW DIC,X,Y,DA,OIEN
. ;
. ;Locate IEN for this entry
. S DIC="^CIAVOBJ(19930.2,",X=$P(TEXT,";"),DIC(0)="OX"
. D ^DIC I +Y<0 W !!,"<MISSING VUECENTRIC OBJECT: ",X,">" Q
. S OIEN=+Y
. ;
. S DA(1)=PIEN,DIC="^CIAVOBJ(19930.2,"_DA(1)_",9,",DIC(0)="LOX",X=$P(TEXT,";")
. D ^DIC
;
XPST Q
;
CONV ;Convert existing PIP/VOB entries to use new BJPN SNOMED TERMS entries
;
;Only convert if backup from pre-install is present
Q:'$D(^XTMP("BJPNSMD"))
;
NEW PIPIEN
;
S PIPIEN=0 F S PIPIEN=$O(^BJPNPL(PIPIEN)) Q:'PIPIEN D
. ;
. NEW OIEN,OSMD,BJPNUP,ERROR,NIEN,DFN,IEN,FND
. ;
. S OIEN=$$GET1^DIQ(90680.01,PIPIEN_",",.03,"I") Q:OIEN=""
. S OSMD=$P($G(^XTMP("BJPNSMD",90680.02,OIEN,0)),U,2) Q:OSMD=""
. S DFN=$$GET1^DIQ(90680.01,PIPIEN_",",.02,"I") Q:DFN=""
. ;
. ;Now look for match in new file
. S NIEN=$$FIND(OSMD)
. ;
. ;Look for deleted SNOMED terms - Remove if not in new set
. I NIEN="" D DEL(DFN,PIPIEN,"E") Q
. ;
. ;Found entry - file in existing structure
. S BJPNUP(90680.01,PIPIEN_",",.01)=NIEN
. S BJPNUP(90680.01,PIPIEN_",",.03)=NIEN
. D FILE^DIE("","BJPNUP","ERROR")
. ;
. ;Check for duplicates - old list had duplicates
. S FND=0,IEN="" F S IEN=$O(^BJPNPL("AC",DFN,NIEN,IEN)) Q:IEN="" D
.. ;
.. ;Skip Deletes
.. Q:($$GET1^DIQ(90680.01,IEN_",","2.01","I")]"")
.. S FND=FND+1
.. S FND(IEN)=""
. ;
. ;Delete any duplicates
. I FND>1 D
.. NEW IEN
.. S IEN=$O(FND(""),-1) Q:IEN=""
.. F S IEN=$O(FND(IEN),-1) Q:IEN="" D DEL(DFN,IEN,"D")
;
;Clear out backup entries
K ^XTMP("BJPNSMD")
Q
;
FIND(TERM) ;Find term in new file
I $G(TERM)="" Q ""
;
NEW SHTERM,IEN,FOUND
;
S SHTERM=$E(TERM,1,30),FOUND=""
S IEN="" F S IEN=$O(^BJPN(90680.02,"C",SHTERM,IEN)) Q:IEN="" D Q:FOUND
. I TERM'=$$GET1^DIQ(90680.02,IEN_",",.02,"I") Q
. S FOUND=IEN
;
Q FOUND
;
DEL(DFN,PIPIEN,DCODE) ;Delete entries that have been removed
;
;If code has been removed delete altogether
I DCODE="E" D
. NEW DA,DIK,TM,IEN
. ;
. ;Remove Prenatal Problem entry
. S DA=PIPIEN,DIK="^BJPNPL(" D ^DIK
. ;
. ;Remove V file entries
. S TM="" F S TM=$O(^AUPNVOB("AE",DFN,PIPIEN,TM)) Q:TM="" D
.. S IEN="" F S IEN=$O(^AUPNVOB("AE",DFN,PIPIEN,TM,IEN)) Q:IEN="" D
... S DA=IEN,DIK="^AUPNVOB(" D ^DIK
;
;If code is a duplicate, mark as deleted (duplicate)
I DCODE="D" D
. NEW VIEN,TM,IEN
. ;
. ;Find last VIEN used
. S (VIEN,TM)="" F S TM=$O(^AUPNVOB("AE",DFN,PIPIEN,TM),-1) Q:TM="" D Q:VIEN
.. S IEN="" F S IEN=$O(^AUPNVOB("AE",DFN,PIPIEN,TM,IEN),-1) Q:IEN="" D Q:VIEN
... S VIEN=$$GET1^DIQ(9000010.43,IEN_",",.03,"I")
. ;
. ;Mark entry as deleted
. I VIEN D DEL^BJPNPRUT("",VIEN,PIPIEN,DCODE,"")
;
Q
;
;;File 19930.2 Field listing
;;PROGID;VRSN;SRC;SER;INI;REQ;PROP;MULT;DIS;ALLK;HIDD;SBYS;SERV;REG;NORG;DOTN;ALIA;TDES;DES;CLSID;HEIGHT;WIDTH
;;.01;1;2;3;8;9;10;11;12;13;14;15;16;17;18;19;22;23;98;99.5;4;5
OBJ ;;
;;FILE:INFRAGISTICS2.EXCEL.V10.3.DLL;Excel.v10.3;10.3.20103.1000;Infragistics2.Excel.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.SHARED.V10.3.DLL;Shared.v10.3;10.3.20103.1000;Infragistics2.Shared.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.MISC.V10.3.DLL;Misc.v10.3;10.3.20103.1000;Infragistics2.Win.Misc.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.EXCELEXPORT.V10.3.DLL;ExcelExport.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinGrid.ExcelExport.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.V10.3.DLL;UltraWinGrid.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinGrid.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.ULTRAWINPRINTPREVIEWDIALOG.V10.3.DLL;UltraWinPrintPreviewDialog.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinPrintPreviewDialog.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.ULTRAWINSTATUSBAR.V10.3.DLL;UltraWinStatusBar.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinStatusBar.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.ULTRAWINTOOLBARS.V10.3.DLL;UltraWinToolbars.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinToolbars.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.V10.3.DLL;Win.v10.3;10.3.20103.1000;Infragistics2.Win.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTBAR.V10.3.DLL;UltraWinListBar.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinListBar.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTVIEW.V10.3.DLL;UltraWinListView.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinListView.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;FILE:RICHTEXTBOXPRINTCONTROL.DLL;Rich Text Box Print Control;1.0.0.0;RichTextBoxPrintControl.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
;;IHS.PN.EHR.PRENATALPICKLIST.PRENATALPICKLISTCOMPONENT;Prenatal Pick List;1.0.0.13;IHS.PN.EHR.PrenatalPickList.dll;;;IHS.PN.EHR.PrenatalPickList.chm;0;1;0;0;0;0;0;0;;1;;;;{0A2C8481-DB1A-4D80-A8E0-CEBF70E6F705};300;600
;;IHS.PN.EHR.PRENATALPROBLEMLIST.PIPCOMPONENT;Pregnancy Issues and Problems List;1.0.0.13;IHS.PN.EHR.PrenatalProblemList.dll;;;IHS.PN.EHR.PrenatalProblemList.chm;0;1;0;0;0;0;0;0;;1;;;;{B5416178-ECD8-4515-A700-2980BCAA6CAA};300;640
;;END;
;;
PPUSE ;;
;;FILE:INFRAGISTICS2.EXCEL.V10.3.DLL
;;FILE:INFRAGISTICS2.SHARED.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.MISC.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.EXCELEXPORT.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.ULTRAWINPRINTPREVIEWDIALOG.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.ULTRAWINSTATUSBAR.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.ULTRAWINTOOLBARS.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.V10.3.DLL
;;FILE:RICHTEXTBOXPRINTCONTROL.DLL
;;END;
;;
PKUSE ;;
;;FILE:INFRAGISTICS2.SHARED.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTBAR.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTVIEW.V10.3.DLL
;;FILE:INFRAGISTICS2.WIN.V10.3.DLL
;;END;
;;
BJPN10PS ;GDIT/HS/BEE-Prenatal Care Module 1.0 Post Install ; 08 May 2012 12:00 PM
+1 ;;1.0;PRENATAL CARE MODULE;;Dec 06, 2012;Build 61
+2 ;
+3 QUIT
+4 ;
PST ;
+1 ;
+2 NEW BI,TEXT,PIEN,DIC,X,Y,DIK,IEN
+3 ;
+4 ;Resolve file 80 descrepancies between sites
+5 SET IEN=0
FOR
SET IEN=$ORDER(^BJPN(90680.02,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 NEW MPIEN
+7 SET MPIEN=0
FOR
SET MPIEN=$ORDER(^BJPN(90680.02,IEN,1,MPIEN))
IF 'MPIEN
QUIT
Begin DoDot:2
+8 NEW DA,IENS,XCD,BUPD,DIC,X,Y
+9 SET DA(1)=IEN
SET DA=MPIEN
SET IENS=$$IENS^DILF(.DA)
+10 SET XCD=$$GET1^DIQ(90680.21,IENS,.03,"E")
+11 IF XCD=""
QUIT
+12 ;
+13 ;ICD Code
+14 ;
+15 ;First look for passed in value
+16 SET X=XCD
SET DIC="^ICD9("
SET DIC(0)="XM"
+17 DO ^DIC
+18 ;
+19 ;If no match, look for + of value
+20 IF +Y="-1"
Begin DoDot:3
+21 SET X=+XCD
SET DIC="^ICD9("
SET DIC(0)="XM"
+22 DO ^DIC
End DoDot:3
+23 ;
+24 ;If no match look in "BA" index - Exact match
+25 IF +Y="-1"
Begin DoDot:3
+26 NEW IEN
+27 SET IEN=""
FOR
SET IEN=$ORDER(^ICD9("BA",XCD,IEN))
IF 'IEN
QUIT
Begin DoDot:4
End DoDot:4
IF Y>0
QUIT
+28 IF $$GET1^DIQ(80,IEN_",",".01","I")'=XCD
SET Y="-1"
QUIT
+29 SET Y=IEN
End DoDot:3
+30 ;
+31 ;If no match look in "BA" index - + subscript, exact match
+32 IF +Y="-1"
Begin DoDot:3
+33 NEW IEN,CD
+34 SET IEN=""
FOR
SET IEN=$ORDER(^ICD9("BA",+XCD,IEN))
IF 'IEN
QUIT
Begin DoDot:4
+35 SET CD=$$GET1^DIQ(80,IEN_",",".01","I")
+36 IF CD=XCD
SET Y=IEN
+37 IF $EXTRACT(XCD,$LENGTH(XCD))="."
IF XCD=(CD_".")
SET Y=IEN
QUIT
+38 IF $EXTRACT(CD,$LENGTH(CD))="."
IF CD=(XCD_".")
SET Y=IEN
QUIT
End DoDot:4
IF Y>0
QUIT
End DoDot:3
+39 ;
+40 ;If no match look in "BA" index - + subscript, + match
+41 IF +Y="-1"
Begin DoDot:3
+42 NEW IEN,CD
+43 SET IEN=""
FOR
SET IEN=$ORDER(^ICD9("BA",+XCD,IEN))
IF 'IEN
QUIT
Begin DoDot:4
+44 SET CD=$$GET1^DIQ(80,IEN_",",".01","I")
+45 IF CD=+XCD
SET Y=IEN
+46 IF $EXTRACT(XCD,$LENGTH(XCD))="."
IF XCD=(CD_".")
SET Y=IEN
QUIT
+47 IF $EXTRACT(CD,$LENGTH(CD))="."
IF CD=(XCD_".")
SET Y=IEN
QUIT
End DoDot:4
IF Y>0
QUIT
End DoDot:3
+48 ;
+49 ;If no match look in "BA" index - subscript and " ", exact match
+50 IF +Y="-1"
Begin DoDot:3
+51 NEW IEN
+52 SET IEN=""
FOR
SET IEN=$ORDER(^ICD9("BA",XCD_" ",IEN))
IF 'IEN
QUIT
Begin DoDot:4
+53 SET CD=$$GET1^DIQ(80,IEN_",",".01","I")
+54 IF CD=XCD
SET Y=IEN
+55 IF $EXTRACT(XCD,$LENGTH(XCD))="."
IF XCD=(CD_".")
SET Y=IEN
QUIT
+56 IF $EXTRACT(CD,$LENGTH(CD))="."
IF CD=(XCD_".")
SET Y=IEN
QUIT
End DoDot:4
IF Y>0
QUIT
End DoDot:3
+57 ;
+58 ;If no match look in "BA" index - + subscript and " ", exact match
+59 IF +Y="-1"
Begin DoDot:3
+60 NEW IEN
+61 SET IEN=""
FOR
SET IEN=$ORDER(^ICD9("BA",XCD_" ",IEN))
IF 'IEN
QUIT
Begin DoDot:4
+62 SET CD=$$GET1^DIQ(80,IEN_",",".01","I")
+63 IF CD=XCD
SET Y=IEN
+64 IF $EXTRACT(XCD,$LENGTH(XCD))="."
IF XCD=(CD_".")
SET Y=IEN
QUIT
+65 IF $EXTRACT(CD,$LENGTH(CD))="."
IF CD=(XCD_".")
SET Y=IEN
QUIT
End DoDot:4
IF Y>0
QUIT
End DoDot:3
+66 ;
+67 ;If no match look in "BA" index - + subscript and " ", any match
+68 IF +Y="-1"
Begin DoDot:3
+69 NEW IEN
+70 SET IEN=""
FOR
SET IEN=$ORDER(^ICD9("BA",+XCD_" ",IEN))
IF 'IEN
QUIT
Begin DoDot:4
+71 SET CD=$$GET1^DIQ(80,IEN_",",".01","I")
+72 IF CD=+XCD
SET Y=IEN
+73 IF $EXTRACT(XCD,$LENGTH(XCD))="."
IF XCD=(CD_".")
SET Y=IEN
QUIT
+74 IF $EXTRACT(CD,$LENGTH(CD))="."
IF CD=(XCD_".")
SET Y=IEN
QUIT
End DoDot:4
IF Y>0
QUIT
End DoDot:3
+75 IF +Y="-1"
QUIT
+76 ;
+77 ;Hard set entry
+78 SET $PIECE(^BJPN(90680.02,IEN,1,MPIEN,0),U)=+Y
End DoDot:2
+79 ;
+80 ;Re-index that SNOMED Code ICD entry
+81 KILL DA
SET DA(1)=IEN
+82 KILL ^BJPN(90680.02,IEN,1,"B")
+83 SET DIK="^BJPN(90680.02,"_DA(1)_",1,"
SET DIK(1)=".01"
DO ENALL^DIK
End DoDot:1
+84 ;
+85 ;Perform conversion (if reload)
+86 DO CONV
+87 ;
+88 ;Re-index entries (in case of re-install)
+89 KILL ^AUPNVOB("AA"),^AUPNVOB("AC"),^AUPNVOB("AE"),^AUPNVOB("AF")
+90 SET DIK="^AUPNVOB("
SET DIK(1)=".02"
DO ENALL^DIK
+91 ;
+92 ; UPDATE THE VUECENTRIC REGISTERED OBJECTS FILE
+93 WRITE !,"Registering the Vucentric Objects..."
+94 FOR BI=1:1
SET TEXT=$PIECE($TEXT(OBJ+BI),";",3,99)
IF ($PIECE(TEXT,";")="END")
QUIT
Begin DoDot:1
+95 WRITE !,$PIECE(TEXT,";")
+96 ;
+97 NEW DIC,X,Y,OBJUPD,ERROR,WP8,WP9,WP10
+98 ;
+99 ;PROGID (#.01)
+100 SET DIC="^CIAVOBJ(19930.2,"
SET DIC(0)="LOX"
SET X=$PIECE(TEXT,";")
+101 DO ^DIC
IF +Y<0
QUIT
+102 SET OIEN=+Y
+103 ;
+104 ;NAME (#1)
+105 SET OBJUPD(19930.2,OIEN_",",1)=$PIECE(TEXT,";",2)
+106 ;
+107 ;VERSION (#2)
+108 SET OBJUPD(19930.2,OIEN_",",2)=$PIECE(TEXT,";",3)
+109 ;
+110 ;SOURCE (#3)
+111 SET OBJUPD(19930.2,OIEN_",",3)=$PIECE(TEXT,";",4)
+112 ;
+113 ;SERIALIZABLE (#8)
+114 SET WP8(1)=$PIECE(TEXT,";",5)
+115 DO WP^DIE(19930.2,OIEN_",",8,"","WP8")
+116 ;
+117 ;INITIALIZATION (#9)
+118 SET WP9(1)=$PIECE(TEXT,";",6)
+119 DO WP^DIE(19930.2,OIEN_",",9,"","WP9")
+120 ;
+121 ;REQUIRED (#10)
+122 SET WP10(1)=$PIECE(TEXT,";",7)
+123 DO WP^DIE(19930.2,OIEN_",",10,"","WP10")
+124 ;
+125 ;PROPEDIT (#11)
+126 SET OBJUPD(19930.2,OIEN_",",11)=$PIECE(TEXT,";",8)
+127 ;
+128 ;MULTIPLE (#12)
+129 SET OBJUPD(19930.2,OIEN_",",12)=$PIECE(TEXT,";",9)
+130 ;
+131 ;DISABLED (#13)
+132 SET OBJUPD(19930.2,OIEN_",",13)=$PIECE(TEXT,";",10)
+133 ;
+134 ;ALLKEYS (#14)
+135 SET OBJUPD(19930.2,OIEN_",",14)=$PIECE(TEXT,";",11)
+136 ;
+137 ;HIDDEN (#15)
+138 SET OBJUPD(19930.2,OIEN_",",15)=$PIECE(TEXT,";",12)
+139 ;
+140 ;SIDEBYSIDE (#16)
+141 SET OBJUPD(19930.2,OIEN_",",16)=$PIECE(TEXT,";",13)
+142 ;
+143 ;SERVICE (#17)
+144 SET OBJUPD(19930.2,OIEN_",",17)=$PIECE(TEXT,";",14)
+145 ;
+146 ;REGRESS (#18)
+147 SET OBJUPD(19930.2,OIEN_",",18)=$PIECE(TEXT,";",15)
+148 ;
+149 ;NOREGISTER (#19)
+150 SET OBJUPD(19930.2,OIEN_",",19)=$PIECE(TEXT,";",16)
+151 ;
+152 ;DOTNET (#22)
+153 SET OBJUPD(19930.2,OIEN_",",22)=$PIECE(TEXT,";",17)
+154 ;
+155 ;ALIAS (#23)
+156 SET OBJUPD(19930.2,OIEN_",",23)=$PIECE(TEXT,";",18)
+157 ;
+158 ;TECHNICAL DESCRIPTION (#98)
+159 SET OBJUPD(19930.2,OIEN_",",98)=$PIECE(TEXT,";",19)
+160 ;
+161 ;DESCRIPTION (#99)
+162 SET OBJUPD(19930.2,OIEN_",",99)=$PIECE(TEXT,";",20)
+163 ;
+164 ;CLSID (#.5)
+165 SET OBJUPD(19930.2,OIEN_",",.5)=$PIECE(TEXT,";",21)
+166 ;
+167 ;HEIGHT (#4)
+168 SET OBJUPD(19930.2,OIEN_",",4)=$PIECE(TEXT,";",22)
+169 ;
+170 ;WIDTH (#5)
+171 SET OBJUPD(19930.2,OIEN_",",5)=$PIECE(TEXT,";",23)
+172 ;
+173 ;Update entry
+174 DO FILE^DIE("","OBJUPD","ERROR")
End DoDot:1
+175 ;
+176 ;Locate PIP entry
+177 SET DIC(0)="MU"
SET X="IHS.PN.EHR.PRENATALPROBLEMLIST"
SET DIC="^CIAVOBJ(19930.2,"
+178 DO ^DIC
IF +Y<0
GOTO XPST
+179 SET PIEN=+Y
+180 ;
+181 ;Enter USER values for Problem List Entry
+182 FOR BI=1:1
SET TEXT=$PIECE($TEXT(PPUSE+BI),";",3,99)
IF ($PIECE(TEXT,";")="END")
QUIT
Begin DoDot:1
+183 ;
+184 NEW DIC,X,Y,DA,OIEN
+185 ;
+186 ;Locate IEN for this entry
+187 SET DIC="^CIAVOBJ(19930.2,"
SET X=$PIECE(TEXT,";")
SET DIC(0)="OX"
+188 DO ^DIC
IF +Y<0
WRITE !!,"<MISSING VUECENTRIC OBJECT: ",X,">"
QUIT
+189 SET OIEN=+Y
+190 ;
+191 SET DA(1)=PIEN
SET DIC="^CIAVOBJ(19930.2,"_DA(1)_",9,"
SET DIC(0)="LOX"
SET X=$PIECE(TEXT,";")
+192 DO ^DIC
End DoDot:1
+193 ;
+194 ;Locate Pick List entry
+195 SET DIC(0)="MU"
SET X="IHS.PN.EHR.PRENATALPICKLIST"
SET DIC="^CIAVOBJ(19930.2,"
+196 DO ^DIC
IF +Y<0
GOTO XPST
+197 SET PIEN=+Y
+198 ;
+199 ;Enter USER values for Pick List Entry
+200 FOR BI=1:1
SET TEXT=$PIECE($TEXT(PKUSE+BI),";",3,99)
IF ($PIECE(TEXT,";")="END")
QUIT
Begin DoDot:1
+201 ;
+202 NEW DIC,X,Y,DA,OIEN
+203 ;
+204 ;Locate IEN for this entry
+205 SET DIC="^CIAVOBJ(19930.2,"
SET X=$PIECE(TEXT,";")
SET DIC(0)="OX"
+206 DO ^DIC
IF +Y<0
WRITE !!,"<MISSING VUECENTRIC OBJECT: ",X,">"
QUIT
+207 SET OIEN=+Y
+208 ;
+209 SET DA(1)=PIEN
SET DIC="^CIAVOBJ(19930.2,"_DA(1)_",9,"
SET DIC(0)="LOX"
SET X=$PIECE(TEXT,";")
+210 DO ^DIC
End DoDot:1
+211 ;
XPST QUIT
+1 ;
CONV ;Convert existing PIP/VOB entries to use new BJPN SNOMED TERMS entries
+1 ;
+2 ;Only convert if backup from pre-install is present
+3 IF '$DATA(^XTMP("BJPNSMD"))
QUIT
+4 ;
+5 NEW PIPIEN
+6 ;
+7 SET PIPIEN=0
FOR
SET PIPIEN=$ORDER(^BJPNPL(PIPIEN))
IF 'PIPIEN
QUIT
Begin DoDot:1
+8 ;
+9 NEW OIEN,OSMD,BJPNUP,ERROR,NIEN,DFN,IEN,FND
+10 ;
+11 SET OIEN=$$GET1^DIQ(90680.01,PIPIEN_",",.03,"I")
IF OIEN=""
QUIT
+12 SET OSMD=$PIECE($GET(^XTMP("BJPNSMD",90680.02,OIEN,0)),U,2)
IF OSMD=""
QUIT
+13 SET DFN=$$GET1^DIQ(90680.01,PIPIEN_",",.02,"I")
IF DFN=""
QUIT
+14 ;
+15 ;Now look for match in new file
+16 SET NIEN=$$FIND(OSMD)
+17 ;
+18 ;Look for deleted SNOMED terms - Remove if not in new set
+19 IF NIEN=""
DO DEL(DFN,PIPIEN,"E")
QUIT
+20 ;
+21 ;Found entry - file in existing structure
+22 SET BJPNUP(90680.01,PIPIEN_",",.01)=NIEN
+23 SET BJPNUP(90680.01,PIPIEN_",",.03)=NIEN
+24 DO FILE^DIE("","BJPNUP","ERROR")
+25 ;
+26 ;Check for duplicates - old list had duplicates
+27 SET FND=0
SET IEN=""
FOR
SET IEN=$ORDER(^BJPNPL("AC",DFN,NIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+28 ;
+29 ;Skip Deletes
+30 IF ($$GET1^DIQ(90680.01,IEN_",","2.01","I")]"")
QUIT
+31 SET FND=FND+1
+32 SET FND(IEN)=""
End DoDot:2
+33 ;
+34 ;Delete any duplicates
+35 IF FND>1
Begin DoDot:2
+36 NEW IEN
+37 SET IEN=$ORDER(FND(""),-1)
IF IEN=""
QUIT
+38 FOR
SET IEN=$ORDER(FND(IEN),-1)
IF IEN=""
QUIT
DO DEL(DFN,IEN,"D")
End DoDot:2
End DoDot:1
+39 ;
+40 ;Clear out backup entries
+41 KILL ^XTMP("BJPNSMD")
+42 QUIT
+43 ;
FIND(TERM) ;Find term in new file
+1 IF $GET(TERM)=""
QUIT ""
+2 ;
+3 NEW SHTERM,IEN,FOUND
+4 ;
+5 SET SHTERM=$EXTRACT(TERM,1,30)
SET FOUND=""
+6 SET IEN=""
FOR
SET IEN=$ORDER(^BJPN(90680.02,"C",SHTERM,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+7 IF TERM'=$$GET1^DIQ(90680.02,IEN_",",.02,"I")
QUIT
+8 SET FOUND=IEN
End DoDot:1
IF FOUND
QUIT
+9 ;
+10 QUIT FOUND
+11 ;
DEL(DFN,PIPIEN,DCODE) ;Delete entries that have been removed
+1 ;
+2 ;If code has been removed delete altogether
+3 IF DCODE="E"
Begin DoDot:1
+4 NEW DA,DIK,TM,IEN
+5 ;
+6 ;Remove Prenatal Problem entry
+7 SET DA=PIPIEN
SET DIK="^BJPNPL("
DO ^DIK
+8 ;
+9 ;Remove V file entries
+10 SET TM=""
FOR
SET TM=$ORDER(^AUPNVOB("AE",DFN,PIPIEN,TM))
IF TM=""
QUIT
Begin DoDot:2
+11 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVOB("AE",DFN,PIPIEN,TM,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+12 SET DA=IEN
SET DIK="^AUPNVOB("
DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 ;If code is a duplicate, mark as deleted (duplicate)
+15 IF DCODE="D"
Begin DoDot:1
+16 NEW VIEN,TM,IEN
+17 ;
+18 ;Find last VIEN used
+19 SET (VIEN,TM)=""
FOR
SET TM=$ORDER(^AUPNVOB("AE",DFN,PIPIEN,TM),-1)
IF TM=""
QUIT
Begin DoDot:2
+20 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVOB("AE",DFN,PIPIEN,TM,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+21 SET VIEN=$$GET1^DIQ(9000010.43,IEN_",",.03,"I")
End DoDot:3
IF VIEN
QUIT
End DoDot:2
IF VIEN
QUIT
+22 ;
+23 ;Mark entry as deleted
+24 IF VIEN
DO DEL^BJPNPRUT("",VIEN,PIPIEN,DCODE,"")
End DoDot:1
+25 ;
+26 QUIT
+27 ;
+28 ;;File 19930.2 Field listing
+29 ;;PROGID;VRSN;SRC;SER;INI;REQ;PROP;MULT;DIS;ALLK;HIDD;SBYS;SERV;REG;NORG;DOTN;ALIA;TDES;DES;CLSID;HEIGHT;WIDTH
+30 ;;.01;1;2;3;8;9;10;11;12;13;14;15;16;17;18;19;22;23;98;99.5;4;5
OBJ ;;
+1 ;;FILE:INFRAGISTICS2.EXCEL.V10.3.DLL;Excel.v10.3;10.3.20103.1000;Infragistics2.Excel.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+2 ;;FILE:INFRAGISTICS2.SHARED.V10.3.DLL;Shared.v10.3;10.3.20103.1000;Infragistics2.Shared.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+3 ;;FILE:INFRAGISTICS2.WIN.MISC.V10.3.DLL;Misc.v10.3;10.3.20103.1000;Infragistics2.Win.Misc.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+4 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.EXCELEXPORT.V10.3.DLL;ExcelExport.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinGrid.ExcelExport.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+5 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.V10.3.DLL;UltraWinGrid.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinGrid.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+6 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINPRINTPREVIEWDIALOG.V10.3.DLL;UltraWinPrintPreviewDialog.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinPrintPreviewDialog.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+7 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINSTATUSBAR.V10.3.DLL;UltraWinStatusBar.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinStatusBar.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+8 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINTOOLBARS.V10.3.DLL;UltraWinToolbars.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinToolbars.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+9 ;;FILE:INFRAGISTICS2.WIN.V10.3.DLL;Win.v10.3;10.3.20103.1000;Infragistics2.Win.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+10 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTBAR.V10.3.DLL;UltraWinListBar.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinListBar.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+11 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTVIEW.V10.3.DLL;UltraWinListView.v10.3;10.3.20103.1000;Infragistics2.Win.UltraWinListView.v10.3.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+12 ;;FILE:RICHTEXTBOXPRINTCONTROL.DLL;Rich Text Box Print Control;1.0.0.0;RichTextBoxPrintControl.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
+13 ;;IHS.PN.EHR.PRENATALPICKLIST.PRENATALPICKLISTCOMPONENT;Prenatal Pick List;1.0.0.13;IHS.PN.EHR.PrenatalPickList.dll;;;IHS.PN.EHR.PrenatalPickList.chm;0;1;0;0;0;0;0;0;;1;;;;{0A2C8481-DB1A-4D80-A8E0-CEBF70E6F705};300;600
+14 ;;IHS.PN.EHR.PRENATALPROBLEMLIST.PIPCOMPONENT;Pregnancy Issues and Problems List;1.0.0.13;IHS.PN.EHR.PrenatalProblemList.dll;;;IHS.PN.EHR.PrenatalProblemList.chm;0;1;0;0;0;0;0;0;;1;;;;{B5416178-ECD8-4515-A700-2980BCAA6CAA};300;640
+15 ;;END;
+16 ;;
PPUSE ;;
+1 ;;FILE:INFRAGISTICS2.EXCEL.V10.3.DLL
+2 ;;FILE:INFRAGISTICS2.SHARED.V10.3.DLL
+3 ;;FILE:INFRAGISTICS2.WIN.MISC.V10.3.DLL
+4 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.EXCELEXPORT.V10.3.DLL
+5 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.V10.3.DLL
+6 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINPRINTPREVIEWDIALOG.V10.3.DLL
+7 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINSTATUSBAR.V10.3.DLL
+8 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINTOOLBARS.V10.3.DLL
+9 ;;FILE:INFRAGISTICS2.WIN.V10.3.DLL
+10 ;;FILE:RICHTEXTBOXPRINTCONTROL.DLL
+11 ;;END;
+12 ;;
PKUSE ;;
+1 ;;FILE:INFRAGISTICS2.SHARED.V10.3.DLL
+2 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTBAR.V10.3.DLL
+3 ;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTVIEW.V10.3.DLL
+4 ;;FILE:INFRAGISTICS2.WIN.V10.3.DLL
+5 ;;END;
+6 ;;
