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

BJPC2P7.m

Go to the documentation of this file. 
  1. BJPC2P7 ; IHS/CMI/LAB - PCC Suite v1.0 patch 3 environment check ;   
  1.  ;;2.0;IHS PCC SUITE;**7**;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*6") D SORRY(2)
  1.  I '$$INSTALLD("APCL*3.0*27") D SORRY(2)
  1.  ;
  1.  Q
  1.  ;
  1. PRE ;
  1.  S DA=0 F  S DA=$O(^APCLVSTS(DA)) Q:DA'=+DA  S DIK="^APCLVSTS(" D ^DIK
  1.  D PRE^AMQQPOST
  1.  S DA=$O(^APCHSCMP("B","REFUSALS",0))
  1.  I DA S DIE="^APCHSCMP(",DR=".01///REFUSALS/DECLINED SERVICES" D ^DIE
  1.  S DA=$O(^APCHSCMP("B","REFUSALS-MOST RECENT OF EACH",0)) I DA S DIE="^APCHSCMP(",DR=".01///REFUSALS/DECLINED SERVICES-MOST RECENT OF EACH" D ^DIE
  1.  ;
  1.  S DA=$O(^APCHSCMP("B","REFUSALS/DECLINED SERVICES",0))
  1.  I DA S DIE="^APCHSCMP(",DR="3///REFUSALS/DECLINED SERVICES" D ^DIE
  1.  S DA=$O(^APCHSCMP("B","REFUSALS/DECLINED SERVICES-MOS",0))
  1.  I DA S DIE="^APCHSCMP(",DR="3///REFUSALS/DECLINED SERVICES-MOST RECENT OF EACH" D ^DIE
  1.  S DA=$O(^DIC(19,"APCH PWH UPDATE DEFAULT",0))
  1.  I DA S DIE="^DIC(19,",DR="1///Update PWH Site Parameters" D ^DIE K DA,DR,DIE
  1.  S DA=$O(^DIC(19,"APCL P REFUSAL LIST",0))
  1.  I DA S DIE="^DIC(19,",DR="1///Listing of Patient Declined Services/Refusals" D ^DIE K DA,DR,DIE
  1.  S DA=$O(^APCHSCMP("B","REPRODUCTIVE HISTORY",0))
  1.  I DA S DIE="^APCHSCMP(",DR=".01///REPRODUCTIVE HISTORY - BRIEF" D ^DIE K DA,DR,DIE
  1.  S DA=$O(^APCDTKW("B","EDC",0))
  1.  I DA S DIE="^APCDTKW(",DR=".01///EDD;.06///EXPECTED DATE OF DELIVERY" D ^DIE K DA,DR,DIE
  1.  S DA=$O(^APCHPWHC("B","EDUCATION FORMS",0))
  1.  I DA S DIE="^APCHPWHC(",DR=".01///EDUCATION HANDOUTS" D ^DIE K DA,DR,DIE
  1.  S DIU=9000017,DIU(0)="" D EN^DIU2  ;DELETE 9000017, FULL DD SENT IN BUILD
  1.  K DIU
  1.  Q
  1. POST ;
  1.  ;ADD EPI OPTIONS
  1.  S X=$$ADD^XPDMENU("APCHMENU","APCH GEN SUPPLEMENT","GSUP")
  1.  I 'X W !,"Attempt to add APCH GEN SUPPLEMENT option failed.." H 3
  1.  S X=$$ADD^XPDMENU("APCD UPD PAT RELATED DATA","APCD PG PATIENT GOALS","PATG")
  1.  I 'X W !,"Attempt to add APCD PG PATIENT GOALS option failed.." H 3
  1.  S X=$$ADD^XPDMENU("BDP MENU REPORTS","BDP NO DESG PROVIDER","NODP")
  1.  I 'X W !,"Attempt to add BDP NO DESG PROVIDER option failed.." H 3
  1.  ;S X=$$ADD^XPDMENU("APCLMENU","APCM MU MAIN MENU","MUR",3)
  1.  ;I 'X W !,"Attempt to add APCM MU MAIN MENU option failed.." H 3
  1.  ;D POST^APCLEM1
  1.  D POST^AMQQPOST
  1.  S DA=$O(^APCDTKW("B","REF",0))
  1.  I DA S DIE="^APCDTKW(",DR=".06///Refused/Declined Service" D ^DIE K DA,DIE,DR
  1.  ;convert RF EDC to EDD fields and convert Contraceptive Methods to a multiple (2101)
  1.  D RFCONV
  1.  ;HEALTH FACTOR UPDATES
  1.  D UPDHF
  1.  D ^BJPC27
  1.  ;update measurement types with .05, .06, .07
  1.  F BJPCX="FH","FT","CXD","SN","PR","EGA","AG","EF" D
  1.  .S BJPCY=$O(^AUTTMSR("B",BJPCX,0))
  1.  .Q:'BJPCY
  1.  .S DIE="^AUTTMSR(",DA=BJPCY,DR=".05///F;.06///9;.07///60" D ^DIE K DIE,DA,DR
  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
  1. UPDHF ;
  1.  ;inactivate HEALTH LITERACY CATEGORY
  1.  S DA=$O(^AUTTHF("B","HEALTH LITERACY",0))
  1.  I DA S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;inactivate HEALTH LITERATE
  1.  S DA=$O(^AUTTHF("B","HEALTH LITERATE",0))
  1.  I DA S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;inactivate LOW HEALTH LITERACY from the Health Literate category
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","LOW HEALTH LITERACY",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="HEALTH LITERACY"!($$VAL^XBDIQ1(9999999.64,BJPCX,.02)="F081") D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;inactivate any other HEALTH LITERACY items
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF(BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="HEALTH LITERACY" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;inactivate several Barriers to Learning
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","CHILDHOOD DEVELOPMENT",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="BARRIERS TO LEARNING" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","LEARNING DISABILITY",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="BARRIERS TO LEARNING" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","DEVELOPMENTAL DELAY",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="BARRIERS TO LEARNING" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","<6TH GRADE EDUCATION",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="BARRIERS TO LEARNING" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","SOCIAL STRESSORS",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="BARRIERS TO LEARNING" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","LESS THAN 6TH GRADE EDUCATION",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="BARRIERS TO LEARNING" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;change emotional stressors (STRS) to Stressors (STRESS)
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","EMOTIONAL STRESSORS",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="BARRIERS TO LEARNING" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".01///STRESSORS;8801///STRESS" D ^DIE K DA,DIE,DR
  1.  ;add barriers to learning LOW HEALTH LITERACY AND COGNITIVE IMPAIRMENT
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF("B","LOW HEALTH LITERACY",BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="BARRIERS TO LEARNING" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR="8801///LOWLIT" D ^DIE K DA,DIE,DR
  1.  ;
  1.  ;inactivate all Rubella Immunity Status HFs
  1.  ;
  1.  S BJPCX=0 F  S BJPCX=$O(^AUTTHF(BJPCX)) Q:BJPCX'=+BJPCX  I $$VAL^XBDIQ1(9999999.64,BJPCX,.03)="RUBELLA IMMUNITY STATUS" D
  1.  .S DA=BJPCX,DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
  1.  ;now add COGNITIVE IMPAIRMENT
  1.  Q:$D(^AUTTHF("C","F120"))  ;already there
  1.  S BJPCC=$O(^AUTTHF("B","BARRIERS TO LEARNING",0))
  1.  S (BJPCX,X)="COGNITIVE IMPAIRMENT",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///F;.03////"_BJPCC_";.02////F120;8801///COGI" D FILE^DICN K DIC,X,DIADD,DLAYGO
  1.  I Y=-1 D MES^XPDUTL("Adding Health Factor "_BJPCX_" failed")
  1.  Q
  1. RFCONV ;
  1.  S BJPCX=0 F  S BJPCX=$O(^AUPNREP(BJPCX)) Q:BJPCX'=+BJPCX  D
  1.  .Q:$P($G(^AUPNREP(BJPCX,0)),U,9)=""  ;nothing to convert
  1.  .;W BJPCX,"~"
  1.  .S BJPCEDD=$P(^AUPNREP(BJPCX,0),U,9)
  1.  .S BJPCHOW=$P(^AUPNREP(BJPCX,0),U,10)
  1.  .I BJPCHOW=""!(BJPCHOW=0) D  Q
  1.  ..S DA=BJPCX,DIE="^AUPNREP(",DR="1314///"_BJPCEDD D ^DIE K DA,DIE,DR
  1.  .I BJPCHOW=1 D  Q
  1.  ..S DA=BJPCX,DIE="^AUPNREP(",DR="1305////"_BJPCEDD D ^DIE K DIE,DA,DR
  1.  .I BJPCHOW=2 D  Q
  1.  ..S DA=BJPCX,DIE="^AUPNREP(",DR="1302////"_BJPCEDD D ^DIE K DIE,DA,DR
  1.  .I BJPCHOW=3 D  Q
  1.  ..S DA=BJPCX,DIE="^AUPNREP(",DR="1308////"_BJPCEDD D ^DIE K DIE,DA,DR
  1. CM ;contraceptive history
  1.  S BJPCX=0 F  S BJPCX=$O(^AUPNREP(BJPCX)) Q:BJPCX'=+BJPCX  D
  1.  .Q:$P(^AUPNREP(BJPCX,0),U,6)=""  ;no method to copy to 21 mult
  1.  .S BJPCTC=$$VAL^XBDIQ1(9000017,BJPCX,3)  ;OLD EXTERNAL SET VALUE (^AUPNREP(BJPCX,0),U,6)
  1.  .S BJPCT="",BJPCCOM=""  ;NEW VALUE
  1.  .S BJPCTE=$$NEWVAL(BJPCTC)  ;get external value
  1.  .I $P(BJPCTE,U,1)="" D MES^XPDUTL("No conversion value for "_BJPCTC) Q  ;no external value
  1.  .S BJPCT=$O(^AUTTCM("B",$P(BJPCTE,U,1),0))
  1.  .I BJPCT="" D MES^XPDUTL("Error converting "_$P(BJPCTE,U,1)_" ien "_BJPCX) Q
  1.  .S BJPCD=$P(^AUPNREP(BJPCX,0),U,7)  ;date begun
  1.  .I BJPCD Q:$D(^AUPNREP("ACON",BJPCX,BJPCT,BJPCD))  ;already has this one in the multiple
  1.  .I 'BJPCD Q:$$HASND(BJPCX,BJPCT)  ;already have it with no date
  1.  .I $P(BJPCTE,U,2) S BJPCCOM=BJPCTC
  1.  .;now create multiple entry
  1.  .S DIC="^AUPNREP("_BJPCX_",2101,"
  1.  .S DIC(0)="L"
  1.  .S DA(1)=BJPCX
  1.  .S DIC("P")=$P(^DD(9000017,2101,0),U,2)
  1.  .S X=BJPCT
  1.  .S DIC("DR")=".02////"_BJPCD_";.06///"_BJPCCOM   ;.04///^S X=$S($G(APCDDATE):$$FMTE^XLFDT(APCDDATE),1:$$FMTE^XLFDT(DT))"
  1.  .K DD,D0,DO
  1.  .D FILE^DICN
  1.  .I Y=-1 D MES^XPDUTL("Converting Contraceptive Method for DFN "_BJPCX_" failed.")
  1.  .K DIC,DD,DO,D0,DA
  1.  Q
  1.  ;
  1. HASND(X,T) ;DOES THIS PATIENT HAVE THIS ONE WITH NO DATE BEGUN?
  1.  NEW Y,G
  1.  S G=0
  1.  S Y=0 F  S Y=$O(^AUPNREP(X,2101,Y)) Q:Y'=+Y  I $P(^AUPNREP(X,2101,Y,0),U,1)=T,$P(^AUPNREP(X,2101,Y,0),U,2)="" S G=1
  1.  Q G
  1. NEWVAL(E) ;
  1.  NEW X,Y,BJPCTEXT,BJPCY
  1.  S Y=""
  1.  S BJPCTEXT="CMMAP" F BJPCY=1:1 S X=$T(@BJPCTEXT+BJPCY) Q:$P(X,";;",2)=""!(Y]"")  I $P(X,";;",2)=E S Y=$P(X,";;",3)_U_$P(X,";;",4)
  1.  Q Y
  1.  ;
  1. CMMAP ;;
  1.  ;;ABSTINENCE;;ABSTINENCE
  1.  ;;HORMONE INJECTION;;HORMONAL/DEPO PROVERA
  1.  ;;HORMONAL IMPLANT;;HORMONAL/IMPLANT
  1.  ;;MENOPAUSE;;NA MENOPAUSE
  1.  ;;EDUCATION ONLY;;OTHER;;1
  1.  ;;ORAL CONTRACEPTIVES;;OTHER;;1
  1.  ;;IUD;;OTHER;;1
  1.  ;;BARRIER METHODS;;OTHER;;1
  1.  ;;OTHER;;OTHER
  1.  ;;NATURAL TECHNIQUES;;PERIODIC ABSTINENCE METHODS
  1.  ;;SURGICAL STERILIZATION;;STERILIZATION (FEMALE)
  1.  ;;PARTNER STERILIZED;;STERILIZATION (MALE)
  1.  ;;NONE;;NONE
  1.  ;;