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.
BJPC2EVH ; IHS/CMI/LAB - PCC Suite v1.0 patch 1 environment check ;
 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
 ;
 ;
START ;
 D MES^XPDUTL($$CJ^XLFSTR("Updating Health Factors...",IOM))
 S BJPCX=0 F  S BJPCX=$O(^APCDTHFD(BJPCX)) Q:BJPCX'=+BJPCX  D
 .S BJPCON=$P(^APCDTHFD(BJPCX,0),U,1)
 .S BJPCNN=$P($G(^APCDTHFD(BJPCX,99)),U)
 .S BJPCCAT=$P(^APCDTHFD(BJPCX,0),U,3)
 .S BJPCCATI=$O(^AUTTHF("B",BJPCCAT,0))
 .I 'BJPCCATI D ADDCAT I 'BJPCCATI  D MES^XPDUTL("Failure to add category "_BJPCCAT) Q
 .S BJPCCODE=$P(^APCDTHFD(BJPCX,0),U,2)
 .S BJPCDHS=$P(^APCDTHFD(BJPCX,0),U,8)
 .S BJPCET=$P(^APCDTHFD(BJPCX,0),U,10)
 .S BJPCIF=$P(^APCDTHFD(BJPCX,0),U,13)
 .S BJPCID=$P(^APCDTHFD(BJPCX,0),U,15)
 .S BJPCMN=$P($G(^APCDTHFD(BJPCX,88)),U,1)
 .S BJPCITP=$P($G(^APCDTHFD(BJPCX,99)),U,2)
 .S BJPCY=0,BJPCHFI=0 F  S BJPCY=$O(^AUTTHF("B",BJPCON,BJPCY)) Q:BJPCY'=+BJPCY!(BJPCHFI)  D
 ..Q:$$VAL^XBDIQ1(9999999.64,BJPCY,.03)'=BJPCCAT
 ..S BJPCHFI=BJPCY
 .;doesn't exist and is to be inactivated or is already inactivated so don't add it
 .I 'BJPCHFI,(BJPCIF+BJPCITP+BJPCID) Q  ;move on to next
 .I 'BJPCHFI D
 ..I BJPCNN]"" S BJPCY=0,BJPCHFI=0 F  S BJPCY=$O(^AUTTHF("B",BJPCNN,BJPCY)) Q:BJPCY'=+BJPCY!(BJPCHFI)  D
 ...Q:$$VAL^XBDIQ1(9999999.64,BJPCY,.03)'=BJPCCAT
 ...S BJPCHFI=BJPCY
 .I 'BJPCHFI D ADDNEW  ;add new one
 .;edit
 .I BJPCNN]"",BJPCON'=BJPCNN S DIE="^AUTTHF(",DA=BJPCHFI,DR=".01///"_BJPCNN D ^DIE K DIE,DA,DR
 .I BJPCITP S DA=BJPCHFI,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DR
 .S DA=BJPCHFI,DIE="^AUTTHF(",DR=".1///"_BJPCET D ^DIE K DA,DR
 .Q
 S DIK="^AUTTHF(",DIK(1)=".03^F" D ENALL^DIK K DIK
 Q
ADDNEW ;
 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
 I Y=-1 D MES^XPDUTL("Error creating health factor "_BJPCON)
 S BJPCHFI=+Y
 Q
ADDCAT ;
 S BJPCCATI=""
 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
 I Y=-1 Q
 S BJPCCATI=+Y
 Q