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

BDMVRL6.m

Go to the documentation of this file. 
  1. BDMVRL6 ; IHS/CMI/LAB - REPORTS INTERFACE ; [ 02/23/2009 9:13 AM ]
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,4,10,12**;JUN 14, 2007;Build 51
  1.  ;VARIOUS INTERFACE CALLS FOR REPORTS
  1.  ;GUI INTERFACE CODE & AND APPOINTMENT REPORTS
  1.  ;
  1. ACTIVE ;EP;TO SELECT PATIENT STATUS FOR REPORTS
  1.  K BDMQUIT
  1.  W !!,"Select the Patient Status for this report"
  1.  S DIR(0)="SO^A:Active;I:Inactive;T:Transient;U:Unreviewed;D:Deceased;N:Non-IHS;NON:Noncompliant;Z:All Patients"
  1.  S DIR("A")="Select patient status"
  1.  S DIR("B")="Active"
  1.  D DIR^BDMFDIC
  1.  I Y]"","AITUDNONZ"[Y S BDM("STATUS")=Y ;IHS/CMI/TMJ Non Compliant Fix
  1.  E  S BDMQUIT=""
  1.  Q
  1. REPORTS ;EP;TO SELECT REPORTS
  1.  S DIR(0)="SO^1:Individual Case Summary;2:Case Summary for Multiple Patients;3:Master List of Diabetes Register Patients;4:Statistical Reports"
  1.  S DIR("A")="Which Report"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I 'Y S BDMQUIT="" Q
  1.  I Y=1 D R1 Q
  1.  I Y=2 D R2 Q
  1.  I Y=3 D R3 Q
  1.  I Y=4 D R4 Q
  1.  Q
  1. SORT1 ;EP;TO SORT DIAGNOSIS AND COMPLICATION REPORTS
  1.  W !,"Sort the ",$G(BDM("REPORT"))," Report by"
  1.  S DIR(0)="SO^1:Alpha Order by Patient;2:Alpha Order by Patient within Community;3:Alpha Order within Complication"
  1.  S DIR("A")="Which One"
  1.  S DIR("B")=1
  1.  D DIR^BDMFDIC
  1.  I 'Y S BDMQUIT="" Q
  1.  S BDM("ORDER")=Y
  1.  Q
  1. R1 ;INDIVIDUAL HEALTH SUMMARY
  1.  Q
  1. R2 ;MULTIPLE HEALTH SUMMARY
  1.  Q
  1. R3 ;MASTER LIST
  1.  Q
  1. R4 ;STATISTICAL REPORTS
  1.  Q
  1. SORT ;SORT REPORTS
  1.  Q
  1. COMM ;SELECT COMMUNITY     
  1.  S DIC="^AUTTCOM("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which COMMUNITY: "
  1.  W !,"Press ENTER to include all communities)"
  1.  D DIC^BDMFDIC
  1.  I $D(BDMQUIT)!$D(BDMOUT) S BDMQUIT="" Q
  1.  I X="" S BDM("COMMUNITY")="ALL"
  1.  E  S BDM("COMMUNITY")=+Y
  1.  Q
  1. PROVIDER ;EP;SELECT PROVIDER
  1.  S DIC=$S(^DD(9000001,.14,0)[200:"^VA(200,",1:"^DIC(16,")
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which PROVIDER: "
  1.  W !,"Press ENTER to include all PROVIDERS)"
  1.  D DIC^BDMFDIC
  1.  I $D(BDMQUIT)!$D(BDMOUT) S BDMQUIT="" Q
  1.  I X="" S BDM("PROVIDER")="ALL"
  1.  E  S BDM("PROVIDER")=+Y
  1.  Q
  1. A1 ;
  1.  S DIR(0)="SO^1:Active Patients Only;2:All Patients in the Register"
  1.  S DIR("A")="Which one"
  1.  S DIR("A",1)="Do you want Active patients Only"
  1.  S DIR("A")="or All Patients in the Register"
  1.  S DIR("B")="Active Patients Only"
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  S BDM("ACTIVE")=$S(Y=1:"ACTIVE",1:"ALL")
  1.  Q
  1. C1 ;
  1.  S DIR(0)="SO^1:All Complications;2:One Particular Complication"
  1.  S DIR("A",1)="Do you want All Complications"
  1.  S DIR("A")="or One Particular Complication"
  1.  S DIR("B")="All Complications"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  I Y=1 S BDM("COMPLICATION")="ALL" Q
  1.  E  D COMP
  1.  Q
  1. D1 ;
  1.  S DIR(0)="SO^1:All Diagnoses;2:One Particular Diagnosis"
  1.  S DIR("A",1)="Do you want All Diagnoses"
  1.  S DIR("A")="or One Particular Diagnosis"
  1.  S DIR("B")="All Diagnoses"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  I Y=1 S BDM("DIAGNOSIS")="ALL" Q
  1.  E  D COMP
  1.  Q
  1. COMP ;SELECT COMPLICATION
  1.  S DIC="^ACM(42.1,"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which COMPLICATION: "
  1.  S DIC("S")="I $D(^ACM(42.1,""RG"",BDMRG,+Y))"
  1.  W !
  1.  D DIC^BDMFDIC
  1.  I $D(BDMQUIT)!$D(BDMOUT) S BDMQUIT="" Q
  1.  I X="" D  Q
  1.  .S BDM("COMPLICATION")="ALL"
  1.  .W !!,"No COMPLICATION was selected."
  1.  .W !,"The report will include all COMPLICATIONS."
  1.  .H 2
  1.  E  S BDM("COMPLICATION")=+Y
  1.  Q
  1. DIAG ;SELECT DIAGNOSIS
  1.  S DIC="^ACM(44.1,"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which DIAGNOSIS: "
  1.  S DIC("S")="I $D(^ACM(44.1,""RG"",BDMRG,+Y))"
  1.  W !
  1.  D DIC^BDMFDIC
  1.  I $D(BDMQUIT)!$D(BDMOUT) S BDMQUIT="" Q
  1.  I X="" D  Q
  1.  .S BDM("DIAGNOSIS")="ALL"
  1.  .W !!,"No DIAGNOSIS was selected."
  1.  .W !,"The report will include all DIAGNOSES."
  1.  .H 2
  1.  E  S BDM("DIAGNOSIS")=+Y
  1.  Q
  1.  D A1,C1,SORT1
  1.  Q
  1. MCS ;EP;TO PRINT MULTIPLE CASE SUMMARY
  1.  K ACMES,ACMEP,ACMPS
  1.  S (ACMEP,ACMPP,ACMRGTP)=""
  1.  D:'$D(ACMDM) ^ACMGTP
  1.  S ACMENTRY="MPS"
  1.  D ENTRY^ACMSRT
  1.  Q
  1. ICS ;EP;TO PRINT INDIVIDUAL CASE SUMMARY
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K ACMES,ACMEP,ACMPS
  1.  S (ACMEP,ACMPP,ACMRGTP)=""
  1.  D:'$D(ACMDM) ^ACMGTP
  1.  S ACMPP=""
  1.  D QONE^ACMED
  1.  Q
  1. ML ;EP;TO PRINT MASTER LIST
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K ACMES,ACMEP,ACMPS
  1.  S (ACMEP,ACMPP,ACMRGTP)=""
  1.  D:'$D(ACMDM) ^ACMGTP
  1.  S ACMENTRY="ML"
  1.  D ENTRY^ACMSRT
  1.  Q
  1. PSR ;EP;TO PRINT PATIENT AND STATISTICAL REPORTS
  1.  D REG^BDMFUTIL
  1.  S ACMDM=""
  1.  Q:$D(BDMQUIT)
  1.  K ACMES,ACMEP,ACMPS
  1.  S (ACMPP,ACMRGTP)=""
  1.  D:'$D(ACMDM) ^ACMGTP
  1.  D CURRENT^ACMED
  1.  S ACMPP=""
  1.  S ACMRG=BDMRDA
  1.  S ACMRGNA=BDMREGNM
  1.  S ACMCTRLP="REG;CMP;DX;FM;PROB;CR;CT"
  1.  S ACMCTRLS="CMPL;DXL;AD"
  1.  D ^ACMQK
  1.  K ACMPP
  1.  D EN^XBVK("ACM"),EN^XBVK("BDM")
  1.  Q
  1. GENRET ;EP;TO ACCESS GENERAL RETRIEVAL (LISTER)
  1.  W @IOF
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S ACMRG=BDMRDA
  1.  S ACMRGNA=BDMREGNM
  1.  S ACMDM=""
  1.  D CONTROL^ACMCTRL
  1.  S ACMCTRLP=ACMCTRL
  1.  D INFORM^ACMRL01
  1.  K ACMES,ACMEP,ACMPS
  1.  S (ACMEP,ACMPP,ACMRGTP)=""
  1.  D:'$D(ACMDM) ^ACMGTP
  1.  K ACMPP
  1.  D ^ACMRL
  1.  K ACMPP,ACMEP,ACMRGTP,ACMCTRLP,ACMCTRL,ACMCRTLS
  1.  Q
  1. APPT ;EP;TO PRINT LIST OF DM PATIENT'S APPOINTMENTS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  D APP1
  1. APPEXIT K BDM,BDMQUIT,BDMOUT
  1.  K ^TMP("BDMVR",$J)
  1.  Q
  1. APP1 S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
  1.  Q:'BDMRDA
  1.  D ^BDMDATE
  1.  Q:$D(BDMQUIT)
  1.  S BDMBROWS=1  ;cmi/maw 1/17/2006 so it asks for print or browse
  1.  D ZIS
  1.  K BDMBROWS  ;cmi/maw 1/17/2006 so variable does not hang around
  1.  Q
  1. APPINIT ;DISPLAY APPOINTMENTS
  1.  K ^TMP("BDMTMP",$J),^TMP("BDMVR",$J)
  1.  S (BDMJ,VALMCNT)=0
  1.  D APPHEAD
  1.  N X,Y,Z,DFN,PAT
  1.  S BDMRPDA=0
  1.  F  S BDMRPDA=$O(^ACM(41,"B",BDMRDA,BDMRPDA)) Q:'BDMRPDA  D
  1.  .S DFN=$P($G(^ACM(41,BDMRPDA,0)),U,2)
  1.  .Q:'$D(^DPT(+DFN,"S"))
  1.  .D PAT^BDMVRL4(DFN,BDMRPDA)
  1.  .Q:$D(^DPT(DFN,.35))
  1.  .D APP(DFN,BDMBEGIN,BDMEND)
  1.  S Y=""
  1.  F  S Y=$O(^TMP("BDMTMP",$J,Y)) Q:Y=""  D
  1.  .S Z=0
  1.  .F  S Z=$O(^TMP("BDMTMP",$J,Y,Z)) Q:'Z  D
  1.  ..S X=^TMP("BDMTMP",$J,Y,Z)
  1.  ..D Z(X)
  1.  Q
  1. APP(DFN,BDMBEGIN,BDMEND) ;EP;TO LIST UPCOMING APPOINTMENTS
  1.  Q:'$G(DFN)!'$G(BDMBEGIN)!'$G(BDMEND)
  1.  N X,Y,Z,PAT
  1.  S Y=BDMBEGIN-.0001
  1.  S X=""
  1.  F  S Y=$O(^DPT(DFN,"S",Y)) Q:'Y!(BDMEND+.9999<Y)  D
  1.  .S Z=$G(^DPT(DFN,"S",Y,0))
  1.  .Q:Z=""
  1.  .S X=""
  1.  .S (PAT,X)=$E($P($G(^DPT(DFN,0)),U),1,20)
  1.  .S $E(X,22)=$E($P($G(^SC(+Z,0)),U),1,20)
  1.  .S DATE=Y
  1.  .X ^DD("DD")
  1.  .S $E(X,44)=$P(Y,"@")
  1.  .S $E(X,56)="at "_$P(Y,"@",2)
  1.  .S BDMJ=BDMJ+1
  1.  .S ^TMP("BDMTMP",$J,PAT,BDMJ)=X
  1.  .;S X=""  ;cmi/maw 1/17/2007 this should get reset prior to follow up appts
  1.  .I $D(BDMFUAPP) D
  1.  ..S Y=$E(X,22,999)
  1.  ..S X=""
  1.  ..S $E(X,6)="NEXT APPT: "
  1.  ..S $E(X,17)=Y
  1.  .D Z(X)  ;cmi/maw 9/7/06 test to see if this works for next appt.
  1.  Q
  1. APPHEAD ;PRINT APPOINTMENT LIST HEADER
  1.  N X,Y,Z
  1.  S X=""
  1.  S $E(X,10)="DIABETES MANAGEMENT SYSTEM - PATIENT APPOINTMENTS"
  1.  D Z(X)
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  S X=""
  1.  S $E(X,10)="REPORT DATE....: "_Y
  1.  D Z(X)
  1.  S Y=BDMBEGIN
  1.  X ^DD("DD")
  1.  S X=""
  1.  S $E(X,10)="APPTS BEGINNING: "_Y
  1.  D Z(X)
  1.  S Y=BDMEND
  1.  X ^DD("DD")
  1.  S X=""
  1.  S $E(X,10)="APPTS ENDING...: "_Y
  1.  D Z(X)
  1.  S X="  "
  1.  D Z(X)
  1.  S X="PATIENT"
  1.  S $E(X,22)="CLINIC"
  1.  S $E(X,44)="APPT DATE/TIME"
  1.  D Z(X)
  1.  S X="--------------------"
  1.  S $E(X,22)="---------------------"
  1.  S $E(X,44)="---------------------"
  1.  D Z(X)
  1.  Q
  1. Z(X) ;SET TMP GLOBAL
  1.  I IO'=IO(0) W !,X Q
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP("BDMVR",$J,VALMCNT,0)=X
  1.  Q
  1. ZIS ;DEVICE INTERFACE
  1.  S ZTSAVE("BDM*")=""
  1.  S (ZTRTN,BDMRTN)="APRINT^BDMVRL6"
  1.  D ^BDMFZIS
  1.  Q
  1. APRINT ;EP;TO PRINT APPOINTMENT LIST
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  D APPINIT
  1.  I IO=IO(0),'$G(BDMPRINT) D  Q  ;cmi/maw 1/17/2006 don't browse if they select print
  1.  .S BDMHDR=""
  1.  .S BDMVALM="BDM APPOINTMENT LIST"
  1.  .D VALM^BDMVRL(BDMVALM) Q
  1.  S J=0
  1.  F  S J=$O(^TMP("BDMVR",$J,J)) Q:'J!$D(BDMQUIT)  D
  1.  .S X=$G(^TMP("BDMVR",$J,J,0))
  1.  .I X]"" U IO W !,X
  1.  .I IOSL-4<$Y D PAUSE^BDMFMENU Q:$D(BDMQUIT)  W @IOF S J=J-8 D APPHEAD
  1.  Q
  1.  ;
  1. BDMGA(BDMRET,BDMBEGIN,BDNEND,BDMRDA,BDMGUI) ;PEP - gui call
  1.  S BDMJ=$J
  1.  S BDMH=$H
  1.  F X="BDMJ","BDMH","BDMBEGIN","BDMEND","BDMRDA" S @X=$G(@X)
  1.  I $G(BDMJ)="" S BDMRET=-1 Q
  1.  I $G(BDMH)="" S BDMRET=-1 Q
  1.  ;create entry in fileman file to hold output
  1.  N BDMOPT  ;maw
  1.  S BDMOPT="List Patient Appointments"
  1.  D NOW^%DTC
  1.  S BDMNOW=$G(%)
  1.  K DD,D0,DIC
  1.  S X=DUZ_"."_BDMH
  1.  S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05///1;.06///"_$G(BDMOPT)_";.07///R"
  1.  S DIC="^BDMGUI(",DIC(0)="L",DIADD=1,DLAYGO=9003002.4
  1.  D FILE^DICN
  1.  K DIADD,DLAYGO,DIC,DA
  1.  I Y=-1 S BDMRET=-1 Q
  1.  S BDMIEN=+Y
  1.  S BDMRET=BDMIEN
  1.  D ^XBFMK
  1.  K ZTSAVE S ZTSAVE("*")=""
  1.  ;D GUIEP  ;for interactive testing
  1.  S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMVRL6",ZTDESC="GUI DM LIST PATIENT APPOINTMENTS" D ^%ZTLOAD
  1.  D XIT
  1.  Q
  1.  ;
  1. GUIEP ;EP - called from taskman
  1.  ;D ^FUPRINT
  1.  K ^TMP($J,"BDMLPA")
  1.  S IOM=80  ;cmi/maw added
  1.  D GUIR^XBLM("APPINIT^BDMVRL6","^TMP($J,""BDMLPA"",")
  1.  ;Q:$G(BDMDSP)  ;quit if to screen
  1.  S X=0,C=0 F  S X=$O(^TMP($J,"BDMLPA",X)) Q:'X  D
  1.  . N BDMGDATA
  1.  . S BDMGDATA=^TMP($J,"BDMLPA",X)
  1.  . ;I BDMGDATA="ZZZZZZZ" S BDMGDATA=$C(12)
  1.  . S ^BDMGUI(BDMIEN,11,X,0)=BDMGDATA
  1.  . S C=C+1
  1.  S ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
  1.  S DA=BDMIEN,DIK="^BDMGUI(" D IX1^DIK
  1.  D ENDLOG
  1.  S ZTREQ="@"
  1.  Q
  1.  ;
  1. ENDLOG ;-- write the end of the log
  1.  D NOW^%DTC
  1.  S BDMNOW=$G(%)
  1.  S DIE="^BDMGUI(",DA=BDMIEN,DR=".04////"_BDMNOW_";.07///C"
  1.  D ^DIE
  1.  K DIE,DR,DA
  1.  Q
  1.  ;
  1. XIT ;-- remove variables and quit
  1.  D EN^XBVK("AUPN")
  1.  D ^XBFMK,KILL^AUPNPAT
  1.  K ^TMP($J,"PATS")
  1.  Q
  1.  ;