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

BDMLLT.m

Go to the documentation of this file. 
  1. BDMLLT ; IHS/CMI/LAB - VIEW PT RECORD LT ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4,10**;JUN 14, 2007;Build 12
  1.  ;
  1. EXIT ;
  1.  D EN^XBVK("BDML")
  1.  K ^TMP($J,"BDMLLTVR")
  1.  K ^XTMP("BDMLLT",BDMJOB,BDMBTH)
  1.  K BDMJOB,BDMBTH
  1.  Q
  1. SELECT ;EP;TO SELECT BDMLLT LETTER
  1.  K BDMLLTQT,BDMLLTOT
  1.  D LIST
  1. S1 S DIR(0)="NO^1:"_BDMLLTJ
  1.  S DIR("A")="Select LETTER NO."
  1.  W !
  1.  D DIR^BDMLLTD
  1.  I +Y<1!'$G(BDMLLTTP(+Y)) S BDMLLTQT="" Q
  1.  S BDMLDA=+BDMLLTTP(+Y)
  1.  Q
  1. ZIS ;EP;TO SELECT DEVICE ON WHICH TO PRINT BDMLLT LETTER
  1.  S:$G(BDMLRTN)="" (ZTRTN,BDMLRTN)="PRINT^BDMLLT"
  1.  S ZTDESC="PRINT BDMLLT PATIENT LETTER"
  1.  S ZTSAVE("ACM*")=""
  1.  S ZTSAVE("DFN")=""
  1.  S ZTSAVE("BDM")=""
  1.  D ^BDMLLTZ
  1.  Q
  1. MULTIPLE ;EP;UTILTIY TO SELECT MULTIPLE PATIENTS FOR WHICH TO PRINT BDMLLT LETTER
  1.  Q
  1. LINIT ;EP;TO CREATE ARRAY OF NAMES OF EXISTING LETTERS
  1.  N X
  1.  K ^TMP($J,"BDMLLTVR"),BDMLLTJ
  1.  S VALMCNT=0
  1.  K X
  1.  S $E(X,5)="NO.  LETTER"
  1.  D Z(X)
  1.  K X
  1.  S $E(X,5)="---  ------------------------------"
  1.  D Z(X)
  1.  S BDMLLTJ=0
  1.  S Y=""
  1.  F  S Y=$O(^BDMLET("B",Y)) Q:Y=""  D
  1.  .S Z=0
  1.  .F  S Z=$O(^BDMLET("B",Y,Z)) Q:'Z  D
  1.  ..S BDMLLTJ=BDMLLTJ+1
  1.  ..K X
  1.  ..S $E(X,5)=BDMLLTJ
  1.  ..S $E(X,10)=Y
  1.  ..D Z(X)
  1.  ..S BDMLLTTP(BDMLLTJ)=Z
  1.  Q
  1. LINE ;
  1.  I $L(Y)<81 D  Q
  1.  .S J=J+1
  1.  .S BDMLLTTP(J,0)=Y
  1.  F I=1:1 S K=$P(Y," ",I) Q:$P(Y," ",I,99)=""  D
  1.  .I $L(Z_" "_K)>80 D  Q
  1.  ..S J=J+1
  1.  ..S BDMLLTTP(J,0)=Z
  1.  ..S Z=""
  1.  .I Z="" S Z=K
  1.  .E  S Z=Z_" "_K
  1.  I $L(Z) S J=J+1,BDMLLTTP(J,0)=Z
  1.  Q
  1. PATLET ;EP;TO SELECT AND PROCESS PATIENT LETTER
  1.  D SELECT
  1.  Q:'$G(BDMLDA)
  1.  S BDMLLTJB=$H_$J
  1.  D ZIS
  1.  Q
  1. LIST ;LIST LETTERS
  1.  K BDMLLTTP
  1.  N BDML,BDMLLTX,BDMLLTY,BDMLLTZ
  1.  W @IOF
  1.  W !!?5,"DMS letters currently on file:"
  1.  W !!,"NO.  LETTER"
  1.  W ?27,"NO.  LETTER"
  1.  W ?54,"NO.  LETTER"
  1.  W !,"---  --------------------"
  1.  W ?27,"---  --------------------"
  1.  W ?54,"---  --------------------"
  1.  S BDMLLTJ=0
  1.  S BDML=""
  1.  F  S BDML=$O(^BDMLET("B",BDML)) Q:BDML=""  D
  1.  .S BDMLLTX=0
  1.  .F  S BDMLLTX=$O(^BDMLET("B",BDML,BDMLLTX)) Q:'BDMLLTX  D
  1.  ..S BDMLLTY=$G(^BDMLET(BDMLLTX,0))
  1.  ..Q:BDMLLTY=""
  1.  ..I $G(BDMLREG),$P(BDMLLTY,U,4)'=BDMLREG Q
  1.  ..S BDMLLTJ=BDMLLTJ+1
  1.  ..S BDMLLTTP(BDMLLTJ)=BDMLLTX_U_BDML
  1.  ..W:BDMLLTJ#3=1 !
  1.  ..W:BDMLLTJ#3=2 ?27
  1.  ..W:BDMLLTJ#3=0 ?53
  1.  ..W $J(BDMLLTJ,2),"   "
  1.  ..W $E(BDML,1,20)
  1.  Q
  1. Z(X) ;SET TMP NODE    
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP($J,"BDMLLTVR",VALMCNT,0)=X
  1.  Q
  1. DATE ;EP;TO PRINT LETTER DATE
  1.  N Y
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  S Z=Y
  1.  Q
  1. COHORT ;EP;TO ESTABLISH COHORT OF PATIENTS TO PRINT
  1.  S BDMJOB=$J,BDMBTH=$H
  1.  D SELECT
  1.  Q:'$G(BDMLDA)
  1.  D C1
  1.  Q:$D(BDMLLTQT)
  1.  S BDMLBROW=""
  1.  Q:'$D(^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER",BDMLLTJB))
  1.  S BDMLRTN="CPRINT^BDMLLT"
  1.  D ZIS
  1.  K BDMLBROW,BDMJOB,BDMBTH,BDMLLTJB
  1.  Q
  1. C1 K ^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER")
  1.  S BDMLLTJB=$H_$J
  1.  N DIR
  1.  S DIR(0)="SO^1:Individual Patient(s);2:Search Template of Patients;3:Members of a Case Management Register"
  1.  S DIR("A")="Create list for letters by"
  1.  D ^DIR
  1.  K DIR
  1.  I 'Y S BDMLLTQT="" Q
  1.  I Y=1 D PATIENT
  1.  I Y=2 D TEMPLATE
  1.  I Y=3 D REGISTER K BDMLREG
  1.  I '$D(^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER")) W !!,"No patients selected." D PAUSE Q
  1.  Q
  1. PATIENT ;SELECT INDIVIDUAL PATIENTS TO PRINT LETTER
  1.  K BDMLLTQT
  1.  F  D P1 Q:$D(BDMLLTQT)
  1.  K BDMLLTQT
  1.  S BDMLSTAT="Z"
  1.  Q
  1. P1 ;
  1.  N DIC
  1.  S DIC="^AUPNPAT("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("S")="I '$G(^DPT(+Y,.35))"
  1.  S DIC("A")="Name, Chart No. or DOB: "
  1.  D ^DIC
  1.  K DIC
  1.  I Y<1 S BDMLLTQT="" Q
  1.  S ^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER",BDMLLTJB,+Y)=""
  1.  Q
  1. TEMPLATE ;SELECT SEARCH TEMPLATE
  1.  N DIC
  1.  S DIC="^DIBT("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("S")="I $O(^DIBT(+Y,1,0))"
  1.  D ^DIC
  1.  K DIC
  1.  Q:'+Y
  1.  M ^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER",BDMLLTJB)=^DIBT(+Y,1)
  1.  S BDMLSTAT="Z"
  1.  Q
  1. CPRINT ;EP;TO PRINT LETTERS FROM LIST OR TEMPLATE
  1.  S DFN=0
  1.  F  S DFN=$O(^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER",BDMLLTJB,DFN)) Q:'DFN!$D(BDMOUT)  D
  1.  .K ^TMP("BDMTMP",$J,"FUL"),BDMOUT
  1.  .S BDMLET=2
  1.  .S BDMRPDA=$G(^ACM(41,"AC",DFN,BDMRDA))
  1.  .S BDMIANL=1 D EN^XBNEW("EPPRINT^BDMLET","BDMLET;BDMRPDA,BDMRDA,BDMIANL;BDMLDA;BDMREGNM;DFN;BDMLSTAT;BDMOUT")
  1.  K BDMIANL
  1.  Q
  1. PAUSE ;EP
  1.  S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. REGISTER ;
  1.  K DIC,BDMLREG
  1.  S DIC(0)="AEMQ"
  1.  S (DIC,DIE)="^ACM(41.1,",DIC("A")="REGISTER: "
  1.  S BDMLZDIC="^ACM(41.1)",DIC("S")="I $D(@BDMLZDIC@(+Y,""AU"",""B"",DUZ))"
  1.  D ^DIC
  1.  I Y=-1 W !!,"No register selected." Q
  1.  S BDMLREG=+Y
  1.   ;which status
  1.  S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  S BDMLSTAT=Y,BDM("STATUS")=Y
  1. REG1 ;
  1.  ;gather up patients from register in ^XTMP
  1.  K ^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER",BDMLLTJB) S BDMLCNT=0,X=0 F  S X=$O(^ACM(41,"B",BDMLREG,X)) Q:X'=+X  D
  1.  .I BDMLSTAT]"",$P($G(^ACM(41,X,"DT")),U,1)=BDMLSTAT S BDMLCNT=BDMLCNT+1,^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER",BDMLLTJB,$P(^ACM(41,X,0),U,2))="" Q
  1.  .I BDMLSTAT="" S BDMLCNT=BDMLCNT+1,^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER",BDMLLTJB,$P(^ACM(41,X,0),U,2))=""
  1.  I '$D(^XTMP("BDMLLT",BDMJOB,BDMBTH,"BDMLLT CUSTOM LETTER",BDMLLTJB)) W !,"No patients with that status in that register!" Q
  1.  W !!,"There are ",BDMLCNT," patients in the ",$P(^ACM(41.1,BDMLREG,0),U)," register with a status of ",BDMLSTAT,".",!!
  1.  D PAUSE
  1.  Q