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

APCL3P21.m

Go to the documentation of this file.
APCL3P21 ; IHS/BJI/GRL - V3.0 PATCH 21 ENV/PRE/P0ST  [ 01/16/05  2:03 PM ]
 ;;3.0;IHS PCC REPORTS;**21**;FEB 05, 1997
 ;;
 ; The following line prevents the "Disable Options..." and "Move
 ; Routines..." questions from being asked during the install.
 F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
 I '$$INSTALLD("ATX*5.1*10") D SORRY(2)
 I '$$INSTALLD("APCL*3.0*20") D SORRY(2)
 Q
 ;
PRE ;EP
 F DA=1:1:900 S DIK="^APCLVSTS(" D ^DIK
 ;kill off lister entries
 F DA=1:1:40 S DIK="^APCLRECD(" D ^DIK
 F DA=1:1:40 S DIK="^APCLDMTX(" D ^DIK
 F DA=1:1:40 S DIK="^APCLBMI(" D ^DIK
 F DA=1:1:40 S DIK="^APCLCNTL(" D ^DIK
 F DA=1:1:40 S DIK="^APCLPDES(" D ^DIK
 K ^APCLBMI("H")
 S DA=$O(^DIC(19,"B","APCL DM2005 RUN AUDIT",0)) I DA S DIE="^DIC(19,",DR="2///@" D ^DIE K DIE,DA,DR
 Q
POST ;EP
 D ^APCLD8PS
 ;
 D POST^APCLCART  ;CALIFORNIA REPORT
 D TAXREAD
 D SETTAXL
 D HOME^%ZIS,DT^DICRW
 ;
 NEW XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
 KILL ^TMP($J,"APCLBUL")
 D WRITEMSG,GETRECIP
 ;Change following lines as desired
SUBJECT S XMSUB="* * * IMPORTANT RPMS INFORMATION * * *"
SENDER S XMDUZ="Cimarron Medical Informatics"
 S XMTEXT="^TMP($J,""APCLBUL"",",XMY(1)="",XMY(DUZ)=""
 I $E(IOST)="C" W !,"Sending Mailman message to holders of the"_" "_APCLKEY_" "_"security key."
 D ^XMD
 KILL ^TMP($J,"APCLBUL"),APCLKEY
 Q
 ;
WRITEMSG ;
 S X=$O(^APCLPDES("B","V3P21",0))
 Q:'X
 S Y=0 F  S Y=$O(^APCLPDES(X,11,Y)) Q:Y'=+Y  S ^TMP($J,"APCLBUL",Y)=^APCLPDES(X,11,Y,0)
 Q
 ;
GETRECIP ;
 ;* * * Define key below to identify recipients * * *
 ;
 S CTR=0,APCLKEY="APCLZMENU"
 F  S CTR=$O(^XUSEC(APCLKEY,CTR)) Q:'CTR  S Y=CTR S XMY(Y)=""
 Q
INSTALLD(APCLSTAL) ;EP - Determine if patch APCLSTAL was installed, where
 ; APCLSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
 ;
 NEW APCLY,DIC,X,Y
 S X=$P(APCLSTAL,"*",1)
 S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
 D IX^DIC
 I Y<1 D IMES Q 0
 S DIC=DIC_+Y_",22,",X=$P(APCLSTAL,"*",2)
 D ^DIC
 I Y<1 D IMES Q 0
 S DIC=DIC_+Y_",""PAH"",",X=$P(APCLSTAL,"*",3)
 D ^DIC
 S APCLY=Y
 D IMES
 Q $S(APCLY<1:0,1:1)
