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

BDMFUTIL.m

Go to the documentation of this file. 
  1. BDMFUTIL ; IHS/CMI/LAB - DMS UTILITY PROGRAM ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,8**;JUN 14, 2007;Build 53
  1.  ;UTILITY PROGRAM
  1.  ;LOCATION FOR VARIOUS UTILITY FUNCTIONS
  1. TAX ;EP;TAXONOMY MANAGEMENT
  1.  F  D TAX1 Q:$D(BDMQUIT)!$D(BDMOUT)
  1. TAXEXIT K BDMQUIT,BDMOUT
  1.  Q
  1. TAX1 D TAXHEAD
  1.  S DIR(0)="SO^1:Diagnostic/Treatment Taxonomies;2:Lab Taxonomies"
  1.  S DIR("A")="Which one"
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  I Y=1 D TAXRX Q
  1.  I Y=2 D TAXLAB Q
  1.  Q
  1. TAXRX ;PROCESS DX/TX TAXONOMIES
  1.  S DIR(0)="SO^1:Diagnosis;2:ADA Code;3:Medication;4:Procedure (Medical);5:Patient Education Topic;6:Health Factors;7:Problem List Diagnosis"
  1.  S DIR("A")="Which one"
  1.  D DIR^BDMFDIC
  1.  I Y<1 K BDMQUIT Q
  1.  I Y=1 S BDMX="DIAGNOSIS"
  1.  I Y=2 S BDMX="ADA CODE"
  1.  I Y=3 S BDMX="RX"
  1.  I Y=4 S BDMX="PROCEDURE (MEDICAL)"
  1.  I Y=5 S BDMX="PATIENT ED TOPIC"
  1.  I Y=6 S BDMX="HEALTH FACTORS"
  1.  I Y=7 S BDMX="PROBLEM LIST DIAGNOSIS"
  1.  S X=$O(^AMQQ(5,"B",BDMX,""))
  1.  I 'X D  Q
  1.  .W !!,"A taxonomy can not be created for this attribute.  Ask your"
  1.  .W !,"system manager to add ",BDMX," as an attribute then try again."
  1.  S AMQQATNM=Y(0)
  1.  S AMQQATN=X
  1.  S AMQQLINK=$P(^AMQQ(5,X,0),U,5)
  1.  Q
  1. TAXLAB ;PROCESS LAB TAXONOMIES
  1.  Q
  1. TAXHEAD ;PRINT HEADER FOR TAXONOMY MANAGEMENT
  1.  W @IOF
  1.  N X
  1.  F X="DIABETES MANAGEMENT SYSTEM","TAXONOMY MANAGEMENT" D
  1.  .W !?(80-$L(X))\2,X
  1.  Q
  1. SORT ;EP;FOR AUTO ADD OF NEW CMS SORT CRITERIA
  1.  S X="PRIMARY PROVIDER"
  1.  Q:$O(^ACM(48.5,"B",X,0))
  1.  S DIC="^ACM(48.5,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")="1////P;4////ACM(41,;7////VA(200,"
  1.  D FILE^BDMFDIC
  1.  Q:+Y<1
  1.  S BDMDA=+Y
  1.  S ^ACM(48.5,BDMDA,1)="S ACMVAL=$P($G(^ACM(41,ACMRGDFN,""DT"")),U,15) Q:'ACMVAL  S ACMVAL=$P($G(^VA(200,ACMVAL,0)),U)"
  1.  S ^ACM(48.5,BDMDA,3)="PRIMARY PROVIDER"
  1.  S $P(^ACM(48.5,BDMDA,2,0),U,2)="9002248.51P"
  1.  F BDMX="RECALL DATES","MASTER LIST","CASE REVIEW DATE","REGISTER DATA","MULTIPLE SUMMARIES","PCC HS MULTIPLE","RECALL LETTERS" D
  1.  .S X="ACM "_BDMX
  1.  .S DIC("DR")="1////"_X
  1.  .S X=$O(^DIPT("B",X,0))
  1.  .Q:'X
  1.  .S (DA,DA(1))=BDMDA
  1.  .S DIC="^ACM(48.5,"_DA_",2,"
  1.  .S DIC(0)="L"
  1.  .D FILE^BDMFDIC
  1.  Q
  1. IDDM ;EP;TO SYNCHRONIZE DIABETES DIAGNOSES
  1.  N BDM,DR
  1.  S BDMX=""
  1.  F  S BDMX=$O(^ACM(44.1,BDMX)) Q:BDMX=""  D:BDMX["IDDM"
  1.  .S BDM=0
  1.  .F  S BDM=$O(^ACM(44.1,"G",BDMX,BDM)) Q:'BDM  D
  1.  ..K DR
  1.  ..I $P($G(^ACM(44.1,BDM)),U)="IDDM" S DR=".01///TYPE 1"
  1.  ..I $P($G(^ACM(44.1,BDM)),U)="NIDDM" S DR=".01///TYPE 2"
  1.  ..Q:$G(DR)=""
  1.  ..S DA=BDM
  1.  ..S DIE="^ACM(44.1,"
  1.  ..D DIE^BDMFDIC
  1.  Q:'BDMRDA
  1.  F BDMX="TYPE 1","TYPE 2","IMPAIRED GLUCOSE TOLERANCE","GESTATIONAL DM" D
  1.  .S BDMDA=0
  1.  .F  S BDMDA=$O(^ACM(44.1,"B",BDMX,BDMDA)) Q:'BDMDA  D
  1.  ..Q:$D(^ACM(44.1,BDMDA,"RG","B",BDMRDA))
  1.  ..S X=BDMRDA
  1.  ..S (DA,DA(1))=BDMDA
  1.  ..S DIC="^ACM(44.1,"_BDMDA_",""RG"","
  1.  ..S DIC(0)="L"
  1.  ..S $P(^ACM(44.1,BDMDA,"RG",0),U,2)="9002244.11P"
  1.  ..D FILE^BDMFDIC
  1.  Q
  1. SWITCH ;EP;TO SWITCH REGISTERS
  1.  K BDMRDA,BDM("REGISTER")
  1.  D REG
  1.  I $D(BDMONE) D
  1.  .W !!,"If there are other DIABETES registers you need access to,"
  1.  .W !,"contact your DIABETES system manager for assistance.",!!
  1.  .H 5
  1.  .K BDMONE
  1.  Q
  1. REG ;EP;TO SET REGISTER DATA     
  1.  K BDMQUIT
  1.  I $G(BDMRDA)&($G(BDMREGNM)["") Q
  1.  D REGLIST
  1.  Q:$D(BDMQUIT)
  1.  I $D(BDMNOREG) D NEWREG K BDMNOREG G REG
  1.  Q:$D(BDMQUIT)
  1.  D DECEASED^ACMGTP(BDMRDA)
  1.  D REGVARS
  1.  D MM^BDMFMENU
  1.  Q
  1. REGVARS ;SET REGISTER VARIABLES
  1.  S BDMREGNM=$P(^ACM(41.1,BDMRDA,0),U)
  1.  D NEWHS
  1.  D IDDM
  1.  D NEWDIAG
  1.  D NEWCOMP
  1.  Q
  1. NEWREG ;CREATE IHS DIABETES REGISTER
  1.  S X="IHS DIABETES REGISTER"
  1.  I $D(^ACM(41.1,"B",X)) S BDMRDA=$O(^(X,0)) Q:BDMRDA
  1.  S DIC="^ACM(41.1,"
  1.  S DIC(0)="L"
  1.  D FILE^BDMFDIC
  1.  S BDMRDA=+Y
  1.  Q
  1. NEWDIAG ;ESTABLISH IHS DIABETES REGISTER DIAGNOSES
  1.  F BDMX="TYPE 1","TYPE 2","GESTATIONAL DM","IMPAIRED GLUCOSE TOLERANCE" D
  1.  .S BDMY=$O(^ACM(44.1,"B",BDMX,0))
  1.  .I BDMY,$D(^ACM(44.1,BDMY,"RG","B",BDMRDA)) Q
  1.  .S X=BDMX
  1.  .S DIC="^ACM(44.1,"
  1.  .S DIC(0)="L"
  1.  .D FILE^BDMFDIC
  1.  .S X=BDMRDA
  1.  .S DA=+Y
  1.  .S DA(1)=+Y
  1.  .S $P(^ACM(44.1,BDMY,"RG",0),U,2)="9002244.11P"
  1.  .S DIC="^ACM(44.1,"_DA_",""RG"","
  1.  .S DIC(0)="L"
  1.  .D FILE^BDMFDIC
  1.  Q
  1. NEWCOMP ;ESTABLISH IHS DIABETES REGISTER COMPLICATIONS
  1.  S:'$G(BDMRDA) BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
  1.  Q:'BDMRDA
  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=$O(^ACM(42.1,"B",BDMX,0))
  1.  .I BDMY,$D(^ACM(42.1,BDMY,"RG","B",BDMRDA)) Q
  1.  .I 'BDMY D
  1.  ..S X=BDMX
  1.  ..S DIC="^ACM(42.1,"
  1.  ..S DIC(0)="L"
  1.  ..D FILE^BDMFDIC
  1.  ..S BDMY=+Y
  1.  .S X=BDMRDA
  1.  .S DA(1)=BDMY
  1.  .S $P(^ACM(42.1,BDMY,"RG",0),U,2)="9002242.11P"
  1.  .S DIC="^ACM(42.1,"_BDMY_",""RG"","
  1.  .S DIC(0)="L"
  1.  .D FILE^BDMFDIC
  1.  Q
  1. NEWHS ;ESTABLISH NEW HEALTH SUMMARIES FOR DMS
  1.  N BDMX,BDMDA
  1.  F BDMX="DMS LAB REPORT","DMS DIABETES LAB REPORT","DMS DIABETIC FLOWSHEET" D
  1.  .S BDMDA=""
  1.  .I $D(^APCHSCTL("B",BDMX)) S BDMDA=$O(^APCHSCTL("B",BDMX,0))
  1.  .I '$G(BDMDA) D
  1.  ..S X=BDMX
  1.  ..S DIC="^APCHSCTL("
  1.  ..S DIC(0)="LZ"
  1.  ..D FILE^BDMFDIC
  1.  ..S BDMDA=+Y
  1.  .Q:BDMDA<1
  1.  .I BDMX["LAB REPORT" D LAB
  1.  .I BDMX["FLOWSHEET" D FS
  1.  Q
  1. LAB S X=$O(^APCHSCMP("B","LABORATORY DATA",0))
  1.  Q:'X
  1.  K BDMQUIT
  1.  S Y=0
  1.  F  S Y=$O(^APCHSCTL(BDMDA,1,Y)) Q:'Y  D
  1.  .I $P($G(^APCHSCTL(BDMDA,1,Y,0)),U,2)=X S BDMQUIT=""
  1.  I $D(BDMQUIT) K BDMQUIT Q
  1.  S $P(^APCHSCTL(BDMDA,1,0),U,2)="9001015.01IA"
  1.  S (DA,DA(1))=BDMDA
  1.  S DIC="^APCHSCTL("_DA_",1,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")="1////"_X_";2////30;3////1Y"
  1.  S X=5
  1.  D FILE^BDMFDIC
  1.  Q:Y<1
  1.  D DMLAB:BDMX["DIABETES LAB"
  1.  Q
  1. FS S X=$O(^APCHSCMP("B","FLOWSHEETS",0))
  1.  Q:'X
  1.  K BDMQUIT
  1.  S Y=0
  1.  F  S Y=$O(^APCHSCTL(BDMDA,1,Y)) Q:'Y  D
  1.  .I $P($G(^APCHSCTL(BDMDA,1,Y,0)),U,2)=X S BDMQUIT=""
  1.  I $D(BDMQUIT) K BDMQUIT Q
  1.  S $P(^APCHSCTL(BDMDA,1,0),U,2)="9001015.01IA"
  1.  S (DA,DA(1))=BDMDA
  1.  S DIC="^APCHSCTL("_DA_",1,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")="1////"_X_";2////10;3////1Y"
  1.  S X=5
  1.  D FILE^BDMFDIC
  1.  Q:Y<1
  1.  S X=$O(^APCHSFLC("B","DIABETIC FLOWSHEET",0))
  1.  Q:'X
  1.  K BDMQUIT
  1.  S Y=0
  1.  F  S Y=$O(^APCHSCTL(BDMDA,6,Y)) Q:'Y  D
  1.  .I $P($G(^APCHSCTL(BDMDA,6,Y,0)),U,2)=X S BDMQUIT=""
  1.  I $D(BDMQUIT) K BDMQUIT Q
  1.  S (DA,DA(1))=BDMDA
  1.  S $P(^APCHSCTL(DA,6,0),U,2)="9001015.07IA"
  1.  S DIC="^APCHSCTL("_DA_",6,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")="1////"_X
  1.  S X=5
  1.  D FILE^BDMFDIC
  1.  Q
  1. DMLAB ;EP;SET DM LABS
  1.  S BDMJ=0
  1.  F BDMX="FASTING GTT","1/2Hr.GTT","1Hr.GTT","2Hr.GTT","3Hr.GTT","4Hr.GTT","5Hr.GTT","6Hr.GTT","FASTING GTT (URINE)","1/2Hr.GTT (URINE)","1Hr.GTT (URINE)","2Hr.GTT (URINE)","3Hr.GTT (URINE)","4Hr.GTT (URINE)","5Hr.GTT (URINE)" D D1
  1.  F BDMX="6Hr.GTT (URINE)","GLUCOSE","GLUCOSE TOLERANCE TEST","GLUCOSE, OTHER","GLUCOSE TOLERANCE (URINE)","HEMOGLOBIN A1C","SGOT","SGPT","TRIGLYCERIDE","LDL","HDL","CHOLESTEROL","LDL CHOLESTEROL" D D1
  1.  Q
  1. D1 S X=$O(^LAB(60,"B",BDMX,0))
  1.  Q:'X
  1.  Q:$D(^APCHSCTL(BDMDA,4,"C",X))
  1.  S BDMJ=BDMJ+1
  1.  S BDMLAB=X
  1.  S X=$S($O(^APCHSCTL(BDMDA,4,99999),-1):$O(^APCHSCTL(BDMDA,4,99999),-1),1:1)
  1.  S $P(^APCHSCTL(BDMDA,4,0),U,2)="9001015.05IA"
  1.  S (DA,DA(1))=BDMDA
  1.  S DIC="^APCHSCTL("_DA_",4,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")="1////"_BDMLAB
  1.  D FILE^BDMFDIC
  1.  Q
  1. REGLIST ;EP;LIST DIABETES REGISTERS
  1.  K BDMQUIT
  1.  N J,X,Y,Z,BDM
  1.  S BDMNOREG=""
  1.  S J=0
  1.  S X=""
  1.  F  S X=$O(^ACM(41.1,"B",X)) Q:X=""  D
  1.  .X ^%ZOSF("UPPERCASE")
  1.  .Q:Y'["DIABET"
  1.  .K BDMNOREG
  1.  .S Y=0
  1.  .F  S Y=$O(^ACM(41.1,"B",X,Y)) Q:'Y  D
  1.  ..S BDMNOACC=1
  1.  ..Q:'$D(^ACM(41.1,+Y,"AU","B",DUZ))
  1.  ..K BDMNOACC
  1.  ..S J=J+1
  1.  ..S BDM(J)=Y_U_X
  1.  I '$O(BDM(0)) D  Q
  1.  .I $G(BDMNOACC) D  Q
  1.  ..W !!,"You do not have access to the DIABETES register."
  1.  ..W !,"Ask your Diabetes Management System coordinator for assistance."
  1.  ..S BDMQUIT="" H 5
  1.  .K BDMNOACC
  1.  K BDMQUIT
  1.  I '$O(BDM(1)) D  Q
  1.  .S BDMRDA=+BDM(1)
  1.  .W !!,"You have access to the ",$P(^ACM(41.1,BDMRDA,0),U)," register,"
  1.  .S BDMONE=""
  1.  W @IOF
  1.  W !!?5,"Select DIABETES Register"
  1.  W !!?5,"---",?10,"------------------------------"
  1.  S J=0
  1.  F  S J=$O(BDM(J)) Q:'J  D
  1.  .W !?5,J,?10,$P(BDM(J),U,2)
  1.  .S BDMJ=J
  1.  S DIR(0)="NO^1:"_BDMJ
  1.  S DIR("A")="Which REGISTER"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  S BDMRDA=+BDM(Y)
  1.  Q
  1. CHARTS ;EP;TO EXPORT CHART NUMBERS
  1.  K ^TMP("BDMCHART",$J)
  1.  W @IOF
  1.  S %FN="/usr/spool/uucppublic/dmschart.dat"
  1.  S BDMOP="W"
  1.  D HOST^BDMFZIS
  1.  I $D(BDMQUIT) D  Q
  1.  .W !!,"The file ",%FN," could not be created."
  1.  .W !,"Consult your site manager for assistance."
  1.  .D PAUSE^BDMFMENU
  1.  S ASUFAC=$S($L($P($G(^AUTTLOC($S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,10))=6:$P(^(0),U,10),1:"ASUFAC")
  1.  S BDMX="ANMC DIABETES REGISTRY"
  1.  S BDMRDA=0
  1.  F  S BDMRDA=$O(^ACM(41.1,"B",BDMX,BDMRDA)) Q:'BDMRDA  D
  1.  .S X=0
  1.  .F  S X=$O(^ACM(41,"B",BDMRDA,X)) Q:'X  D
  1.  ..Q:$E($G(^ACM(41,X,"DT")))'="A"
  1.  ..S DFN=$P($G(^ACM(41,X,0)),U,2)
  1.  ..S FAC=1665
  1.  ..Q:'$D(^AUPNPAT(+DFN,41,FAC,0))  S CHART=$P(^(0),U,2)
  1.  ..S CHART=$E("000000",1,6-$L(CHART))_CHART
  1.  ..S ^TMP("BDMCHART",$J,ASUFAC,BDMX,CHART)=""
  1.  ..S ^TMP("BDMCHART",$J,CHART)=""
  1.  D C1
  1.  D ^%ZISC
  1.  W !!,"The file 'dmschart.dat' has been filed in the /usr/spool/uucppublic/ directory."
  1.  D PAUSE^BDMFMENU
  1.  K ^TMP("BDMCHART",$J)
  1.  Q
  1. C1 ;
  1.  S XX="ASUFAC"
  1.  S $E(XX,10)="REGISTER"
  1.  S $E(XX,50)="CHART"
  1.  S XX="CHART NO."
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  S $E(XX,15)="File created on: "_Y
  1.  U IO W XX,!
  1.  S X=""
  1.  F  S X=$O(^TMP("BDMCHART",$J,X)) Q:X=""  D:X=""
  1.  .S Y=""
  1.  .F  S Y=$O(^TMP("BDMCHART",$J,X,Y)) Q:Y=""  D
  1.  ..S Z=""
  1.  ..F  S Z=$O(^TMP("BDMCHART",$J,X,Y,Z)) Q:Z=""  D
  1.  ...S XX=X
  1.  ...S $E(XX,10)=$E(Y,1,30)
  1.  ...S $E(XX,50)=Z
  1.  ...S XX=Z
  1.  ...U IO W XX,!
  1.  ...U 0 W "."
  1.  S Z=""
  1.  F  S Z=$O(^TMP("BDMCHART",$J,Z)) Q:Z=""  D
  1.  .U IO W Z,!
  1.  .U 0 W "."
  1.  Q