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

BHSCOAG.m

Go to the documentation of this file.
  1. BHSCOAG ;IHS/MSC/MGH - Health Summary for Anticoag data ;22-Aug-2014 14:54;DU
  1. ;;1.0;HEALTH SUMMARY COMPONENTS;**8,9**;Mar 17,2006;Build 16
  1. ;===================================================================
  1. ANTICOAG ;DISPLAY PROBLEMS USED BY VISITS IN HEALTH SUMMARY
  1. N TARGET,X,LINE,IEN,QUIT,NUM,CNT
  1. ;For Visit instructions and treatments, the default is the latest visit
  1. S GMTSNDM=$G(GMTSNDM)
  1. I (GMTSNDM="")!(GMTSNDM=-1) S GMTSNDM=999
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. ;Find the visits
  1. S CNT=0
  1. S IEN=$C(0)
  1. F S IEN=$O(^AUPNVACG("AC",DFN,IEN),-1) Q:IEN=""!(CNT>GMTSNDM) D
  1. .Q:$$GET1^DIQ(9000010.51,IEN,1.01)'=""
  1. .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"Anticoag Data",!
  1. .S CNT=CNT+1
  1. .D DATA(IEN)
  1. Q
  1. DATA(IEN) ;Get the data for the anticoag entry
  1. N EVDT,WAR,GOAL,MAX,MIN,DUR,START,STOP,COMM,STRING,STRING,COMMENT,END,STRING2
  1. S STRING2=""
  1. S EVDT=$$GET1^DIQ(9000010.51,IEN,1201)
  1. I EVDT="" S EVDT=$$GET1^DIQ(9000010.51,IEN,.03)
  1. S WAR=$$GET1^DIQ(9000010.51,IEN,.01)
  1. S GOAL=$$GET1^DIQ(9000010.51,IEN,.04)
  1. S MIN=$$GET1^DIQ(9000010.51,IEN,.05)
  1. S MAX=$$GET1^DIQ(9000010.51,IEN,.06)
  1. S DUR=$$GET1^DIQ(9000010.51,IEN,.07)
  1. S START=$$GET1^DIQ(9000010.51,IEN,.08)
  1. S END=$$GET1^DIQ(9000010.51,IEN,.09)
  1. S COMMENT=$$GET1^DIQ(9000010.51,IEN,1101)
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W !!,"Date: "_EVDT_" Warfarin: "_WAR
  1. S STRING="Goal: "_GOAL
  1. I MIN'="" S STRING=STRING_" Min: "_MIN
  1. I MAX'="" S STRING=STRING_" Max: "_MAX
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W !,STRING
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W !,"Duration: "_DUR
  1. I START'="" S STRING2="Start "_START
  1. I END'="" S STRING2=STRING2_" End: "_END
  1. I STRING2'="" D
  1. .D CKP^GMTSUP Q:$D(GMTSQIT)
  1. .W !,STRING2
  1. I COMMENT'="" D
  1. .D CKP^GMTSUP Q:$D(GMTSQIT)
  1. .W !,"Comment: "_COMMENT
  1. Q
  1. TMPGBL() ;EP
  1. K ^TMP("BHSCOAG",$J) Q $NA(^($J))