Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BJPN10PS

BJPN10PS.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ;
  1. PST ;
  1.  ;
  1.  NEW BI,TEXT,PIEN,DIC,X,Y,DIK,IEN
  1.  ;
  1.  ;Resolve file 80 descrepancies between sites
  1.  S IEN=0 F  S IEN=$O(^BJPN(90680.02,IEN)) Q:'IEN  D
  1.  . NEW MPIEN
  1.  . S MPIEN=0 F  S MPIEN=$O(^BJPN(90680.02,IEN,1,MPIEN)) Q:'MPIEN  D
  1.  .. NEW DA,IENS,XCD,BUPD,DIC,X,Y
  1.  .. S DA(1)=IEN,DA=MPIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S XCD=$$GET1^DIQ(90680.21,IENS,.03,"E")
  1.  .. Q:XCD=""
  1.  .. ;
  1.  .. ;ICD Code
  1.  .. ;
  1.  .. ;First look for passed in value
  1.  .. S X=XCD,DIC="^ICD9(",DIC(0)="XM"
  1.  .. D ^DIC
  1.  .. ;
  1.  .. ;If no match, look for + of value
  1.  .. I +Y="-1" D
  1.  ... S X=+XCD,DIC="^ICD9(",DIC(0)="XM"
  1.  ... D ^DIC
  1.  .. ;
  1.  .. ;If no match look in "BA" index - Exact match
  1.  .. I +Y="-1" D
  1.  ... NEW IEN
  1.  ... S IEN="" F  S IEN=$O(^ICD9("BA",XCD,IEN)) Q:'IEN  D  I Y>0 Q
  1.  ... I $$GET1^DIQ(80,IEN_",",".01","I")'=XCD S Y="-1" Q
  1.  ... S Y=IEN
  1.  .. ;
  1.  .. ;If no match look in "BA" index - + subscript, exact match
  1.  .. I +Y="-1" D
  1.  ... NEW IEN,CD
  1.  ... S IEN="" F  S IEN=$O(^ICD9("BA",+XCD,IEN)) Q:'IEN  D  I Y>0 Q
  1.  .... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
  1.  .... I CD=XCD S Y=IEN
  1.  .... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
  1.  .... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
  1.  .. ;
  1.  .. ;If no match look in "BA" index - + subscript, + match
  1.  .. I +Y="-1" D
  1.  ... NEW IEN,CD
  1.  ... S IEN="" F  S IEN=$O(^ICD9("BA",+XCD,IEN)) Q:'IEN  D  I Y>0 Q
  1.  .... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
  1.  .... I CD=+XCD S Y=IEN
  1.  .... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
  1.  .... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
  1.  .. ;
  1.  .. ;If no match look in "BA" index - subscript and " ", exact match
  1.  .. I +Y="-1" D
  1.  ... NEW IEN
  1.  ... S IEN="" F  S IEN=$O(^ICD9("BA",XCD_" ",IEN)) Q:'IEN  D  I Y>0 Q
  1.  .... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
  1.  .... I CD=XCD S Y=IEN
  1.  .... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
  1.  .... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
  1.  .. ;
  1.  .. ;If no match look in "BA" index -  + subscript and " ", exact match
  1.  .. I +Y="-1" D
  1.  ... NEW IEN
  1.  ... S IEN="" F  S IEN=$O(^ICD9("BA",XCD_" ",IEN)) Q:'IEN  D  I Y>0 Q
  1.  .... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
  1.  .... I CD=XCD S Y=IEN
  1.  .... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
  1.  .... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
  1.  .. ;
  1.  .. ;If no match look in "BA" index -  + subscript and " ", any match
  1.  .. I +Y="-1" D
  1.  ... NEW IEN
  1.  ... S IEN="" F  S IEN=$O(^ICD9("BA",+XCD_" ",IEN)) Q:'IEN  D  I Y>0 Q
  1.  .... S CD=$$GET1^DIQ(80,IEN_",",".01","I")
  1.  .... I CD=+XCD S Y=IEN
  1.  .... I $E(XCD,$L(XCD))=".",XCD=(CD_".") S Y=IEN Q
  1.  .... I $E(CD,$L(CD))=".",CD=(XCD_".") S Y=IEN Q
  1.  .. I +Y="-1" Q
  1.  .. ;
  1.  .. ;Hard set entry
  1.  .. S $P(^BJPN(90680.02,IEN,1,MPIEN,0),U)=+Y
  1.  . ;
  1.  . ;Re-index that SNOMED Code ICD entry
  1.  . K DA S DA(1)=IEN
  1.  . K ^BJPN(90680.02,IEN,1,"B")
  1.  . S DIK="^BJPN(90680.02,"_DA(1)_",1,",DIK(1)=".01" D ENALL^DIK
  1.  ;
  1.  ;Perform conversion (if reload)
  1.  D CONV
  1.  ;
  1.  ;Re-index entries (in case of re-install)
  1.  K ^AUPNVOB("AA"),^AUPNVOB("AC"),^AUPNVOB("AE"),^AUPNVOB("AF")
  1.  S DIK="^AUPNVOB(",DIK(1)=".02" D ENALL^DIK
  1.  ;
  1.  ; UPDATE THE VUECENTRIC REGISTERED OBJECTS FILE
  1.  W !,"Registering the Vucentric Objects..."
  1.  F BI=1:1 S TEXT=$P($T(OBJ+BI),";",3,99) Q:($P(TEXT,";")="END")  D
  1.  .W !,$P(TEXT,";")
  1.  . ;
  1.  . NEW DIC,X,Y,OBJUPD,ERROR,WP8,WP9,WP10
  1.  . ;
  1.  . ;PROGID (#.01)
  1.  . S DIC="^CIAVOBJ(19930.2,",DIC(0)="LOX",X=$P(TEXT,";")
  1.  . D ^DIC I +Y<0 Q
  1.  . S OIEN=+Y
  1.  . ;
  1.  . ;NAME (#1)
  1.  . S OBJUPD(19930.2,OIEN_",",1)=$P(TEXT,";",2)
  1.  . ;
  1.  . ;VERSION (#2)
  1.  . S OBJUPD(19930.2,OIEN_",",2)=$P(TEXT,";",3)
  1.  . ;
  1.  . ;SOURCE (#3)
  1.  . S OBJUPD(19930.2,OIEN_",",3)=$P(TEXT,";",4)
  1.  . ;
  1.  . ;SERIALIZABLE (#8)
  1.  . S WP8(1)=$P(TEXT,";",5)
  1.  . D WP^DIE(19930.2,OIEN_",",8,"","WP8")
  1.  . ;
  1.  . ;INITIALIZATION (#9)
  1.  . S WP9(1)=$P(TEXT,";",6)
  1.  . D WP^DIE(19930.2,OIEN_",",9,"","WP9")
  1.  . ;
  1.  . ;REQUIRED (#10)
  1.  . S WP10(1)=$P(TEXT,";",7)
  1.  . D WP^DIE(19930.2,OIEN_",",10,"","WP10")
  1.  . ;
  1.  . ;PROPEDIT (#11)
  1.  . S OBJUPD(19930.2,OIEN_",",11)=$P(TEXT,";",8)
  1.  . ;
  1.  . ;MULTIPLE (#12)
  1.  . S OBJUPD(19930.2,OIEN_",",12)=$P(TEXT,";",9)
  1.  . ;
  1.  . ;DISABLED (#13)
  1.  . S OBJUPD(19930.2,OIEN_",",13)=$P(TEXT,";",10)
  1.  . ;
  1.  . ;ALLKEYS (#14)
  1.  . S OBJUPD(19930.2,OIEN_",",14)=$P(TEXT,";",11)
  1.  . ;
  1.  . ;HIDDEN (#15)
  1.  . S OBJUPD(19930.2,OIEN_",",15)=$P(TEXT,";",12)
  1.  . ;
  1.  . ;SIDEBYSIDE (#16)
  1.  . S OBJUPD(19930.2,OIEN_",",16)=$P(TEXT,";",13)
  1.  . ;
  1.  . ;SERVICE (#17)
  1.  . S OBJUPD(19930.2,OIEN_",",17)=$P(TEXT,";",14)
  1.  . ;
  1.  . ;REGRESS (#18)
  1.  . S OBJUPD(19930.2,OIEN_",",18)=$P(TEXT,";",15)
  1.  . ;
  1.  . ;NOREGISTER (#19)
  1.  . S OBJUPD(19930.2,OIEN_",",19)=$P(TEXT,";",16)
  1.  . ;
  1.  . ;DOTNET (#22)
  1.  . S OBJUPD(19930.2,OIEN_",",22)=$P(TEXT,";",17)
  1.  . ;
  1.  . ;ALIAS (#23)
  1.  . S OBJUPD(19930.2,OIEN_",",23)=$P(TEXT,";",18)
  1.  . ;
  1.  . ;TECHNICAL DESCRIPTION (#98)
  1.  . S OBJUPD(19930.2,OIEN_",",98)=$P(TEXT,";",19)
  1.  . ;
  1.  . ;DESCRIPTION (#99)
  1.  . S OBJUPD(19930.2,OIEN_",",99)=$P(TEXT,";",20)
  1.  . ;
  1.  . ;CLSID (#.5)
  1.  . S OBJUPD(19930.2,OIEN_",",.5)=$P(TEXT,";",21)
  1.  . ;
  1.  . ;HEIGHT (#4)
  1.  . S OBJUPD(19930.2,OIEN_",",4)=$P(TEXT,";",22)
  1.  . ;
  1.  . ;WIDTH (#5)
  1.  . S OBJUPD(19930.2,OIEN_",",5)=$P(TEXT,";",23)
  1.  . ;
  1.  . ;Update entry
  1.  .D FILE^DIE("","OBJUPD","ERROR")
  1.  ;
  1.  ;Locate PIP entry
  1.  S DIC(0)="MU",X="IHS.PN.EHR.PRENATALPROBLEMLIST",DIC="^CIAVOBJ(19930.2,"
  1.  D ^DIC I +Y<0 G XPST
  1.  S PIEN=+Y
  1.  ;
  1.  ;Enter USER values for Problem List Entry
  1.  F BI=1:1 S TEXT=$P($T(PPUSE+BI),";",3,99) Q:($P(TEXT,";")="END")  D
  1.  . ;
  1.  . NEW DIC,X,Y,DA,OIEN
  1.  . ;
  1.  . ;Locate IEN for this entry
  1.  . S DIC="^CIAVOBJ(19930.2,",X=$P(TEXT,";"),DIC(0)="OX"
  1.  . D ^DIC I +Y<0 W !!,"<MISSING VUECENTRIC OBJECT: ",X,">" Q
  1.  . S OIEN=+Y
  1.  . ;
  1.  . S DA(1)=PIEN,DIC="^CIAVOBJ(19930.2,"_DA(1)_",9,",DIC(0)="LOX",X=$P(TEXT,";")
  1.  . D ^DIC
  1.  ;
  1.  ;Locate Pick List entry
  1.  S DIC(0)="MU",X="IHS.PN.EHR.PRENATALPICKLIST",DIC="^CIAVOBJ(19930.2,"
  1.  D ^DIC I +Y<0 G XPST
  1.  S PIEN=+Y
  1.  ;
  1.  ;Enter USER values for Pick List Entry
  1.  F BI=1:1 S TEXT=$P($T(PKUSE+BI),";",3,99) Q:($P(TEXT,";")="END")  D
  1.  . ;
  1.  . NEW DIC,X,Y,DA,OIEN
  1.  . ;
  1.  . ;Locate IEN for this entry
  1.  . S DIC="^CIAVOBJ(19930.2,",X=$P(TEXT,";"),DIC(0)="OX"
  1.  . D ^DIC I +Y<0 W !!,"<MISSING VUECENTRIC OBJECT: ",X,">" Q
  1.  . S OIEN=+Y
  1.  . ;
  1.  . S DA(1)=PIEN,DIC="^CIAVOBJ(19930.2,"_DA(1)_",9,",DIC(0)="LOX",X=$P(TEXT,";")
  1.  . D ^DIC
  1.  ;
  1. XPST Q
  1.  ;
  1. CONV ;Convert existing PIP/VOB entries to use new BJPN SNOMED TERMS entries
  1.  ;
  1.  ;Only convert if backup from pre-install is present
  1.  Q:'$D(^XTMP("BJPNSMD"))
  1.  ;
  1.  NEW PIPIEN
  1.  ;
  1.  S PIPIEN=0 F  S PIPIEN=$O(^BJPNPL(PIPIEN)) Q:'PIPIEN  D
  1.  . ;
  1.  . NEW OIEN,OSMD,BJPNUP,ERROR,NIEN,DFN,IEN,FND
  1.  . ;
  1.  . S OIEN=$$GET1^DIQ(90680.01,PIPIEN_",",.03,"I") Q:OIEN=""
  1.  . S OSMD=$P($G(^XTMP("BJPNSMD",90680.02,OIEN,0)),U,2) Q:OSMD=""
  1.  . S DFN=$$GET1^DIQ(90680.01,PIPIEN_",",.02,"I") Q:DFN=""
  1.  . ;
  1.  . ;Now look for match in new file
  1.  . S NIEN=$$FIND(OSMD)
  1.  . ;
  1.  . ;Look for deleted SNOMED terms - Remove if not in new set
  1.  . I NIEN="" D DEL(DFN,PIPIEN,"E") Q
  1.  . ;
  1.  . ;Found entry - file in existing structure
  1.  . S BJPNUP(90680.01,PIPIEN_",",.01)=NIEN
  1.  . S BJPNUP(90680.01,PIPIEN_",",.03)=NIEN
  1.  . D FILE^DIE("","BJPNUP","ERROR")
  1.  . ;
  1.  . ;Check for duplicates - old list had duplicates
  1.  . S FND=0,IEN="" F  S IEN=$O(^BJPNPL("AC",DFN,NIEN,IEN)) Q:IEN=""  D
  1.  .. ;
  1.  .. ;Skip Deletes
  1.  .. Q:($$GET1^DIQ(90680.01,IEN_",","2.01","I")]"")
  1.  .. S FND=FND+1
  1.  .. S FND(IEN)=""
  1.  . ;
  1.  . ;Delete any duplicates
  1.  . I FND>1 D
  1.  .. NEW IEN
  1.  .. S IEN=$O(FND(""),-1) Q:IEN=""
  1.  .. F  S IEN=$O(FND(IEN),-1) Q:IEN=""  D DEL(DFN,IEN,"D")
  1.  ;
  1.  ;Clear out backup entries
  1.  K ^XTMP("BJPNSMD")
  1.  Q
  1.  ;
  1. FIND(TERM) ;Find term in new file
  1.  I $G(TERM)="" Q ""
  1.  ;
  1.  NEW SHTERM,IEN,FOUND
  1.  ;
  1.  S SHTERM=$E(TERM,1,30),FOUND=""
  1.  S IEN="" F  S IEN=$O(^BJPN(90680.02,"C",SHTERM,IEN)) Q:IEN=""  D  Q:FOUND
  1.  . I TERM'=$$GET1^DIQ(90680.02,IEN_",",.02,"I") Q
  1.  . S FOUND=IEN
  1.  ;
  1.  Q FOUND
  1.  ;
  1. DEL(DFN,PIPIEN,DCODE) ;Delete entries that have been removed
  1.  ;
  1.  ;If code has been removed delete altogether
  1.  I DCODE="E" D
  1.  . NEW DA,DIK,TM,IEN
  1.  . ;
  1.  . ;Remove Prenatal Problem entry 
  1.  . S DA=PIPIEN,DIK="^BJPNPL(" D ^DIK
  1.  . ;
  1.  . ;Remove V file entries
  1.  . S TM="" F  S TM=$O(^AUPNVOB("AE",DFN,PIPIEN,TM)) Q:TM=""  D
  1.  .. S IEN="" F  S IEN=$O(^AUPNVOB("AE",DFN,PIPIEN,TM,IEN)) Q:IEN=""  D
  1.  ... S DA=IEN,DIK="^AUPNVOB(" D ^DIK
  1.  ;
  1.  ;If code is a duplicate, mark as deleted (duplicate)
  1.  I DCODE="D" D
  1.  . NEW VIEN,TM,IEN
  1.  . ;
  1.  . ;Find last VIEN used
  1.  . S (VIEN,TM)="" F  S TM=$O(^AUPNVOB("AE",DFN,PIPIEN,TM),-1) Q:TM=""  D  Q:VIEN
  1.  .. S IEN="" F  S IEN=$O(^AUPNVOB("AE",DFN,PIPIEN,TM,IEN),-1) Q:IEN=""  D  Q:VIEN
  1.  ... S VIEN=$$GET1^DIQ(9000010.43,IEN_",",.03,"I")
  1.  . ;
  1.  . ;Mark entry as deleted
  1.  . I VIEN D DEL^BJPNPRUT("",VIEN,PIPIEN,DCODE,"")
  1.  ;
  1.  Q
  1.  ;
  1.  ;;File 19930.2 Field listing
  1.  ;;PROGID;VRSN;SRC;SER;INI;REQ;PROP;MULT;DIS;ALLK;HIDD;SBYS;SERV;REG;NORG;DOTN;ALIA;TDES;DES;CLSID;HEIGHT;WIDTH
  1.  ;;.01;1;2;3;8;9;10;11;12;13;14;15;16;17;18;19;22;23;98;99.5;4;5
  1. 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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;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;;;;;;
  1.  ;;FILE:RICHTEXTBOXPRINTCONTROL.DLL;Rich Text Box Print Control;1.0.0.0;RichTextBoxPrintControl.dll;;;;0;0;0;0;1;0;0;0;;0;;;;;;
  1.  ;;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
  1.  ;;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
  1.  ;;END;
  1.  ;;
  1. PPUSE ;;
  1.  ;;FILE:INFRAGISTICS2.EXCEL.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.SHARED.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.MISC.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.EXCELEXPORT.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.ULTRAWINGRID.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.ULTRAWINPRINTPREVIEWDIALOG.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.ULTRAWINSTATUSBAR.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.ULTRAWINTOOLBARS.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.V10.3.DLL
  1.  ;;FILE:RICHTEXTBOXPRINTCONTROL.DLL
  1.  ;;END;
  1.  ;;
  1. PKUSE ;;
  1.  ;;FILE:INFRAGISTICS2.SHARED.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTBAR.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.ULTRAWINLISTVIEW.V10.3.DLL
  1.  ;;FILE:INFRAGISTICS2.WIN.V10.3.DLL
  1.  ;;END;
  1.  ;;