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

ACMADDM2.m

Go to the documentation of this file. 
  1. ACMADDM2 ; IHS/TUCSON/TMJ - CONTINUATION OF ADD IHS PRE-DIABETES REGISTER ; [ 10/17/05  11:49 AM ]
  1.  ;;2.0;ACM CASE MANAGEMENT SYSTEM;*6*;JAN 10, 1996
  1.  ;This routine allows the user to convert existing Pre-Diabetes Register data
  1.  ;to IHS standard data.
  1.  ;IHS/CMI/TMJ - PATCH #6 - INSTALL NEW PRE-DIABETES REGISTER
  1.  ;ROUTINE IS CALLED FROM ACMADDMP AND ENTERED VIA TAG CDIAG OR CCOMP
  1.  ;OR CRISK OR CDXCR - DX - COMPLICATIONS - RISK FACTORS - DX CRITERIA
  1.  Q
  1.  ;
  1. CDIAG ;EP;CONVERTS USER DIAGNOSES TO IHS STANDARD DIAGNOSES
  1.  W !,"I will now check your patient's diagnoses against the IHS standards:"
  1. SETD ;FINDS STANDARD DIAGNOSIS AND PUT IN ^TMP($J,"STD"   
  1.  K ACME S (ACMDIR,ACME)="" F I=1:1 S ACME=$T(DIAG+I^ACMRGA02) Q:ACME["*"  S ACME=$P(ACME,";;",3),ACMD="",ACMD=$O(^ACM(44.1,"B",ACME,ACMD)),^TMP($J,"STD",ACMD)=ACME,ACMDIR=ACMDIR_I_":"_ACME_";"
  1.  S ACMDIR=ACMDIR_I_":DELETE ENTIRELY;"
  1.  S ACMDIR=ACMDIR_(I+1)_":LEAVE AS IS"
  1.  ;
  1. FINDD ;FINDS REGISTER DIAGNOSIS AND PUT IN ^TMP($J,"REG"
  1.  S ACME="" F I=1:1 S ACME=$O(^ACM(44,"E",ACMRG,ACME)) Q:ACME=""  S ACMD=$P(^ACM(44,ACME,0),U,1) I '$D(^TMP($J,"STD",ACMD)) S:'$D(^TMP($J,"REG",ACMD)) ^TMP($J,"REG",ACMD)="" S ^TMP($J,"REG",ACMD,ACME)=ACME_U_ACMD_U_$P(^ACM(44.1,ACMD,0),U,1)
  1.  S ACMD="",ACMQ=0 F  S ACMD=$O(^TMP($J,"REG",ACMD)) Q:ACMD=""  D MATCHD Q:ACMQ
  1.  Q:ACMQ
  1.  D:$D(^TMP($J,"REG")) DIRYND
  1.  D END
  1.  Q
  1. DIRYND S DIR(0)="YO",DIR("A")="Are you ready to change your patient's diagnoses to the new diagnoses",DIR("B")="YES"
  1.  W ! D ^DIR K DIR Q:Y=0!(Y["^")  I Y=1 D CHGD
  1.  Q
  1. CHGD ;LOOPS AND CHANGES DIAGNOSES TO NEW VALUES
  1.  W !,"Changing diagnosis..." S ACMD="" F  S ACMD=$O(^TMP($J,"REG",ACMD)) Q:ACMD=""  D CHGD1
  1.  Q
  1. CHGD1 Q:^TMP($J,"REG",ACMD)="LEAVE AS IS"
  1.  I ^TMP($J,"REG",ACMD)="DELETE ENTIRELY" D CHGDD Q
  1.  S ACME="" F  S ACME=$O(^TMP($J,"REG",ACMD,ACME)) Q:ACME=""  S DIE="^ACM(44,",DA=ACME,DR=".01///^S X=^TMP($J,""REG"",ACMD);.04///^S X=ACMRG" D ^DIE K DA,DR W "."
  1.  K ^ACM(44,"AC") S DIK="^ACM(44,",DIK(1)=".04^AC" D ENALL^DIK K DIK
  1.  Q
  1.  ;
  1. CHGDD ;
  1.  S ACMX=0 F  S ACMX=$O(^ACM(44,"B",ACMD,ACMX)) Q:+ACMX=0  S DA=ACMX,DIK="^ACM(44," D ^DIK K DIK,DA W "."
  1.  S DIK="^ACM(44.1,"_ACMD_",""RG"",",DA(1)=ACMD,DA=ACMRG D ^DIK K DA,DA(1),DIK
  1.  I '$D(^ACM(44.1,ACMD,"RG","B")) S DIK="^ACM(44.1,",DA=ACMD D ^DIK K DA,DIK
  1.  Q
  1. MATCHD ;
  1.  W !,"Choose a new diagnosis from the list below:",!
  1.  W !,"for your diagnosis:  ",$P(^ACM(44.1,ACMD,0),U,1)
  1.  S DIR(0)="S^"_ACMDIR,DIR("A")="Choose a Diagnosis: " D ^DIR
  1.  I Y="" S ^TMP($J,"REG",ACMD)="LEAVE AS IS" Q
  1.  I Y["^" S ACMQ=1 Q
  1.  S ^TMP($J,"REG",ACMD)=Y(0) Q
  1.  Q
  1.  ;
  1. CCOMP ;EP;CONVERTS USER COMPLICATIONS TO IHS STANDARD COMPLICATIONS
  1.  W !,"I will now check your patient's complications against the IHS standards:"
  1.  ;
  1. SETC ;FINDS STANDARD COMPLICATIONS AND PUT IN ^TMP($J,"STD"   
  1.  K ACME S (ACMDIR,ACME)="" F I=1:1 S ACME=$T(COMP+I^ACMRGA02) Q:ACME["*"  S ACME=$P(ACME,";;",3),ACMD="",ACMD=$O(^ACM(42.1,"B",ACME,ACMD)),^TMP($J,"STD",ACMD)=ACME,ACMDIR=ACMDIR_I_":"_ACME_";"
  1.  S ACMDIR=ACMDIR_I_":DELETE ENTIRELY;"
  1.  S ACMDIR=ACMDIR_(I+1)_":LEAVE AS IS"
  1.  ;
  1. FINDC ;FINDS REGISTER COMPLICATION AND PUT IN ^TMP($J,"REG"
  1.  S ACME="" F I=1:1 S ACME=$O(^ACM(42,"E",ACMRG,ACME)) Q:ACME=""  S ACMD=$P(^ACM(42,ACME,0),U,1) I '$D(^TMP($J,"STD",ACMD)) S:'$D(^TMP($J,"REG",ACMD)) ^TMP($J,"REG",ACMD)="" S ^TMP($J,"REG",ACMD,ACME)=ACME_U_ACMD_U_$P(^ACM(42.1,ACMD,0),U,1)
  1.  S ACMD="",ACMQ=0 F  S ACMD=$O(^TMP($J,"REG",ACMD)) Q:ACMD=""  D MATCHC Q:ACMQ
  1.  Q:ACMQ
  1.  D:$D(^TMP($J,"REG")) DIRYNC
  1.  D END
  1.  Q
  1. DIRYNC S DIR(0)="YO",DIR("A")="Are you ready to change your patient's complications to the new complications",DIR("B")="YES"
  1.  W ! D ^DIR K DIR Q:Y=0!(Y["^")  I Y=1 D CHGC
  1.  Q
  1.  ;
  1. CHGC ;LOOPS AND CHANGES COMPLICATIONS TO NEW VALUES
  1.  W !,"Changing complication..." S ACMD="" F  S ACMD=$O(^TMP($J,"REG",ACMD)) Q:ACMD=""  D CHGC1
  1.  Q
  1. CHGC1 Q:^TMP($J,"REG",ACMD)="LEAVE AS IS"
  1.  I ^TMP($J,"REG",ACMD)="DELETE ENTIRELY" D CHGCD Q
  1.  S ACME="" F  S ACME=$O(^TMP($J,"REG",ACMD,ACME)) Q:ACME=""  S DIE="^ACM(42,",DA=ACME,DR=".01///^S X=^TMP($J,""REG"",ACMD);.04///^S X=ACMRG" D ^DIE K DA,DR W "."
  1.  K ^ACM(42,"AC") S DIK="^ACM(42,",DIK(1)=".04^AC" D ENALL^DIK K DIK
  1.  Q
  1.  ;
  1. CHGCD ;
  1.  S ACMX=0 F  S ACMX=$O(^ACM(42,"B",ACMD,ACMX)) Q:+ACMX=0  S DA=ACMX,DIK="^ACM(42," D ^DIK K DIK,DA W "."
  1.  S DIK="^ACM(42.1,"_ACMD_",""RG"",",DA(1)=ACMD,DA=ACMRG D ^DIK K DA,DA(1),DIK
  1.  I '$D(^ACM(42.1,ACMD,"RG","B")) S DIK="^ACM(42.1,",DA=ACMD D ^DIK K DA,DIK
  1.  Q
  1. MATCHC ;MATCHES COMPLICATION TO STD
  1.  W !,"Choose a new complication from the list below:",!
  1.  W !,"for your complication:  ",$P(^ACM(42.1,ACMD,0),U,1)
  1.  S DIR(0)="S^"_ACMDIR,DIR("A")="Choose a Complication: " D ^DIR
  1.  I Y="" S ^TMP($J,"REG",ACMD)="LEAVE AS IS" Q
  1.  I Y["^" S ACMQ=1 Q
  1.  S ^TMP($J,"REG",ACMD)=Y(0) Q
  1.  Q
  1.  ;
  1.  ;
  1. CRISK ;EP;FINDS STANDARD RISK FACTORS AND PUT IN ^TMP($J,"STD"
  1.  W !,"I will now check your patient's Risk Factors against the IHS standards:"
  1.  ;
  1.  ;
  1. SETR ;FINDS THE STANDARDS AND PUTS IN ^TMP($J,"STD"
  1.  K ACME S (ACMDIR,ACME)="" F I=1:1 S ACME=$T(RISK+I^ACMRGA02) Q:ACME["*"  S ACME=$P(ACME,";;",3),ACMD="",ACMD=$O(^ACM(45.1,"B",ACME,ACMD)),^TMP($J,"STD",ACMD)=ACME,ACMDIR=ACMDIR_I_":"_ACME_";"
  1.  S ACMDIR=ACMDIR_I_":DELETE ENTIRELY;"
  1.  S ACMDIR=ACMDIR_(I+1)_":LEAVE AS IS"
  1.  ;
  1. FINDR ;
  1.  S ACME="" F I=1:1 S ACME=$O(^ACM(45,"E",ACMRG,ACME)) Q:ACME=""  S ACMD=$P(^ACM(45,ACME,0),U,1) I '$D(^TMP($J,"STD",ACMD)) S:'$D(^TMP($J,"REG",ACMD)) ^TMP($J,"REG",ACMD)="" S ^TMP($J,"REG",ACMD,ACME)=ACME_U_ACMD_U_$P(^ACM(45.1,ACMD,0),U,1)
  1.  S ACMD="",ACMQ=0 F  S ACMD=$O(^TMP($J,"REG",ACMD)) Q:ACMD=""  D MATCHR Q:ACMQ
  1.  Q:ACMQ
  1.  D:$D(^TMP($J,"REG")) DIRYNR
  1.  D END
  1.  Q
  1.  ;
  1. DIRYNR S DIR(0)="YO",DIR("A")="Are you ready to change your patient's Risk Factors to the new Risk Factors",DIR("B")="YES"
  1.  W ! D ^DIR K DIR Q:Y=0!(Y["^")  I Y=1 D CHGR
  1.  Q
  1. CHGR ;
  1.  W !,"Changing Risk Factors..." S ACMD="" F  S ACMD=$O(^TMP($J,"REG",ACMD)) Q:ACMD=""  D CHGR1
  1.  Q
  1.  ;
  1. CHGR1 Q:^TMP($J,"REG",ACMD)="LEAVE AS IS"
  1.  I ^TMP($J,"REG",ACMD)="DELETE ENTIRELY" D CHGRD Q
  1.  S ACME="" F  S ACME=$O(^TMP($J,"REG",ACMD,ACME)) Q:ACME=""  S DIE="^ACM(45,",DA=ACME,DR=".01///^S X=^TMP($J,""REG"",ACMD);.04///^S X=ACMRG" D ^DIE K DA,DR W "."
  1.  K ^ACM(45,"AC") S DIK="^ACM(45,",DIK(1)=".04^AC" D ENALL^DIK K DIK
  1.  Q
  1.  ;
  1. CHGRD ;
  1.  S ACMX=0 F  S ACMX=$O(^ACM(45,"B",ACMD,ACMX)) Q:+ACMX=0  S DA=ACMX,DIK="^ACM(45," D ^DIK K DIK,DA W "."
  1.  S DIK="^ACM(45.1,"_ACMD_",""RG"",",DA(1)=ACMD,DA=ACMRG D ^DIK K DA,DA(1),DIK
  1.  I '$D(^ACM(45.1,ACMD,"RG","B")) S DIK="^ACM(45.1,",DA=ACMD D ^DIK K DA,DIK
  1.  Q
  1.  ;
  1. MATCHR ;
  1.  W !,"Choose a new Risk Factor from the list below:",!
  1.  W !,"for your Risk Factor:  ",$P(^ACM(45.1,ACMD,0),U,1)
  1.  S DIR(0)="S^"_ACMDIR,DIR("A")="Choose a Risk Factor: " D ^DIR
  1.  I Y="" S ^TMP($J,"REG",ACMD)="LEAVE AS IS" Q
  1.  I Y["^" S ACMQ=1 Q
  1.  S ^TMP($J,"REG",ACMD)=Y(0) Q
  1.  Q
  1.  ;
  1.  ;
  1. CDXCR ;EP;CONVERT DIAGNOSTIC CRITERIA TO STANDARD
  1.  W !,"I will now check your patient's Diagnostic Criteria agains the IHS Standards:"
  1.  ;
  1. SETDC ;FINDS STANDARD DX CRITERIA AND PUT IN ^TMP($J,"STD"
  1.  K ACME S (ACMDIR,ACME)="" F I=1:1 S ACME=$T(DXCRIT+I^ACMRGA02) Q:ACME["*"  S ACME=$P(ACME,";;",3),ACMD="",ACMD=$O(^ACM(51.1,"B",ACME,ACMD)),^TMP($J,"STD",ACMD)=ACME,ACMDIR=ACMDIR_I_":"_ACME_";"
  1.  S ACMDIR=ACMDIR_I_":DELETE ENTIRELY;"
  1.  S ACMDIR=ACMDIR_(I+1)_":LEAVE AS IS"
  1.  ;
  1. FINDDC ;FINDS REGISTER DX CRIERIA AND PUT IN TMP($J,"REG"
  1.  S ACME="" F I=1:1 S ACME=$O(^ACM(51,"E",ACMRG,ACME)) Q:ACME=""  S ACMD=$P(^ACM(51,ACME,0),U,1) I '$D(^TMP($J,"STD",ACMD)) S:'$D(^TMP($J,"REG",ACMD)) ^TMP($J,"REG",ACMD)="" S ^TMP($J,"REG",ACMD,ACME)=ACME_U_ACMD_U_$P(^ACM(51.1,ACMD,0),U,1)
  1.  S ACMD="",ACMQ=0 F  S ACMD=$O(^TMP($J,"REG",ACMD)) Q:ACMD=""  D MATCHDC Q:ACMQ
  1.  Q:ACMQ
  1.  D:$D(^TMP($J,"REG")) DIRYNDC
  1.  D END
  1.  Q
  1.  ;
  1. DIRYNDC S DIR(0)="YO",DIR("A")="Are you ready to change your patient's Diagnostic Criteria to the new Standard",DIR("B")="YES"
  1.  W ! D ^DIR K DIR Q:Y=0!(Y["^")  I Y=1 D CHGDC
  1.  Q
  1. CHGDC ;LOOPS & CHANGES DX CRITERIA TO NEW VALUES
  1.  W !,"Changing Diagnostic Criteria..." S ACMD="" F  S ACMD=$O(^TMP($J,"REG",ACMD)) Q:ACMD=""  D CHGDC1
  1.  Q
  1.  ;
  1. CHGDC1 Q:^TMP($J,"REG",ACMD)="LEAVE AS IS"
  1.  I ^TMP($J,"REG",ACMD)="DELETE ENTIRELY" D CHGDCD Q
  1.  S ACME="" F  S ACME=$O(^TMP($J,"REG",ACMD,ACME)) Q:ACME=""  S DIE="^ACM(51,",DA=ACME,DR=".01///^S X=^TMP($J,""REG"",ACMD);.04///^S X=ACMRG" D ^DIE K DA,DR W "."
  1.  K ^ACM(51,"AC") S DIK="^ACM(51,",DIK(1)=".04^AC" D ENALL^DIK K DIK
  1.  Q
  1.  ;
  1. CHGDCD ;
  1.  S ACMX=0 F  S ACMX=$O(^ACM(51,"B",ACMD,ACMX)) Q:+ACMX=0  S DA=ACMX,DIK="^ACM(51," D ^DIK K DIK,DA W "."
  1.  S DIK="^ACM(51.1,"_ACMD_",""RG"",",DA(1)=ACMD,DA=ACMRG D ^DIK K DA,DA(1),DIK
  1.  I '$D(^ACM(51.1,ACMD,"RG","B")) S DIK="^ACM(51.1,",DA=ACMD D ^DIK K DA,DIK
  1.  Q
  1.  ;
  1. MATCHDC ;
  1.  W !,"Choose a new Diagnostic Criteria from the list below:",!
  1.  W !,"for your Diagnostic Criteria:  ",$P(^ACM(51.1,ACMD,0),U,1)
  1.  S DIR(0)="S^"_ACMDIR,DIR("A")="Choose a Diagnostic Criteria: " D ^DIR
  1.  I Y="" S ^TMP($J,"REG",ACMD)="LEAVE AS IS" Q
  1.  I Y["^" S ACMQ=1 Q
  1.  S ^TMP($J,"REG",ACMD)=Y(0) Q
  1.  Q
  1. END ;CLEANUP IHS/OHPRD/TMJ Patch #1 - Removed Kill ACMQ
  1.  K ^TMP($J,"REG"),^TMP($J,"STD"),ACMD,ACMDIR,ACME,DA,DIE,DIR,DR,I
  1.  Q