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

BJPC2EVH.m

Go to the documentation of this file.
  1. BJPC2EVH ; IHS/CMI/LAB - PCC Suite v1.0 patch 1 environment check ;
  1. ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1. ;
  1. ;
  1. START ;
  1. D MES^XPDUTL($$CJ^XLFSTR("Updating Health Factors...",IOM))
  1. S BJPCX=0 F S BJPCX=$O(^APCDTHFD(BJPCX)) Q:BJPCX'=+BJPCX D
  1. .S BJPCON=$P(^APCDTHFD(BJPCX,0),U,1)
  1. .S BJPCNN=$P($G(^APCDTHFD(BJPCX,99)),U)
  1. .S BJPCCAT=$P(^APCDTHFD(BJPCX,0),U,3)
  1. .S BJPCCATI=$O(^AUTTHF("B",BJPCCAT,0))
  1. .I 'BJPCCATI D ADDCAT I 'BJPCCATI D MES^XPDUTL("Failure to add category "_BJPCCAT) Q
  1. .S BJPCCODE=$P(^APCDTHFD(BJPCX,0),U,2)
  1. .S BJPCDHS=$P(^APCDTHFD(BJPCX,0),U,8)
  1. .S BJPCET=$P(^APCDTHFD(BJPCX,0),U,10)
  1. .S BJPCIF=$P(^APCDTHFD(BJPCX,0),U,13)
  1. .S BJPCID=$P(^APCDTHFD(BJPCX,0),U,15)
  1. .S BJPCMN=$P($G(^APCDTHFD(BJPCX,88)),U,1)
  1. .S BJPCITP=$P($G(^APCDTHFD(BJPCX,99)),U,2)
  1. .S BJPCY=0,BJPCHFI=0 F S BJPCY=$O(^AUTTHF("B",BJPCON,BJPCY)) Q:BJPCY'=+BJPCY!(BJPCHFI) D
  1. ..Q:$$VAL^XBDIQ1(9999999.64,BJPCY,.03)'=BJPCCAT
  1. ..S BJPCHFI=BJPCY
  1. .;doesn't exist and is to be inactivated or is already inactivated so don't add it
  1. .I 'BJPCHFI,(BJPCIF+BJPCITP+BJPCID) Q ;move on to next
  1. .I 'BJPCHFI D
  1. ..I BJPCNN]"" S BJPCY=0,BJPCHFI=0 F S BJPCY=$O(^AUTTHF("B",BJPCNN,BJPCY)) Q:BJPCY'=+BJPCY!(BJPCHFI) D
  1. ...Q:$$VAL^XBDIQ1(9999999.64,BJPCY,.03)'=BJPCCAT
  1. ...S BJPCHFI=BJPCY
  1. .I 'BJPCHFI D ADDNEW ;add new one
  1. .;edit
  1. .I BJPCNN]"",BJPCON'=BJPCNN S DIE="^AUTTHF(",DA=BJPCHFI,DR=".01///"_BJPCNN D ^DIE K DIE,DA,DR
  1. .I BJPCITP S DA=BJPCHFI,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DR
  1. .S DA=BJPCHFI,DIE="^AUTTHF(",DR=".1///"_BJPCET D ^DIE K DA,DR
  1. .Q
  1. S DIK="^AUTTHF(",DIK(1)=".03^F" D ENALL^DIK K DIK
  1. Q
  1. ADDNEW ;
  1. S X=BJPCON,DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".02///"_BJPCCODE_";.03////"_BJPCCATI_";.1///"_BJPCET_";.08///"_BJPCDHS_";8801///"_BJPCMN K DO,DD,D0 D FILE^DICN K DIADD,DLAYGO,DIC,X
  1. I Y=-1 D MES^XPDUTL("Error creating health factor "_BJPCON)
  1. S BJPCHFI=+Y
  1. Q
  1. ADDCAT ;
  1. S BJPCCATI=""
  1. S X=BJPCCAT,DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".03///"_BJPCCAT_";.1///C;.02///"_BJPCCODE K DO,DD,D0 D FILE^DICN K DIADD,DLAYGO,DIC,X
  1. I Y=-1 Q
  1. S BJPCCATI=+Y
  1. Q