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

BJPC2P5.m

Go to the documentation of this file. 
  1. BJPC2P5 ; IHS/CMI/LAB - PCC Suite v1.0 patch 3 environment check ;   
  1.  ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
  1.  ;
  1.  ;
  1.  ; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  ;KERNEL
  1.  I +$$VERSION^XPDUTL("XU")<8 D MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required.  Not installed",80)) D SORRY(2) I 1
  1.  E  D MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
  1.  ;FILEMAN
  1.  I +$$VERSION^XPDUTL("DI")<22 D MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required.  Not installed.",80)) D SORRY(2) I 1
  1.  E  D MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
  1.  ;BJPC
  1.  I $$VERSION^XPDUTL("BJPC")'="2.0" D MES^XPDUTL($$CJ^XLFSTR("Version 2.0 of the IHS PCC SUITE (BJPC) is required.  Not installed",80)) D SORRY(2) I 1
  1.  E  D MES^XPDUTL($$CJ^XLFSTR("Requires IHS PCC Suite (BJPC) Version 2.0....Present.",80))
  1.  ;BJPC 2.0 PATCH 4
  1.  I '$$INSTALLD("BJPC*2.0*4") D SORRY(2)
  1.  I '$$INSTALLD("APCL*3.0*27") D SORRY(2)
  1.  I '$$INSTALLD("AUPN*99.1*21") D SORRY(2)
  1.  I '$$INSTALLD("AG*7.1*8") D SORRY(2)
  1.  I '$$INSTALLD("HL*1.6*1006") D SORRY(2)
  1.  ;
  1.  Q
  1.  ;
  1. PRE ;
  1.  S BJPCDA=$O(^APCHSCMP("B","MEASUREMENT PANELS (OUTPATIENT)",0))
  1.  I BJPCDA S DA=BJPCDA,DR=".01///MEASUREMENT PANELS",DIE="^APCHSCMP(" D ^DIE K DA,DIE,DR
  1.  S BJPCDA=$O(^APCHSCMP("B","PROBLEMS - INACTIVE/RESOLVED",0))
  1.  I BJPCDA S DA=BJPCDA,DR=".01///PROBLEMS - INACTIVE;3///INACTIVE PROBLEMS",DIE="^APCHSCMP(" D ^DIE K DA,DIE,DR
  1.  S DA=0 F  S DA=$O(^APCLVSTS(DA)) Q:DA'=+DA  S DIK="^APCLVSTS(" D ^DIK
  1.  S DA=0 F  S DA=$O(^APCDTHFD(DA)) Q:DA'=+DA  S DIK="^APCDTHFD(" D ^DIK
  1.  S DA=$O(^APCDTKW("B","PRO",0)) I DA S DIK="^APCDTKW(" D ^DIK
  1.  K DA,DIK
  1.  S DA=$O(^APCDTKW("B","MEAS",0))
  1.  I DA S DIE="^APCDTKW(",DR=".07///0" D ^DIE K DA,DIE,DR
  1.  D PRE^AMQQPOST
  1.  Q
  1. POST ;
  1.  ;ADD EPI OPTIONS
  1.  S X=$$ADD^XPDMENU("APCLMENU","APCS EPI PROGRAM HL7 EXPORTS","EPIX")
  1.  I 'X W !,"Attempt to add APCS EPI PROGRAM HL7 EXPORTS option failed.." H 3
  1.  S X=$$DELETE^XPDMENU("APCLMENU","APCL M MAIN DM MENU")
  1.  S X=$$ADD^XPDMENU("APCLMENU","APCL TAXONOMY SETUP","TS")
  1.  D LAB
  1.  D HLO
  1.  D ^APCS
  1.  D POST^AMQQPOST
  1.  D HF
  1. HSHF ;
  1.  ;now fix health summary types to add 3 categories if the tobacco one is in the health factor multiple
  1.  S BJPCX=0 F  S BJPCX=$O(^APCHSCTL(BJPCX)) Q:BJPCX'=+BJPCX  D
  1.  .Q:'$O(^APCHSCTL(BJPCX,7,0))  ;no health factor categories defined
  1.  .;GET THE LAST ORDER NUMBER USED
  1.  .S (X,BJPCL)="" F  S X=$O(^APCHSCTL(BJPCX,7,"B",X)) Q:X'=+X  S BJPCL=X
  1.  .S (X,BJPCI)="" F  S X=$O(^APCHSCTL(BJPCX,7,X)) Q:X'=+X  S BJPCI=X
  1.  .S BJPCY=0 F  S BJPCY=$O(^APCHSCTL(BJPCX,7,BJPCY)) Q:BJPCY'=+BJPCY  D
  1.  ..S BJPCC=$P(^APCHSCTL(BJPCX,7,BJPCY,0),U,2)
  1.  ..;don't bother if this is not TOBACCO
  1.  ..Q:'BJPCC
  1.  ..Q:$P($G(^AUTTHF(BJPCC,0)),U,1)'="TOBACCO"
  1.  ..S BJPCO=$P(^APCHSCTL(BJPCX,7,BJPCY,0),U,1)
  1.  ..;CHANGE THIS ONE TO TOBACCO (SMOKING)
  1.  ..S X=$O(^AUTTHF("B","TOBACCO (SMOKING)",0))
  1.  ..Q:'X
  1.  ..S $P(^APCHSCTL(BJPCX,7,BJPCY,0),U,2)=X,$P(^APCHSCTL(BJPCX,7,BJPCY,0),U,3)="Tobacco Use (Smoking)"
  1.  ..S BJPCYN=$P(^APCHSCTL(BJPCX,7,BJPCY,0),U,4)
  1.  ..;NO INDEXES
  1.  ..S BJPCN=BJPCO+1,BJPCIE=BJPCI+1 I $D(^APCHSCTL(BJPCX,7,"B",BJPCN)) S BJPCN=BJPCL+1
  1.  ..S X=$O(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0))
  1.  ..I X D
  1.  ...S ^APCHSCTL(BJPCX,7,BJPCIE,0)=BJPCN_U_X_U_"Tobacco Use (Smokeless)"_U_BJPCYN
  1.  ...S ^APCHSCTL(BJPCX,7,"B",BJPCN,BJPCIE)=""
  1.  ..S BJPCN=BJPCO+2,BJPCIE=BJPCI+2 I $D(^APCHSCTL(BJPCX,7,"B",BJPCN)) S BJPCN=BJPCL+2
  1.  ..S X=$O(^AUTTHF("B","TOBACCO (EXPOSURE)",0))
  1.  ..I X D
  1.  ...S ^APCHSCTL(BJPCX,7,BJPCIE,0)=BJPCN_U_X_U_"Tobacco (Exposure)"_U_BJPCYN
  1.  ...S ^APCHSCTL(BJPCX,7,"B",BJPCN,BJPCIE)=""
  1.  Q
  1. HF ;
  1.  ;UPDATE HEALTH FACTOR TABLE AND V HEALTH FACTOR DATA
  1.  ;inactivate category TOBACCO as it has been broken into 3 categories
  1.  S DA=$O(^AUTTHF("B","TOBACCO",0))
  1.  I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;add 3 new categories
  1.  ;TOBACCO (SMOKING)
  1.  I '$O(^AUTTHF("B","TOBACCO (SMOKING)",0)) D
  1.  .S X="TOBACCO (SMOKING)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (SMOKING)" D FILE^DICN K DIADD,DLAYGO,DIC,X
  1.  .I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKING) failed") Q
  1.  ;TOBACCO (SMOKLESS - CHEWING DIP)
  1.  I '$O(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0)) D
  1.  .S X="TOBACCO (SMOKELESS - CHEWING/DIP)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (SMOKELESS - CHEWING/DIP)" D FILE^DICN K DIADD,DLAYGO,DIC,X
  1.  .I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKELESS - CHEWING/DIP) failed") Q
  1.  ;TOBACCO (EXPOSURE)
  1.  I '$O(^AUTTHF("B","TOBACCO (EXPOSURE)",0)) D
  1.  .S X="TOBACCO (EXPOSURE)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (EXPOSURE)" D FILE^DICN K DIADD,DLAYGO,DIC,X
  1.  .I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (EXPOSURE) failed") Q
  1.  ;change names of 3 health factors
  1.  ;CURRENT SMOKER - CURRENT SMOKER, STATUS UNKNOWN
  1.  S DA=$O(^AUTTHF("B","CURRENT SMOKER",0))
  1.  I DA S DIE="^AUTTHF(",DR=".01///CURRENT SMOKER, STATUS UNKNOWN" D ^DIE K DA,DIE,DR
  1.  ;PREVIOUS SMOKER - PREVIOUS (FORMER) SMOKER
  1.  S DA=$O(^AUTTHF("B","PREVIOUS SMOKER",0))
  1.  I DA S DIE="^AUTTHF(",DR=".01///PREVIOUS (FORMER) SMOKER" D ^DIE K DA,DIE,DR
  1.  ;PREVIOUS SMOKELESS - PREVIOUS (FORMER) SMOKELESS
  1.  S DA=$O(^AUTTHF("B","PREVIOUS SMOKELESS",0))
  1.  I DA S DIE="^AUTTHF(",DR=".01///PREVIOUS (FORMER) SMOKELESS" D ^DIE K DA,DIE,DR
  1.  ;INACTIVATE 2 HEALTH FACTORS
  1.  ;CURRENT SMOKER AND SMOKELESS
  1.  S DA=$O(^AUTTHF("B","CURRENT SMOKER & SMOKELESS",0))
  1.  I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;NEVER USED TOBACCO
  1.  S DA=$O(^AUTTHF("B","NEVER USED TOBACCO",0))
  1.  I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;ADD 6 NEW HEALTH FACTORS
  1.  F BJPCX="CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","NEVER SMOKED","SMOKING STATUS UNKNOWN","SMOKELESS TOBACCO, STATUS UNKNOWN","NEVER USED SMOKELESS TOBACCO" D
  1.  .Q:$D(^AUTTHF("B",BJPCX))
  1.  .S X=BJPCX,DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///F" D FILE^DICN K DIC,X,DIADD,DLAYGO
  1.  .I Y=-1 D MES^XPDUTL("Adding Health Factor "_BJPCX_" failed")
  1.  ;UPDATE CATEGORY ON ALL NEW HEALTH FACTORS
  1.  F BJPCX="NON-TOBACCO USER","CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","CURRENT SMOKER, STATUS UNKNOWN","CESSATION-SMOKER","PREVIOUS (FORMER) SMOKER","CEREMONIAL USE ONLY","NEVER SMOKED","SMOKING STATUS UNKNOWN" D
  1.  .S DA=$O(^AUTTHF("B",BJPCX,0))
  1.  .I 'DA D MES^XPDUTL("updating category for "_BJPCX_" failed.") Q
  1.  .S DIE="^AUTTHF(",DR=".03///TOBACCO (SMOKING)" D ^DIE K DA,DR,DIE
  1.  .I $D(Y) D MES^XPDUTL("Updating category for "_BJPCX_" failed.")
  1.  F BJPCX="CURRENT SMOKELESS","CESSATION-SMOKELESS","PREVIOUS (FORMER) SMOKELESS","NEVER USED SMOKELESS TOBACCO","SMOKELESS TOBACCO, STATUS UNKNOWN" D
  1.  .S DA=$O(^AUTTHF("B",BJPCX,0))
  1.  .I 'DA D MES^XPDUTL("updating category for "_BJPCX_" failed.") Q
  1.  .S DIE="^AUTTHF(",DR=".03///TOBACCO (SMOKELESS - CHEWING/DIP)" D ^DIE K DA,DR,DIE
  1.  .I $D(Y) D MES^XPDUTL("Updating category for "_BJPCX_" failed.")
  1.  F BJPCX="SMOKER IN HOME","SMOKE FREE HOME","EXPOSURE TO ENVIRONMENTAL TOBACCO SMOKE" D
  1.  .S DA=$O(^AUTTHF("B",BJPCX,0))
  1.  .I 'DA D MES^XPDUTL("updating category for "_BJPCX_" failed.") Q
  1.  .S DIE="^AUTTHF(",DR=".03///TOBACCO (EXPOSURE)" D ^DIE K DA,DR,DIE
  1.  .I $D(Y) D MES^XPDUTL("Updating category for "_BJPCX_" failed.")
  1. HFDATA ;
  1.  ;UPDATE V HEALTH FACTORS
  1.  ;IF PATIENT HAS CURRENT SMOKER AND SMOKELESS THEN ADD CURRENT SMOKER, STATUS UNKNOWN AND CURRENT SMOKELESS
  1.  ;IF PATIENT HAS NEVER USED TOBACCO THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
  1.  ;IF PATIENT HAS NON-TOBACCO USER THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
  1.  S BJPCDA=0 F  S BJPCDA=$O(^AUPNVHF(BJPCDA)) Q:BJPCDA'=+BJPCDA  D
  1.  .I $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="CURRENT SMOKER & SMOKELESS" D  Q
  1.  ..;add 2 new v health factors
  1.  ..S BJPCNEW="CURRENT SMOKER, STATUS UNKNOWN"
  1.  ..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
  1.  ..S BJPCNEW="CURRENT SMOKELESS"
  1.  ..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
  1.  .I $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="NON-TOBACCO USER" D  Q
  1.  ..;add 2 new v health factors
  1.  ..S BJPCNEW="NEVER SMOKED"
  1.  ..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
  1.  ..S BJPCNEW="NEVER USED SMOKELESS TOBACCO"
  1.  ..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
  1.  .I $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="NEVER USED TOBACCO" D  Q
  1.  ..;add 2 new v health factors
  1.  ..S BJPCNEW="NEVER SMOKED"
  1.  ..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
  1.  ..S BJPCNEW="NEVER USED SMOKELESS TOBACCO"
  1.  ..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
  1. CODE ;now update all HF Codes per Floyd's spreadsheet
  1.  S BJPCX=0 F  S BJPCX=$O(^APCDTHFD(BJPCX)) Q:BJPCX'=+BJPCX  D
  1.  .S BJPCHF=$P(^APCDTHFD(BJPCX,0),U,1)
  1.  .S BJPCHFC=$P(^APCDTHFD(BJPCX,0),U,2)
  1.  .S BJPCHFN=$P($G(^APCDTHFD(BJPCX,88)),U,1)
  1.  .S DA=$O(^AUTTHF("B",BJPCHF,0))
  1.  .Q:'DA
  1.  .I DA S DIE="^AUTTHF(",DR=".02///"_BJPCHFC_";8801///"_BJPCHFN
  1.  .D ^DIE
  1.  .K DA,DIE,DR
  1.  ;now add LOW HEALTH LITERACY READINESS TO LEARN PER Floyd
  1.  Q:$D(^AUTTHF("C","F112"))  ;already there
  1.  S BJPCC=$O(^AUTTHF("B","BARRIERS TO LEARNING",0))
  1.  S X="LOW HEALTH LITERACY",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///F;.03////"_BJPCC_";.02////F112" D FILE^DICN K DIC,X,DIADD,DLAYGO
  1.  I Y=-1 D MES^XPDUTL("Adding Health Factor "_BJPCX_" failed")
  1.  Q
  1. GOTHF(VISIT,HF) ;is this hf already attached to this visit?
  1.  NEW X,G
  1.  S G=0
  1.  S X=0 F  S X=$O(^AUPNVHF("AD",VISIT,X)) Q:X'=+X!(G)  I $D(^AUPNVHF(X,0)),$$VAL^XBDIQ1(9000010.23,X,.01)=BJPCNEW S G=1
  1.  Q G
  1. ADDHF(VISIT,HF,HFDA) ;add this v health factor to visit
  1.  I '$G(VISIT) Q
  1.  I '$D(^AUPNVSIT(VISIT,0)) Q
  1.  ;SET UP ARRAY WITH SAME VALUES AS THE OTHER ENTRY
  1.  N BJPCFDA,BJPCIENS,BJPCERRR,BJPCPIEN,DITC
  1.  S DITC=1
  1.  S BJPCIENS="+1,"
  1.  S BJPCFDA(9000010.23,BJPCIENS,.01)=$O(^AUTTHF("B",HF,0))
  1.  S BJPCFDA(9000010.23,BJPCIENS,.02)=$P(^AUPNVHF(HFDA,0),U,2)
  1.  S BJPCFDA(9000010.23,BJPCIENS,.03)=VISIT
  1.  I $P(^AUPNVHF(HFDA,0),U,4)]"" S BJPCFDA(9000010.23,BJPCIENS,.04)=$P(^AUPNVHF(HFDA,0),U,4)
  1.  I $P(^AUPNVHF(HFDA,0),U,5)]"" S BJPCFDA(9000010.23,BJPCIENS,.05)=$P(^AUPNVHF(HFDA,0),U,5)
  1.  I $P(^AUPNVHF(HFDA,0),U,6)]"" S BJPCFDA(9000010.23,BJPCIENS,.06)=$P(^AUPNVHF(HFDA,0),U,6)
  1.  I $P($G(^AUPNVHF(HFDA,12)),U,1)]"" S BJPCFDA(9000010.23,BJPCIENS,1201)=$P($G(^AUPNVHF(HFDA,12)),U,1)
  1.  I $P($G(^AUPNVHF(HFDA,12)),U,2)]"" S BJPCFDA(9000010.23,BJPCIENS,1202)=$P($G(^AUPNVHF(HFDA,12)),U,2)
  1.  I $P($G(^AUPNVHF(HFDA,12)),U,3)]"" S BJPCFDA(9000010.23,BJPCIENS,1203)=$P($G(^AUPNVHF(HFDA,12)),U,3)
  1.  I $P($G(^AUPNVHF(HFDA,12)),U,4)]"" S BJPCFDA(9000010.23,BJPCIENS,1204)=$P($G(^AUPNVHF(HFDA,12)),U,4)
  1.  I $P($G(^AUPNVHF(HFDA,12)),U,8)]"" S BJPCFDA(9000010.23,BJPCIENS,1208)=$P($G(^AUPNVHF(HFDA,12)),U,8)
  1.  I $P($G(^AUPNVHF(HFDA,12)),U,9)]"" S BJPCFDA(9000010.23,BJPCIENS,1209)=$P($G(^AUPNVHF(HFDA,12)),U,9)
  1.  I $P($G(^AUPNVHF(HFDA,12)),U,10)]"" S BJPCFDA(9000010.23,BJPCIENS,1210)=$P($G(^AUPNVHF(HFDA,12)),U,10)
  1.  I $P($G(^AUPNVHF(HFDA,12)),U,15)]"" S BJPCFDA(9000010.23,BJPCIENS,1215)=$P($G(^AUPNVHF(HFDA,12)),U,15)
  1.  I $P($G(^AUPNVHF(HFDA,801)),U,1)]"" S BJPCFDA(9000010.23,BJPCIENS,80101)=$P($G(^AUPNVHF(HFDA,801)),U,1)
  1.  I $P($G(^AUPNVHF(HFDA,801)),U,2)]"" S BJPCFDA(9000010.23,BJPCIENS,80102)=$P($G(^AUPNVHF(HFDA,801)),U,2)
  1.  I $P($G(^AUPNVHF(HFDA,811)),U,1)]"" S BJPCFDA(9000010.23,BJPCIENS,81101)=$P($G(^AUPNVHF(HFDA,811)),U,1)
  1.  I $P($G(^AUPNVHF(HFDA,812)),U,1)]"" S BJPCFDA(9000010.23,BJPCIENS,81201)=$P($G(^AUPNVHF(HFDA,812)),U,1)
  1.  I $P($G(^AUPNVHF(HFDA,812)),U,2)]"" S BJPCFDA(9000010.23,BJPCIENS,81202)=$P($G(^AUPNVHF(HFDA,812)),U,2)
  1.  I $P($G(^AUPNVHF(HFDA,812)),U,3)]"" S BJPCFDA(9000010.23,BJPCIENS,81203)=$P($G(^AUPNVHF(HFDA,812)),U,1)
  1.  D UPDATE^DIE("","BJPCFDA","BJPCIENS","BJPCERRR(1)")
  1.  I $D(BJPCERRR) D MES^XPDUTL("Error creating V Health Factor "_HF_" for visit ien "_VISIT_".") Q
  1.  W "."
  1.  Q
  1.  ;
  1. LAB ;EP
  1.  S APCSX="SURVEILLANCE RAPID FLU TESTS" D LAB1
  1.  ;D HLO
  1.  Q
  1. LAB1 ;
  1.  S APCSDA=$O(^ATXLAB("B",APCSX,0))
  1.  Q:APCSDA  ;taxonomy already exisits
  1.  W !,"Creating ",APCSX," Taxonomy..."
  1.  S X=APCSX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  I Y=-1 W !!,"ERROR IN CREATING ",APCSX," TAX" Q
  1.  S APCSTX=+Y,$P(^ATXLAB(APCSTX,0),U,2)=APCSX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60
  1.  S ^ATXLAB(APCSTX,21,0)="^9002228.02101PA^0^0"
  1.  S DA=APCSTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. HLO ;--register the app in HLO
  1.  N FDA,FIENS,FERR,PCCI
  1.  Q:$O(^HLD(779.2,"B","RPMS-ILI",0))
  1.  S PCCI=$O(^DIC(9.4,"B","IHS PCC SUITE",0))
  1.  Q:'PCCI
  1.  S FIENS=""
  1.  S FDA(779.2,"+1,",.01)="RPMS-ILI"
  1.  S FDA(779.2,"+1,",2)=PCCI
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  Q
  1. INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
  1.  ; APCLSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW BJPCY,DIC,X,Y
  1.  S X=$P(BJPCSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(BJPCSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(BJPCSTAL,"*",3)
  1.  D ^DIC
  1.  S BJPCY=Y
  1.  D IMES
  1.  Q $S(BJPCY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q