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

BDMVRL4.m

Go to the documentation of this file. 
  1. BDMVRL4 ; IHS/CMI/LAB - VIEW PT RECORD CON'T ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**1,3,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51
  1.  ;LIST OF FOLLOW-UP EXAMS
  1.  ;MOVED 'FURESULT' TO BDMVRL42 TO CONTROL ROUTINE SIZE
  1.  ;DMS GUI INTERFACE CODE
  1.  ;
  1. FU ;EP;TO PRINT FOLLOW-UP NEEDED REPORTS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  F  D FUEN Q:$D(BDMQUIT)!$D(BDMOUT)
  1. EXIT ;EP
  1.  K BDM,BDMQUIT,BDMTAX,BDMFU,BDMRPDA,BDMOUT,BDMPROV,BDMFUAPP
  1.  K L,FR,TO,BY,FLDS  ;cmi/anch/maw 8/15/2007 DIP vars that may hand around even though they aren't supposed to patch 1
  1.  K ^TMP("BDMVR",$J),^TMP("BDMTMP",$J)
  1.  Q
  1. FUEN ;
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  D EXIT
  1.  S:'$G(VALMWD) VALMWD=80
  1.  D CLEAR^VALM1
  1.  W !?8,"DIABETES REGISTER - FOLLOW-UP NEEDED REPORTS"
  1.  W !?8,"(Patients due now or within the next 30 days.)"
  1.  W !
  1.  D SCREEN^BDMVRL42
  1.  S DIR(0)="FO^1:30"
  1.  S DIR("A",1)="        Type 'ALL' to include ALL Follow-up Needed"
  1.  S DIR("A")="        Which Report"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I X=""!$D(BDMQUIT) S BDMQUIT="" Q
  1.  ;I X=99 D PROTO^BDMVRL42 Q
  1.  I $E(Y)?1A D  I $D(BDMQUIT) K BDMQUIT Q
  1.  .S X=Y
  1.  .X ^%ZOSF("UPPERCASE")
  1.  .I Y'="ALL" S BDMQUIT="" Q
  1.  I Y="ALL" D ALL^BDMVRL42 S BDMY=Y
  1.  D PARSE^BDMVRL42
  1.  D ST
  1.  Q:$D(BDMQUIT)
  1.  D ACTIVE
  1.  Q:$D(BDMQUIT)
  1.  D DX
  1.  Q:$D(BDMQUIT)
  1.  D APPT^BDMVRL42
  1.  Q:$D(BDMQUIT)
  1.  D PROVIDER^BDMVRL43
  1.  Q:$D(BDMQUIT)
  1.  D REPLET
  1.  Q:$D(BDMQUIT)
  1.  D DEMOCHK^BDMUTL(.BDMDEMO)
  1.  I BDMDEMO=-1 Q
  1.  D ZIS
  1.  Q
  1. ZIS ;DEVICE INTERFACE
  1.  S ZTSAVE("BDM*")=""
  1.  S (ZTRTN,BDMRTN)="FUPRINT^BDMVRL4"
  1.  D ^BDMFZIS
  1.  Q
  1. BDMG(BDM) ;EP - Visual DMS Entry Point
  1.  ;cmi/anch/maw added for GUI DMS
  1.  D FUPRINT
  1.  K ^XTMP("BDMTAX",BDMJOB,BDMBTH)
  1.  Q
  1.  ;
  1. FUPRINT ;EP;TO DISPLAY THE FOLLOW-UP REPORT
  1.  I $E(IOST,1,2)="C-" D
  1.  .W !!,"Please stand by.  It could take me a while to figure this out."
  1.  S BDMJOB=$J,BDMBTH=$H
  1.  D BUILDSML^BDMUTL(2019)
  1.  D FUGET ;GET ALL DATA AND SET IM ^TMP ARRAY
  1.  D FUDISP ;DISPLAY FOLLOW-UP REPORT
  1.  Q
  1. FUGET ;EP;GET DATA
  1.  S BDMP=0
  1.  F  S BDMP=$O(BDM("PARSE",BDMP)) Q:'BDMP  D FUGET1
  1.  Q
  1. FUGET1 S BDMFU=$P(BDM("REPORT",BDMP),U)
  1.  S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
  1.  I BDMRDA="" D  Q
  1.  .S X="NO "_BDMREGNM_" ON FILE"
  1.  .D Z(X)
  1.  ;INDEPENDENT LOOKUP FOR HTN, PAP, MAMM
  1.  ;I BDMFU="HTN" S BDM("FOLLOW-UP TYPE")="HYPERTENSION"
  1.  ;E  I BDMFU="PAP" S BDM("FOLLOW-UP TYPE")="PAP SMEAR"
  1.  ;E  I BDMFU="MAM" S BDM("FOLLOW-UP TYPE")="MAMMOGRAPHY"
  1.  I BDMFU="DENT" S BDM("FOLLOW-UP TYPE")="DENTAL"
  1.  E  D  ;Q:'$D(BDM("IEN"))
  1.  .D IEN^BDMVRL41
  1.  .;Q:'$D(BDM("IEN"))
  1.  K X2
  1.  I BDMFU="EKG" S X2=-1795
  1.  D FULAST
  1.  I $G(BDMRPDA) D FUPAT Q
  1.  I $G(BDMIANL) D FUPAT Q
  1.  S BDMRPDA=0
  1.  F  S BDMRPDA=$O(^ACM(41,"B",BDMRDA,BDMRPDA)) Q:'BDMRPDA  D
  1.  .D FUPAT
  1.  .I $E(IOST,1,2)="C-" W "."
  1.  Q
  1. FUPAT ;EP;TO GATHER FOLLOW-UP INFO ON A PATIENT
  1.  I '$G(BDMIANL) S DFN=$P($G(^ACM(41,BDMRPDA,0)),U,2)
  1.  Q:'DFN
  1.  ;I DUZ=2881 Q:DFN'=1717
  1.  ;S ^TMP("ALL DFN",$J,DFN)=""
  1.  Q:$$DEMO^BDMUTL(DFN,$G(BDMDEMO))
  1.  I $G(BDM("DM DIAGNOSIS"))]"" D PATDX I $D(BDMQUIT) K BDMQUIT Q
  1.  I $G(BDM("SEARCH TEMPLATE")) Q:'$D(^DIBT(BDM("SEARCH TEMPLATE"),1,DFN))
  1.  D PAT(DFN,BDMRPDA)
  1.  S BDMRECST=""
  1.  I BDMRPDA S BDMRECST=$P($G(^ACM(41,BDMRPDA,"DT")),U,1)
  1.  I BDM("STATUS")'="Z" Q:$G(BDMRECST)'=BDM("STATUS")
  1.  ;I BDMFU="PAP"!(BDMFU="MAM")!(BDMFU="BRST"),$P($G(^DPT(DFN,0)),U,2)'="F" Q
  1.  K BDM("HRN")
  1.  S BDM=""
  1.  I BDMK["PROV" D
  1.  .S BDM=$P($G(^AUPNPAT(DFN,0)),U,14)
  1.  .I BDM,'$O(BDMK(0)) S BDM=$P($G(^VA(200,BDM,0)),U)
  1.  I BDMK["COMM" D
  1.  .D RES^BDMVRL5(DFN)
  1.  .I '$O(BDMK(0)) S BDM=$P($G(^AUTTCOM(+$G(BDM("RES")),0)),U)
  1.  I BDMK["WHER" D
  1.  .S BDM=$P($G(^ACM(41,BDMRPDA,"DT")),U,10)
  1.  .I BDM,'$O(BDMK(0)) D
  1.  ..S BDM("HRN")=$P($G(^AUPNPAT(DFN,41,+BDM,0)),U,2)
  1.  ..K:BDM("HRN")="" BDM("HRN")
  1.  ..S BDM=$P($G(^DIC(4,BDM,0)),U)
  1.  S:BDM="" BDM="NOT LISTED"
  1.  K BDMQUIT
  1.  I $O(BDMK(0)),BDM]"" D
  1.  .I '$D(BDMK(BDM)) S BDMQUIT="" Q
  1.  .S BDM=BDMK(BDM)
  1.  I $D(BDMQUIT) K BDMQUIT Q
  1.  S BDM("COMMUNITY")=$E(BDM,1,15)
  1.  S:'$D(BDM("HRN")) BDM("HRN")=$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,2)
  1.  S:BDM("HRN")="" BDM("HRN")="XXXXXX"
  1.  S BDM("PATIENT")=$E($P($G(^DPT(DFN,0)),U),1,25)
  1.  ;INDEPENDENT LOOKUPS
  1.  I BDMFU="HTN" D HTN^BDMVRL41 I 1
  1.  E  I BDMFU="PAP" D LPAP^BDMVRL41 I 1
  1.  E  I BDMFU="MAM" D LMAM^BDMVRL41 I 1
  1.  E  I "^FTEX^EYE^DENT^DEP^EKG^"[(U_BDMFU_U) D APCLEXAM^BDMVRL41 I 1
  1.  E  I "^NTED^EXER^GENI^"[(U_BDMFU_U) D APCLED^BDMVRL41 I 1
  1.  E  I BDMFU="FLU" D FLUC^BDMVRL41 I 1
  1.  E  I BDMFU="PNEU" D PNEUMOC^BDMVRL41 I 1
  1.  E  I BDMFU="TD" D TDC^BDMVRL41 I 1
  1.  E  I BDMFU="HEPB" D HEPBC^BDMVRL41 I 1
  1.  E  I BDMFU="HEPC" D HEPCC^BDMVRL41 I 1
  1.  E  D FIND I 1
  1.  ;INDEPENDENT LOOKUPS
  1.  K BDMQUIT
  1.  Q
  1. FUDISP ;DISPLAY REPORT
  1.  I $G(BDMLET)<2!($G(BDMLET)=3) D FUD1
  1.  I $G(BDMLET)>1 D FUL1
  1.  Q
  1. FUD1 D FUHEAD^BDMVRL42
  1.  I $E(IOST,1,2)="C-" D FUVALM Q
  1.  S X=0
  1.  F  S X=$O(^TMP("BDMVR",$J,X)) Q:'X  D
  1.  .S Y=$G(^TMP("BDMVR",$J,X,0))
  1.  .W !,Y
  1.  .D PAGE
  1.  Q
  1. FUL1 ;PRINT FOLLOW-UP LETTER
  1.  K BDMQUIT
  1.  S DFN=0
  1.  F  S DFN=$O(^TMP("BDMTMP",$J,"FUL",DFN)) Q:'DFN!$D(BDMQUIT)  D
  1.  .S BDMRPDA=$G(^ACM(41,"AC",DFN,BDMRDA))
  1.  .Q:'BDMRPDA
  1.  .D PAT(DFN,BDMRPDA)
  1.  .D PRINT^BDMLET
  1.  Q
  1. PAGE ;PAGE CONTROL
  1.  Q:IOSL-4>$Y
  1.  S:'$G(BDMPAGE) BDMPAGE=1
  1.  W @IOF
  1.  I $G(BDMGUI),BDMPAGE'=1 W !,"ZZZZZZZ"
  1.  W !?8,$S($G(BDMREGNM)]"":BDMREGNM,1:"DIABETES REGISTER")
  1.  W !?8,"FOLLOW-UP REPORT: ",BDM("FOLLOW-UP TYPE"),?60,"PAGE: ",BDMPAGE
  1.  W !!,"COMMUNITY",?16,"PATIENT",?42,"HRN",?49,"STATUS"
  1.  W !,"---------------",?16,"-------------------------",?42,"------",?49,"--------------------"
  1.  Q
  1. FUVALM ;USE LIST MANAGER TO DISPLAY REPORT TO SCREEN
  1.  S BDMVALM="BDM FOLLOW-UP REPORT"
  1.  D VALM^BDMVRL(BDMVALM)
  1.  Q
  1. FIND ;FIND PATIENTS WITHOUT SPECIFIED ITEM
  1.  N X,Y
  1.  S X=BDMFU
  1.  I BDMFU="CHOL"!(BDMFU="LDL")!(BDMFU="HDL")!(BDMFU="TRIG")!(BDMFU="CREA")!(BDMFU="HGB")!(BDMFU="LIVR")!(BDMFU="UPRO")!(BDMFU="URIN")!(BDMFU="GFR")!(BDMFU="UACR")!(BDMFU="HEPC") D LAB^BDMVRL43 Q
  1.  I BDMFU="TD" D IMMUN^BDMVRL43 Q
  1.  ;USE V EXAM FOR DENTAL INSTEAD OF V DENTAL
  1.  I X="DENT" D DENT
  1.  I X="EKG" S Y="^AUPNVDPR("
  1.  I "^FTEX^RECT^BRST^EYE^DENT^DEP^"[(U_X_U) S Y="^AUPNVXAM"
  1.  I X="MAM" S Y="^AUPNVRAD"
  1.  I X="FLU"!(X="PNEU")!(X="TD") S Y="^AUPNVIMM"
  1.  I X="PPD" S Y="^AUPNVSK"
  1.  I X="NTED"!(X="COMP")!(X="EXER")!(X="GENI") S Y="^AUPNVPED"
  1.  I X=(X="DIET")!(X="DISE")!(X="FUP")!(X="FTED")!(X="LIFE")!(X="MEDS") S Y="^AUPNVPED"
  1.  I X="HGB"!(X="LIVR")!(X="UPRO")!(X="URIN")!(X="CHOL")!(X="LDL")!(X="HDL")!(X="MICR")!(X="CREA")!(X="TRIG")!(X="PAP")!(X="UPT") S Y="^AUPNVLAB"
  1. F1 S BDMGBL=Y
  1.  I X="LIVR" D  Q:'$D(BDMQUIT)
  1.  .D LMEDS
  1.  .;IF PATIENT NOT TAKING TARGET MEDS THEY DON'T NEED TO BE ON F/U LIST
  1.  K BDMQUIT
  1.  I BDMFU="CHOL"!(BDMFU="LDL")!(BDMFU="HDL")!(BDMFU="TRIG")!(BDMFU="CREA")!(BDMFU="HGB")!(BDMFU="LIVR")!(BDMFU="UPRO")!(BDMFU="URIN")!(BDMFU="UPT")!(BDMFU="GFR") D LAB^BDMVRL43 Q
  1.  D FURESULT^BDMVRL42
  1.  I $D(BDMQUIT) K BDMQUIT Q
  1.  D ENTRY
  1.  Q
  1. LMEDS D LMEDS^BDMVRL2
  1.  Q
  1. FUNO ;EP Followup Entry
  1.  S X="*NO* "_BDM("FOLLOW-UP TYPE")_" on record."
  1. FUOUT ;EP;
  1.  I $G(BDMIANL) G FUOUT1
  1.  S ^TMP("BDMTMP",$J,BDM("COMMUNITY"),BDM("PATIENT"),BDMP,BDM("FOLLOW-UP TYPE"))=X_U_BDM("HRN")
  1.  S ^TMP("BDMTMP",$J,BDM("COMMUNITY"),BDM("PATIENT"))=DFN
  1.  Q:$G(BDMLET)<2
  1. FUOUT1 S ^TMP("BDMTMP",$J,"FUL",DFN,BDMP,BDM("FOLLOW-UP TYPE"))=X
  1.  Q
  1. FULAST ;EP;
  1.  S X1=DT
  1.  S:'$G(X2) X2=-330
  1.  D C^%DTC
  1.  S BDM("SHOULD HAVE FOLLOW-UP AFTER")=X
  1.  K X1,X2
  1.  Q
  1. LSTVST(X) ;EP;LAST VISIT
  1.  N Y
  1.  S Y=9999999-X
  1.  I Y>BDM("SHOULD HAVE FOLLOW-UP AFTER") S X=""
  1.  E  D
  1.  .X ^DD("DD")
  1.  .S X="last "_BDM("FOLLOW-UP TYPE")_" "_Y
  1.  Q X
  1. ENTRY ;EP;FOR INDEPENDENT CALLS
  1.  I $G(Z)="" D FUNO Q
  1.  S Z=$$LSTVST(Z)
  1. EDONE ;EP;FOLLOW-UP DONE
  1.  I Z="" D  Q
  1.  .K ^TMP("BDMTMP",$J,BDM("COMMUNITY"),BDM("PATIENT"),BDMP,BDM("FOLLOW-UP TYPE"))
  1.  .S BDMQUIT=""
  1.  I BDMFU="PPD",$D(BDM("PPD")) D
  1.  .I $P(BDM("PPD"),U)]"" S Z=Z_" ("_$S($E(BDM("PPD"))="N":"NEG",$E(BDM("PPD"))="P":"POS",1:"")
  1.  .I $P(BDM("PPD"),U,2) S Z=Z_$S($P(BDM("PPD"),U)="":" (",1:"-")_$P(BDM("PPD"),U,2)_" MM)"
  1.  .E  S:$P(BDM("PPD"),U)]""!$P(BDM("PPD"),U,2) Z=Z_")"
  1.  .K BDM("PPD")
  1.  S X=Z
  1.  D FUOUT
  1.  Q
  1. ACTIVE ;EP;TO SELECT PATIENT STATUS
  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 Register Patients"
  1.  S DIR("A")="Which patients"
  1.  S DIR("B")="Active"
  1.  D DIR^BDMFDIC
  1.  I Y]"","AITUDNONZ"[Y S BDM("STATUS")=Y Q
  1.  E  S BDMQUIT=""
  1.  Q
  1. REPLET ;PRINT REPORT OR LETTER
  1.  S DIR(0)="SO^1:Follow-up Report;2:Follow-up Letter;3:Both"
  1.  S DIR("A")="Which one"
  1.  S DIR("B")="Follow-up Report"
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  S BDMLET=+Y
  1.  Q:+Y=1
  1.  D SELECT^BDMLET
  1.  I '$G(BDMLDA) S BDMQUIT="" Q
  1.  Q
  1. Z(X) ;SET TMP NODE
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP("BDMVR",$J,VALMCNT,0)=X
  1.  Q
  1. PAT(DFN,ACMRPDA) ;EP;TO CHECK PATIENT DOD STATUS
  1.  Q:'ACMRPDA
  1.  Q:'$G(^DPT(+DFN,.35))
  1.  S DA=ACMRPDA
  1.  S DIE="^ACM(41,"
  1.  S DR="1////D"
  1.  D DIE^BDMFDIC
  1.  Q
  1. ST ;SELECT SEARCH TEMPLATE OR ENTIRE REGISTER
  1.  S DIR(0)="SO^1:Use Register Members;2:Use A Search Template"
  1.  S DIR("A")="Which Group"
  1.  S DIR("B")="Use Register Members"
  1.  D DIR^BDMFDIC
  1.  Q:Y<2
  1.  S DIC="^DIBT("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which Search Template: "
  1.  S DIC("S")="I $D(^DIBT(+Y,1)),$P(^DIBT(+Y,0),U,4)=2!($P(^DIBT(+Y,0),U,4)=9000001)"
  1.  D DIC^BDMFDIC
  1.  I +Y>0 S BDM("SEARCH TEMPLATE")=+Y
  1.  E  K BDM("SEARCH TEMPLATE")
  1.  Q
  1. DX ;EP;TO SELECT DIABETES DIAGNOSIS
  1.  D DX^BDMVRL2
  1.  Q
  1. PATDX ;INCLUDE PATIENTS WITH SPECIFIC DIAGNOSIS
  1.  D PATDX^BDMVRL2
  1.  Q
  1. DENT K BDM("IEN")
  1.  S Y="^AUPNVDEN"
  1.  F X=9320,9321 I $O(^AUTTADA("B",X,0)) S BDM("IEN",$O(^(0)))=""
  1.  I '$D(BDM("IEN")) D D1 Q
  1.  D F1
  1. D1 D DENT^BDMVRL41
  1.  Q
  1.  ;
  1. BDMGA(BDMRET,BDM,BDMFUAPP,BDMFL,BDMK,BDMRL,BDMFU,BDMLDA,BDMREG,BDMGUI,BDMDEMO) ;PEP - gui call
  1.  S BDMJ=$J
  1.  S BDMH=$H
  1.  F X="BDMJOB","BDMH","BDM","BDMRS","BDMFUAP","BDMBEG","BDGEND","BDMPBYV","BDMFL","BDMK","BDMRL","BDMFU","BDMLP","BDMLDA","BDMREG" 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="Follow-Up Needed"
  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^BDMVRL4",ZTDESC="GUI DM FOLLOW UP REPORT" D ^%ZTLOAD
  1.  D XIT
  1.  Q
  1. GUIEP ;EP - called from taskman
  1.  ;D ^FUPRINT
  1.  K ^TMP($J,"BDMFUR")
  1.  S IOM=80  ;cmi/maw added
  1.  S IOSL=55
  1.  S IOST="P"
  1.  D GUIR^XBLM("BDMG^BDMVRL4(.BDM)","^TMP($J,""BDMFUR"",")
  1.  ;Q:$G(BDMDSP)  ;quit if to screen
  1.  S X=0,C=0 F  S X=$O(^TMP($J,"BDMFUR",X)) Q:'X  D
  1.  . N BDMGDATA
  1.  . S BDMGDATA=^TMP($J,"BDMFUR",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.  ;