IMES ;
 D MES^XPDUTL($$CJ^XLFSTR("Patch """_APCLSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
 Q
SORRY(X) ;
 KILL DIFQ
 I X=3 S XPDQUIT=2 Q
 S XPDQUIT=X
 W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
 Q
TAXREAD ;
 S APCLPNSP=""
 S APCLTEXT="TAX" F APCLX=1:1 S APCLDATA=$P($T(@APCLTEXT+APCLX),";;",2) Q:APCLDATA=""  D
 .S APCLDA=$O(^ATXAX("B",$P(APCLDATA,"|"),0))
 .Q:APCLDA=""
 .S $P(^ATXAX(APCLDA,0),U,4)="n" W !,$P(APCLDATA,"|")  ;SET NO DELETE
 .S $P(^ATXAX(APCLDA,0),U,22)=$P(APCLDATA,"|",2) ;set read only
 .;set packages in multiple
 .K DIC,DA,DR
 .S APCLP=$P(APCLDATA,"|",3)
 .F APCLN=1:1 S APCLPP=$P(APCLP,"*",APCLN) Q:APCLPP=""  D
 ..S APCLPI=$O(^DIC(9.4,"C",APCLPP,0))
 ..Q:APCLPI=""  ;NO PACKAGE
 ..S X="`"_APCLPI,DIC="^ATXAX("_APCLDA_",41,",DIC(0)="L",DIC("P")=$P(^DD(9002226,4101,0),U,2),DA(1)=APCLDA
 ..D ^DIC
 ..I Y=-1 W !,"updating package multiple for ",APCLPP," entry ",$P(^ATXAX(APCLDA,0),U)," failed"
 ..K DIC,DA,Y,X
 .Q
 Q
SETTAXL ;
 ;Q:'$D(^DD(9002228,4101,0))  ;taxonomy patch not yet installed
 S APCLTEXT="LABTAX" F APCLX=1:1 S APCLDATA=$P($T(@APCLTEXT+APCLX),";;",2) Q:APCLDATA=""  D
 .S APCLDA=$O(^ATXLAB("B",$P(APCLDATA,"|"),0))
 .Q:APCLDA=""
 .S $P(^ATXLAB(APCLDA,0),U,4)="n" W !,$P(APCLDATA,"|")  ;SET NO DELETE
 .S $P(^ATXLAB(APCLDA,0),U,22)=$P(APCLDATA,"|",2) ;set read only
 .S $P(^ATXLAB(APCLDA,0),U,11)=$P(APCLDATA,"|",4) ;set panel yes/no
 .;set packages in multiple
 .K DIC,DA,DR
 .S APCLP=$P(APCLDATA,"|",3)
 .F APCLN=1:1 S APCLPP=$P(APCLP,"*",APCLN) Q:APCLPP=""  D
 ..S APCLPI=$O(^DIC(9.4,"C",APCLPP,0))
 ..Q:APCLPI=""  ;NO PACKAGE
 ..S X="`"_APCLPI,DIC="^ATXLAB("_APCLDA_",41,",DIC(0)="L",DIC("P")=$P(^DD(9002228,4101,0),U,2),DA(1)=APCLDA
 ..D ^DIC
 ..I Y=-1 W !,"updating package multiple for ",APCLPP," entry ",$P(^ATXLAB(APCLDA,0),U)," failed"
 ..K DIC,DA,Y,X
 .Q
 Q
TAX ;
 ;;DM AUDIT INCRETIN MIMETIC|0|APCL*BDM
 ;;DM AUDIT DPP4 INHIBITOR DRUGS|0|APCL*BDM
 ;;DM AUDIT P/C RATIO LOINC|1|APCL*BDM
 ;;DM AUDIT P/C RATIO TAX|0|APCL*BDM
 ;;DM AUDIT A/C RATIO TAX|0|APCL*BDM
 ;;APCL DIABETES REG COMPLICATION|0|APCL*BDM
 ;;APCL DIABETES REG NEW CASE|0|APCL*BDM
 ;;DM AUDIT 75GM 2HR LOINC|1|APCL*APCH*BDM
 ;;DM AUDIT A/C RATIO LOINC|1|APCL*BDM
 ;;DM AUDIT ACARBOSE DRUGS|0|APCL*BDM
 ;;DM AUDIT ACE INHIBITORS|0|APCL*BDM
 ;;DM AUDIT ANTI-PLATELET DRUGS|0|APCL*BDM
 ;;DM AUDIT ASPIRIN DRUGS|0|APCL*BDM
 ;;DM AUDIT CESSATION HLTH FACTOR|0|APCL*BDM
 ;;DM AUDIT DENTAL EXAM ADA CODES|0|APCL*BDM
 ;;DM AUDIT DEPRESSIVE DISORDERS|1|APCL*BDM
 ;;DM AUDIT DIABETES EDUC TOPICS|0|APCL*BDM
 ;;DM AUDIT DIET EDUC TOPICS|0|APCL*BDM
 ;;DM AUDIT EKG CPTS|1|APCL*BDM
 ;;DM AUDIT ESTIMATED GFR LOINC|1|APCL*APCH
 ;;DM AUDIT EXCERCISE EDUC TOPICS|0|APCL*BDM
 ;;DM AUDIT EXERCISE EDUC TOPICS|0|APCL*BDM
 ;;DM AUDIT EYE EXAM DXS|1|APCL*BDM
 ;;DM AUDIT FASTING GLUC LOINC|1|APCL*APCH*BDM
 ;;DM AUDIT FLU CPTS|1|APCL*BDM
 ;;DM AUDIT INSULIN DRUGS|0|APCL*BDM
 ;;DM AUDIT LIPID LOWERING DRUGS|0|APCL*BDM
 ;;DM AUDIT MAMMOGRAM CPTS|1|APCL*BDM
 ;;DM AUDIT METFORMIN DRUGS|0|APCL*BDM
 ;;DM AUDIT ORAL HYPOGLYCEMICS|0|APCL*BDM
 ;;DM AUDIT OTHER EDUC TOPICS|0|APCL*BDM
 ;;DM AUDIT PAP CPTS|1|APCL*BDM
 ;;DM AUDIT PERIDONTAL ADA CODES|0|APCL*BDM
 ;;DM AUDIT PNEUMO CPTS|1|APCL*BDM
 ;;DM AUDIT PRE-DIABETES DXS|1|APCL*BDM*APCH
 ;;DM AUDIT PROBLEM DIABETES DX|1|APCL*BDM
 ;;DM AUDIT PROBLEM HTN DIAGNOSES|1|APCL*BDM
 ;;DM AUDIT PROBLEM SMOKING DXS|1|APCL*BDM
 ;;DM AUDIT PROBLEM TB DXS|1|APCL*BDM
 ;;DM AUDIT SDM PROVIDERS|0|APCL*BDM
 ;;DM AUDIT SELF MONITOR DRUGS|0|APCL*BDM
 ;;DM AUDIT SMOKING CESS EDUC|0|APCL*BDM
 ;;DM AUDIT SMOKING RELATED DXS|1|APCL*BDM
 ;;DM AUDIT STATIN DRUGS|0|APCL*BDM
 ;;DM AUDIT SULFONYLUREA DRUGS|0|APCL*BDM
 ;;DM AUDIT TB HEALTH FACTORS|0|APCL*BDM
 ;;DM AUDIT TD CPTS|1|APCL*BDM
 ;;DM AUDIT TOBACCO HLTH FACTORS|0|APCL*BDM
 ;;DM AUDIT GLITAZONE DRUGS|0|APCL*BDM
 ;;DM AUDIT TYPE I DXS|1|APCL*BDM
 ;;DM AUDIT TYPE II DXS|1|APCL*BDM
 ;;DM AUDIT MICROALBUMIN LOINC CODES|1|APCL*BDM
 ;;DM AUDIT URINALYSIS LOINC|1|APCL*BDM
 ;;DM AUDIT URINE PROTEIN LOINC|1|APCL*BDM
 ;;APCL CAR CNM|0|APCL
 ;;APCL CAR DENTISTS|0|APCL
 ;;APCL CAR FNP|0|APCL
 ;;APCL CAR LCSW|0|APCL
 ;;APCL CAR LVN|0|APCL
 ;;APCL CAR OTHER PROVIDERS|0|APCL
 ;;APCL CAR OTHER2|0|APCL
 ;;APCL CAR PA|0|APCL
 ;;APCL CAR PHYSICIANS|0|APCL
 ;;APCL CAR PSYCHIATRIST|0|APCL
 ;;APCL CAR PSYCHOLOGIST|0|APCL
 ;;APCL CAR PT ED|0|APCL
 ;;APCL CAR RDA|0|APCL
 ;;APCL CAR RN|0|APCL
 ;;
LABTAX ;;
 ;;APCH HCT/HGB TESTS|0|APCH|1
 ;;BGP QUANT URINE PROTEIN|0|APCL*BDM*BGP|1
 ;;DM AUDIT 2 HR GTT TAX|0|APCL*BDM|1
 ;;DM AUDIT LIPID PROFILE TAX|0|APCL*BDM|1
 ;;DM AUDIT PAP SMEAR TAX|0|APCL*BDM|1
 ;;DM AUDIT URINALYSIS TAX|0|APCL*BDM|1
 ;;