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

AMHLSW.m

Go to the documentation of this file.
  1. AMHLSW ; IHS/CMI/LAB - SWITCH TO V FILE ;
  1. ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1. ;
  1. ; AMHLSWD=DICTIONARY NUMBER
  1. ; AMHLSWCR=LINKING CROSS REFERENCE
  1. ; AMHLSWV=VISIT DFN
  1. ;
  1. S U="^"
  1. S AMHLOOK=""
  1. Q:'$D(AMHSWV)
  1. Q:AMHSWV=""
  1. Q:'$D(AMHSWD)
  1. Q:'AMHSWD
  1. Q:'$D(^DIC(AMHSWD,0,"GL"))
  1. S AMHSWG=^DIC(AMHSWD,0,"GL")
  1. I '$D(AMHSWCR),AMHSWD'=(AMHSWD\1),AMHSWD\1=9000010 S AMHSWCR="AD"
  1. I '$D(AMHSWCR),AMHSWD\1'=9000010 S AMHSWCR="AC"
  1. Q:'$D(AMHSWCR)
  1. Q:AMHSWCR=""
  1. W !
  1. S AMHSWDA=0 F AMHSWI=1:1 S AMHSWDA=$O(@(AMHSWG_""""_AMHSWCR_""",AMHSWV,AMHSWDA)")) Q:AMHSWDA="" S DIC=AMHSWG,Y=AMHSWDA D GETVAL,WRITE
  1. S AMHSWI=AMHSWI-1
  1. S AMHSWAN="" S:AMHSWI=1 AMHSWAN=AMHSWI
  1. RDR I AMHSWAN="",AMHSWI R !!,"Choose: ",AMHSWAN:$S($D(DTIME):DTIME,1:300)
  1. I AMHSWAN,$D(AMHSWT(AMHSWAN)) S AMHLOOK=AMHSWT(AMHSWAN)
  1. K AMHSWV,AMHSWVA,AMHSWL,AMHSWCR,AMHSWD,AMHSWG,AMHSWDA,AMHSWI,AMHSWAN,AMHSWT,AMHSWN,AMHSWEX,AMHSWL,AMHSWP,AMHSWZ,AMHSWD2,AMHSWG2,AMHSWV2,Y
  1. W !
  1. Q
  1. ;
  1. GETVAL ;
  1. S AMHSWD2=AMHSWD,AMHSWG2=AMHSWG,AMHSWV2=AMHSWDA
  1. F AMHSWL=0:0 S AMHSWVA=$P(@(AMHSWG2_AMHSWV2_",0)"),U) Q:$P(@("^DD("_AMHSWD2_",.01,0)"),U,2)'["P" S AMHSWG2=U_$P(^(0),U,3),AMHSWD2=+$P($P(^(0),U,2),"P",2),AMHSWV2=AMHSWVA
  1. Q
  1. ;
  1. WRITE ;
  1. W !,AMHSWI," ",AMHSWVA
  1. S AMHSWN=0,AMHSWT(AMHSWI)=AMHSWDA F AMHSWL=0:0 S AMHSWN=$O(@("^DD("_AMHSWD_",0,""ID"",AMHSWN)")) Q:AMHSWN="" S AMHSWEX=^(AMHSWN) W @("$E("_DIC_"Y,0),0)") X AMHSWEX
  1. Q