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

BDMPOST.m

Go to the documentation of this file. 
  1. BDMPOST ; cmi/anch/maw - POST INIT ROUTINE ; [ 08/23/2006  3:21 PM ]
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**1**;AUG 11, 2006
  1.  ;
  1. ENV ;EP;
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  F X="XPM1","XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  ;I '$$INSTALLD("ACM*2.0*6") D SORRY(2)
  1.  Q
  1. EN D REGISTER
  1.  Q
  1. REGISTER ;CREATE QMAN REGISTER ENTRY
  1.  Q:$D(^AMQQ(7,"B","REGISTER",52))&$D(^AMQQ(5,6,"B","CMS REGISTER"))&$D(^AMQQ(5,6,"B","REGISTER"))
  1.  N J
  1.  S Z="RTEXT"
  1.  F J=1:1 S X=$T(@Z+J) Q:X["END"  D
  1.  .S X=$P(X,";;",2)
  1.  .S J=J+1
  1.  .S Y=$T(RTEXT+J)
  1.  .S Y=$P(Y,";;",2)
  1.  .S @X=Y
  1.  Q
  1. ACM421 ;EP;TO CHECK RG MULTIPLE NODE OF THE CMS COMPLICATIONS LIST FILE
  1.  ;AND ADD 2000 DIABETES AUDIT TO 'BDMMENU'
  1.  N X,Y,Z
  1.  S X=0
  1.  F  S X=$O(^ACM(42.1,X)) Q:'X  D
  1.  .I $D(^ACM(42.1,X,"RG",0)) S $P(^ACM(42.1,X,"RG",0),U)="",$P(^(0),U,2)="9002241.11P"
  1.  S DA(1)=$O(^DIC(19,"B","BDMMENU",0))
  1.  S X=$O(^DIC(19,"B","APCL M MAIN DM MENU",0))
  1.  Q:'DA(1)!'X
  1.  D:'$D(^DIC(19,DA(1),10,"B",X))
  1.  .K DD,DO
  1.  .S DIC="^DIC(19,DA(1),10,"
  1.  .S DIC(0)="L"
  1.  .S DIC("DR")="2////DA"
  1.  .D FILE^DICN
  1.  S DA=$O(^DIC(19,"B","BDM DIABETES AUDIT",0))
  1.  Q:'DA
  1.  S DA=$O(^DIC(19,DA(1),10,"B",DA,0))
  1.  Q:'DA
  1.  S DIK="^DIC(19,"_DA(1)_",10,"
  1.  D ^DIK
  1.  K DA,DIK,DIC,DR
  1.  Q
  1. P2 ;EP;
  1.  I $G(^DIC(2160032,0))["DMS LETTERS" K ^DIC(2160032),^DD(2160032)
  1.  D NEWOP
  1.  D PP
  1.  D COMP
  1.  D DMLAB
  1. P3 ;EP;
  1. P4 ;EP;
  1.  D NEWOP
  1. P5 ;EP;
  1.  D NEWOP
  1.  D ^BDMBUL
  1.  Q
  1.  ;
  1. P6 ;EP;
  1.  F BDMX="BDM SELF MONITORING REPORT" D
  1.  .S BDMY="SMR"
  1.  .S X=$$ADD^XPDMENU("BDM REPORTS",BDMX,BDMY)
  1.  ;
  1.  ;
  1.  ;NEW TAXONOMY MENU OPTION
  1.  ;F BDMX="BDM TAXONOMY SETUP" D
  1.  ;.S BDMY="TMS"
  1.  ;.S X=$$ADD^XPDMENU("BDM REGISTER MAINTENANCE",BDMX,BDMY)
  1.  ;
  1.  F BDMX="APCL DM2005 DM AUDIT TAX CHECK" D
  1.  .S BDMY="D5TC"
  1.  .S X=$$ADD^XPDMENU("BDM TAXONOMY SETUP",BDMX,BDMY)
  1.  ;
  1.  F BDMX="APCL DM2005 AUDIT TAX UPDATE" D
  1.  .S BDMY="D5TU"
  1.  .S X=$$ADD^XPDMENU("BDM TAXONOMY SETUP",BDMX,BDMY)
  1.  ;
  1.  F BDMX="APCL DM2005 PREDIAB TAX CHECK" D
  1.  .S BDMY="PDTC"
  1.  .S X=$$ADD^XPDMENU("BDM TAXONOMY SETUP",BDMX,BDMY)
  1.  ;
  1.  F BDMX="APCL DM2005 PREDIAB TAX UPDATE" D
  1.  .S BDMY="PDTU"
  1.  .S X=$$ADD^XPDMENU("BDM TAXONOMY SETUP",BDMX,BDMY)
  1.  ;
  1.  ;
  1.  ;S BDMNAME="BDM TAXONOMY SETUP"
  1.  ;S BDMOPT=$O(^DIC(19,"B",BDMNAME,0)) Q:'BDMOPT
  1.  ;S DIE="^DIC(19,",DA=BDMOPT,DR="15////@;20////@"
  1.  ;D ^DIE K DIE,DR,DA
  1.  ;
  1.  ;D ^BDMBUL6
  1.  ;
  1. NEWOPT2 ;MODIFY MAIN MENU EXIT ACTION
  1.  ;
  1.  S BDMNAME="BDMMENU"
  1.  S BDMOPT=$O(^DIC(19,"B",BDMNAME,0)) Q:'BDMOPT
  1.  S DIE="^DIC(19,",DA=BDMOPT,DR="15////"_"D ^BDMKILL"
  1.  D ^DIE K DIE,DR,DA
  1.  Q
  1.  ;
  1. NEWOP ;ADD NEW OPTIONS
  1.  F BDMX="BDM EDIT PCP" D
  1.  .S BDMY="PCP"
  1.  .S X=$$ADD^XPDMENU("BDM REGISTER MAINTENANCE",BDMX,BDMY)
  1.  Q
  1. DMLAB ;EP;TO UPDATE PRIMARY PROVIDER AND DM LAB VALUES
  1.  S BDMX="DMS DIABETES LAB REPORT"
  1.  I $D(^APCHSCTL("B",BDMX)) S BDMDA=$O(^APCHSCTL("B",BDMX,0))
  1.  Q:'$G(BDMDA)
  1.  D DMLAB^BDMFUTIL
  1.  Q
  1. PP ;EP;TO SYNCHRONIZE PRIMARY PROVIDER WITH FILE 9000001
  1.  Q:$G(^DD(9000001,.14,0))'[200
  1.  S BDMDA=0
  1.  F  S BDMDA=$O(^ACM(41,BDMDA)) Q:'BDMDA  D
  1.  .W "."
  1.  .S PAT=$P(^ACM(41,BDMDA,0),U,2)
  1.  .Q:'PAT
  1.  .S PP=$P($G(^ACM(41,BDMDA,"DT")),U,15)
  1.  .Q:'PP
  1.  .S PPP=$P($G(^AUPNPAT(PAT,0)),U,14)
  1.  .Q:'PPP
  1.  .Q:PP=PPP
  1.  .W "."
  1.  .S DA=BDMDA
  1.  .S DIE="^ACM(41,"
  1.  .S DR="15////"_PPP
  1.  .D DIE^BDMFDIC
  1.  Q
  1. COMP ;EP;TO ELIMINATE DUPLICATE COMPLICATIONS
  1.  F BDMX="CVA (STROKE)","END STAGE RENAL DISEASE","FIXED PROTEINURIA","HIGH RISK FOOT","HYPERTENSION","LASER TX FOR RETINOPATHY","MAJOR AMPUTATION(S)","MINOR AMPUTATION(S)","RETINOPATHY" D
  1.  .S (BDMY,BDMZ)=$O(^ACM(42.1,"B",BDMX,0))
  1.  .Q:'BDMY
  1.  .F  S BDMZ=$O(^ACM(42.1,"B",BDMX,BDMZ)) Q:'BDMZ  D
  1.  ..S BDMDA=0
  1.  ..F  S BDMDA=$O(^ACM(42,"B",BDMZ,BDMDA)) Q:'BDMDA  D
  1.  ...S DA=BDMDA
  1.  ...S DIE="^ACM(42,"
  1.  ...S DR=".01///"_BDMY
  1.  ...W "."
  1.  ...D DIE^BDMFDIC
  1.  ..S DA=BDMZ
  1.  ..S DIK="^ACM(42.1,"
  1.  ..W "."
  1.  ..D DIK^BDMFDIC
  1.  Q
  1. RTEXT ;;
  1.  ;;^AMQQ(5,6,0)
  1.  ;;REGISTER^^^52^40^^^^P
  1.  ;;^AMQQ(5,6,1,0)
  1.  ;;^9009075.01^2^2
  1.  ;;^AMQQ(5,6,1,1,0)
  1.  ;;REGISTER
  1.  ;;^AMQQ(5,6,1,2,0)
  1.  ;;CMS REGISTER
  1.  ;;^AMQQ(5,6,1,"B","CMS REGISTER",2)
  1.  ;;
  1.  ;;^AMQQ(5,6,1,"B","REGISTER",1)
  1.  ;;
  1.  ;;^AMQQ(5,"C","CMS REGISTER",6,2)
  1.  ;;
  1.  ;;^AMQQ(5,"C","REGISTER",6,1)
  1.  ;;
  1.  ;;^AMQQ(7,52,0)
  1.  ;;REGISTER
  1.  ;;^AMQQ(7,"B","REGISTER",52)
  1.  ;;
  1.  ;;END
  1.  ;
  1. INSTALLD(BDMSTAL) ;EP - Determine if patch BDMSTAL was installed, where
  1.  ; BDMSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  NEW BDMY,DIC,X,Y
  1.  S X=$P(BDMSTAL,"*",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(BDMSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(BDMSTAL,"*",3)
  1.  D ^DIC
  1.  S BDMY=Y
  1.  D IMES
  1.  Q $S(BDMY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_BDMSTAL_""" 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. V2POST ;EP - called from post init of kids build
  1.  NEW X
  1.  S X=$O(^ACM(58.1,"B","Case Comments",0))
  1.  I X S DA=X,DIE="^ACM(58.1,",DR=".11///@" D ^DIE K DIE,DA,DR
  1.  S X=$O(^ACM(58.1,"B","Care Plan Comment",0))
  1.  I X S DA=X,DIE="^ACM(58.1,",DR=".11///CP" D ^DIE K DIE,DA,DR
  1.  S X=$O(^ACM(58.1,"B","Complication Comments",0))
  1.  I X S DA=X,DIE="^ACM(58.1,",DR=".11///CMP" D ^DIE K DIE,DA,DR
  1.  S X=$O(^ACM(58.1,"B","Complication Onset Dt",0))
  1.  I X S DA=X,DIE="^ACM(58.1,",DR=".11///CMP" D ^DIE K DIE,DA,DR
  1.  D ^BDMBUL
  1.  Q