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

BKM1POST.m

Go to the documentation of this file. 
  1. BKM1POST ;PRXM/HC/ALA - HMS Version 1.0 Post-Installation ; 21 Jul 2005  9:46 PM
  1.  ;;1.0;HIV MANAGEMENT SYSTEM;;Sep 08, 2006
  1.  ;
  1.  ;**Program Description**
  1.  ;    This is the post-installation program to set up values for the
  1.  ;    HIV Management System
  1.  ;
  1. EN ;  Entry Point
  1.  ;
  1.  ;  Set up the HIV registry entry
  1.  NEW X,DIC,DLAYGO,REGISTER,DA,DR,DIE,Y
  1.  S X="HMS REGISTER",DIC(0)="LMNZ",DLAYGO=90450,DIC="^BKM(90450,"
  1.  D ^DIC
  1.  S (REGISTER,DA)=+Y
  1.  S DR=".02////HMS;12////1;12.5////1;19////0",DIE=DIC D ^DIE
  1.  ;
  1.  ;  Add the intro text for autopopulate
  1.  NEW BI,LM K ^TMP($J,"BKMTXT")
  1.  F BI=1:1:18 S LM=$T(TXT+BI) Q:LM=" Q"  S ^TMP($J,"BKMTXT",BI,0)=$P(LM,";;",2)
  1.  D WP^DIE(90450,REGISTER,50,"","^TMP($J,""BKMTXT"")")
  1.  K ^TMP($J,"BKMTXT")
  1.  ;
  1. QM ;  Set up QMAN entries
  1.  NEW X,DIC,DLAYGO,DA,DR,DIE,LINK,Y,TERM
  1.  S X="PATIENT;IMM",DIC(0)="LMNZ",DLAYGO=9009071,DIC="^AMQQ(1,"
  1.  D ^DIC
  1.  S (DA,LINK)=+Y
  1.  S BKMUPD(9009071,LINK_",",1)=9999999.14,BKMUPD(9009071,LINK_",",2)=9000010.11
  1.  S BKMUPD(9009071,LINK_",",3)=".01",BKMUPD(9009071,LINK_",",4)=10,BKMUPD(9009071,LINK_",",7)=1
  1.  D FILE^DIE("","BKMUPD")
  1.  K BKMUPD,X,DA,DIC,DIE,DLAYGO,Y
  1.  ;
  1.  S X="HMS IMMUNIZATION",DIC(0)="LMNZ",DLAYGO=9009075,DIC="^AMQQ(5,"
  1.  D ^DIC
  1.  S (DA,TERM)=+Y
  1.  S BKMUPD(9009075,TERM_",",1)="P",BKMUPD(9009075,TERM_",",3)=1,BKMUPD(9009075,TERM_",",4)=LINK
  1.  S BKMUPD(9009075,TERM_",",13)=3,BKMUPD(9009075,TERM_",",14)="IMMUNIZATION"
  1.  S BKMUPD(9009075,TERM_",",18)="AUTTIMM(",BKMUPD(9009075,TERM_",",19)="C"
  1.  S BKMUPD(9009075,TERM_",",20)="M"
  1.  D FILE^DIE("","BKMUPD")
  1.  K BKMUPD,X,DA,DIC,DIE,DLAYGO,Y
  1.  ;
  1.  S X="HMS IMMUNIZATIONS",DA(1)=TERM,DIC(0)="LMNZ",DIC="^AMQQ(5,"_DA(1)_",1,",DLAYGO=9009075.01
  1.  D ^DIC
  1.  ;
  1.  NEW X,DIC,DLAYGO,DA,DR,DIE,LINK,Y,TERM
  1.  S X="PATIENT;LOINC",DIC(0)="LMNZ",DLAYGO=9009071,DIC="^AMQQ(1,"
  1.  D ^DIC
  1.  S (DA,LINK)=+Y
  1.  S BKMUPD(9009071,LINK_",",1)=95.3,BKMUPD(9009071,LINK_",",2)=9000010.09
  1.  S BKMUPD(9009071,LINK_",",3)=".01",BKMUPD(9009071,LINK_",",4)=10,BKMUPD(9009071,LINK_",",7)=1
  1.  D FILE^DIE("","BKMUPD")
  1.  K BKMUPD,X,DA,DIC,DIE,DLAYGO,Y
  1.  ;
  1.  S X="LOINC",DIC(0)="LMNZ",DLAYGO=9009075,DIC="^AMQQ(5,"
  1.  D ^DIC
  1.  S (DA,TERM)=+Y
  1.  S BKMUPD(9009075,TERM_",",1)="P",BKMUPD(9009075,TERM_",",3)=4,BKMUPD(9009075,TERM_",",4)=LINK
  1.  S BKMUPD(9009075,TERM_",",13)=3,BKMUPD(9009075,TERM_",",14)="LOINC"
  1.  S BKMUPD(9009075,TERM_",",18)="LAB(95.3,",BKMUPD(9009075,TERM_",",19)="C"
  1.  S BKMUPD(9009075,TERM_",",20)="M"
  1.  D FILE^DIE("","BKMUPD")
  1.  K BKMUPD,X,DA,DIC,DIE,DLAYGO,Y
  1.  ;
  1.  S X="HMS IMMUNIZATIONS",DA(1)=TERM,DIC(0)="LMNZ",DIC="^AMQQ(5,"_DA(1)_",1,",DLAYGO=9009075.01
  1.  D ^DIC
  1.  ;
  1.  S MOK=$$ADD^XPDMENU("BKMV REPORTS","BGPMENU","GPRA",7)
  1.  S MOK=$$ADD^XPDMENU("BKMV OTHER RPMS","LR IHS MENU")
  1.  S MOK=$$ADD^XPDMENU("BKMV OTHER RPMS","PSO USER1")
  1.  S MOK=$$ADD^XPDMENU("BKMV OTHER RPMS","GMRAMGR")
  1.  S MOK=$$ADD^XPDMENU("BKMV OTHER RPMS","AGMENU")
  1.  S MOK=$$ADD^XPDMENU("BKMV OTHER RPMS","BMCMENU")
  1.  S MOK=$$ADD^XPDMENU("BKMV OTHER RPMS","AMQQMENU")
  1.  S MOK=$$ADD^XPDMENU("BKMV OTHER RPMS","BSDMENU")
  1.  S MOK=$$ADD^XPDMENU("XUCORE","BKMVMENU","HMS",7)
  1.  K MOK
  1.  ;
  1. BLR ;
  1.  ; Check the IHS LAB CPT CODE File for bad pointers
  1.  NEW CT,BLN,LBN,XMY,XMZ
  1.  K ^TMP("BQIMAIL",$J)
  1.  S BLN=0,CT=0
  1.  F  S BLN=$O(^BLRCPT(BLN)) Q:'BLN  D
  1.  . S LBN=$P($G(^BLRCPT(BLN,1)),U,1)
  1.  . Q:LBN=""
  1.  . Q:$G(^LAB(60,LBN,0))'=""
  1.  . S CT=CT+1,^TMP("BQIMAIL",$J,CT,0)="The "_$P(^BLRCPT(BLN,0),U,1)_" record in the IHS LAB CPT CODE File #9009021 PANEL/TEST pointer does not exist in the LAB TEST File #60."
  1.  I $D(^TMP("BQIMAIL",$J))>0 D
  1.  . S CT=CT+1,^TMP("BQIMAIL",$J,CT,0)=" "
  1.  . S CT=CT+1,^TMP("BQIMAIL",$J,CT,0)="Go to option BLR EDIT IHS LAB CPT FILE to correct these records."
  1.  . S XMSUB="iCare Install Problem"
  1.  . S XMTEXT="^TMP(""BQIMAIL"",$J,"
  1.  . I $G(DUZ)'="" S XMDUZ=DUZ,XMY(DUZ)=""
  1.  . I $G(DUZ)="" S XMDUZ="iCare Install"
  1.  . S XMY(DUZ)=""
  1.  . NEW BDUZ
  1.  . S BDUZ="" F  S BDUZ=$O(^XUSEC("LRLIASON",BDUZ)) Q:BDUZ=""  D
  1.  .. I $P($G(^VA(200,BDUZ,0)),U,11)'="" Q
  1.  .. S XMY(BDUZ)=""
  1.  . I '$D(XMY) S XMY(.5)=""
  1.  . D ^XMD
  1.  ;
  1. LTAX ;  Add Lab Taxonomies to ^ATXLAB
  1.  NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX
  1.  S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228
  1.  ; Loop through the Taxonomies as stored in routine BKMVTAX4.
  1.  D LDLAB^BKMVTAX4(.LTAX)
  1.  F BJ=1:1 Q:'$D(LTAX(BJ))  S X=LTAX(BJ) D
  1.  . I $D(^ATXLAB("B",X)) Q  ; Skip pre-existing Lab taxonomies
  1.  . D ^DIC S DA=+Y
  1.  . I DA<1 Q
  1.  . S BKTXUP(9002228,DA_",",.02)=$P(X," ",2,999)
  1.  . S BKTXUP(9002228,DA_",",.05)=DUZ
  1.  . S BKTXUP(9002228,DA_",",.06)=DT
  1.  . S BKTXUP(9002228,DA_",",.09)=60
  1.  . D FILE^DIE("I","BKTXUP")
  1.  . S BKTXUP(9002228,DA_",",.08)="B"
  1.  . D FILE^DIE("E","BKTXUP")
  1.  ;
  1.  K DA,BJ,BKTXUP
  1.  ;
  1. TAX ;  Set up the taxonomies
  1.  D ^BKMTX
  1.  D ^BKMATX
  1.  D ^BKMBTX
  1.  D ^BKMCTX
  1.  D ^BKMDTX
  1.  ;
  1. USR ;  Set up the Case File Manager
  1.  D CFM^BKMVB1
  1.  K IEN,HIVIEN,GETDFN,BKMUSER,OCCUP,USER,X,Y
  1.  ;
  1.  ; PRXM/HC/BHS - 05/10/2006 - Convert UN code to UNR per IHS
  1. UNR ; Check the HMS CANDIDATE File for Status (.03) = "UN" and
  1.  ; if found convert to "UNR"
  1.  NEW DA,DIE,DR,STATUS
  1.  S DA=0
  1.  F  S DA=$O(^BKM(90451.2,DA)) Q:'DA  D
  1.  . S STATUS=$$GET1^DIQ(90451.2,DA,".03","I")
  1.  . ; Only convert UN code to UNR
  1.  . Q:STATUS'="UN"
  1.  . S DIE="^BKM(90451.2,",DR=".03///UNR"
  1.  . D ^DIE
  1.  ;
  1.  Q
  1.  ;
  1. TXT ; Text to be stored
  1.  ;;The autopopulate function will search your RPMS database to identify
  1.  ;;patient candidates for your site's HMS Register.  You can review your
  1.  ;;candidate list (REV option) after the autopopulate and move selected
  1.  ;;patients to the Register.
  1.  ;;  
  1.  ;;HMS uses the following logic to identify patients as candidates:
  1.  ;;   1.  at least one POV or Problem List diagnosis of HIV ever; or
  1.  ;;   2.  a positive result on an HIV test; or
  1.  ;;   3.  at least 2 of any antiretroviral medications (NRTI, NNRTI, PI or
  1.  ;;       FI medications)
  1.  ;;  
  1.  ;;See the User Manual for complete, detailed definitions and related
  1.  ;;taxonomies.
  1.  ;;  
  1.  ;;Checking for Taxonomies . . .
  1.  ;;  
  1.  ;;In order for the HMS autopopulate function to find all necessary data,
  1.  ;;several taxonomies must be established.
  1.  Q