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

AMQQVIEW.m

Go to the documentation of this file. 
  1. AMQQVIEW ; IHS/CMI/THL - VIEW TAXONOMIES AND SEARCH TEMPLATES ;
  1.  ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1.  ; CALLS TASKMAN
  1. CHK I $D(DTOUT)+$D(DUOUT)+(Y=-1)+(Y="") K DIRUT,DUOUT,DTOUT S AMQQQUIT="" Q
  1.  Q
  1.  ;
  1. TAX ; ENTRY POINT FROM AMQQOPT1
  1.  S AMQQVG="^ATXAX"
  1.  S AMQQVTYP="TAX"
  1.  S AMQQVSS=11
  1.  D OUT
  1.  G EXIT
  1. TMP ; ENTRY POINT FROM AMQQOPT1
  1.  W !!!,"You can view templates which store either PATIENTS or VISITS =>"
  1.  S DIR(0)="SO^1:PATIENTS;2:VISITS;3:BOTH patients and visits"
  1.  S DIR("A")=$C(10)_"     Your choice"
  1.  D ^DIR
  1.  K DIR
  1.  D CHK
  1.  I  Q
  1.  S AMQQVCK=$S(Y=1:"I %=2!(%=9000001)",Y=2:"I %=9000010",1:"I %=2!(%=9000001)!(%=9000010)")
  1.  S AMQQVG="^DIBT"
  1.  S AMQQVTYP="TMP"
  1.  S AMQQVSS="%D"
  1.  D OUT
  1. EXIT K AMQQQUIT,AMQQVENO,AMQQVNL,AMQQVWP,AMQQVENA,AMQQVG,AMQQVTYP,AMQQVSS,AMQQVIX,AMQQVCK,AMQQVOFF,%,I,Z
  1.  W @IOF
  1.  Q
  1.  ;
  1. OUT S AMQQVOFF=0
  1.  W !!
  1.  S %ZIS="Q"
  1.  D ^%ZIS
  1.  I POP Q
  1.  I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G OUT
  1.  I $E(IOST,1,2)="P-" N AMQQRV,AMQQNV,AMQQXV S (AMQQRV,AMQQNV)="AMQQXV",AMQQXV=""
  1.  I $E(IOST,1,2)="C-" W !,@AMQQRV,@AMQQNV S AMQQVOFF=$X
  1.  I '$D(IO("Q")) U IO D TASK D ^%ZISC Q
  1.  S ZTRTN="TASK^AMQQVIEW"
  1.  S ZTIO=ION
  1.  S ZTDTH="NOW"
  1.  S ZTDESC="Q-MAN LIST OF TAXONOMIES AND TEMPLATES"
  1. QUEUE F I=1:1 S %=$P("DT;DTIME;DUZ(;DUZ;U;AMQQV*;AMQQ200(;AMQQRV;AMQQNV;AMQQXV",";",I) Q:%=""  S ZTSAVE(%)=""
  1.  D ^%ZTLOAD
  1.  D ^%ZISC
  1.  W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
  1.  H 3
  1.  Q
  1.  ;
  1. TASK D HEADER
  1.  S AMQQVNL=0
  1.  I AMQQVTYP="TMP" F AMQQVIX="F9000001","F2","F9000010" I $D(@AMQQVG@(AMQQVIX)) S AMQQVENA="" F  S AMQQVENA=$O(@AMQQVG@(AMQQVIX,AMQQVENA)) Q:AMQQVENA=""  F AMQQVENO=0:0 S AMQQVENO=$O(@AMQQVG@(AMQQVIX,AMQQVENA,AMQQVENO)) Q:'AMQQVENO  D TLSET
  1.  I AMQQVTYP="TAX" S AMQQVENA="" F  S AMQQVENA=$O(@AMQQVG@("B",AMQQVENA)) Q:AMQQVENA=""  F AMQQVENO=0:0 S AMQQVENO=$O(@AMQQVG@("B",AMQQVENA,AMQQVENO)) Q:'AMQQVENO  D TLSET,MEM
  1.  I '$D(AMQQQUIT),$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR D CHK
  1.  Q
  1.  ;
  1. TLSET I AMQQVTYP="TAX" G TLS1
  1.  S %=$P($G(@AMQQVG@(AMQQVENO,0)),U,4)
  1.  X AMQQVCK E  Q
  1.  I $D(@AMQQVG@(AMQQVENO,1))<10 Q
  1.  D TLS1
  1.  Q
  1. MEM ; List members of taxonomy
  1.  N AMQQTX
  1.  I $O(^ATXAX(AMQQVENO,21,0)) D PAUSE Q:$D(AMQQQUIT)  W !,$P(^ATXAX(AMQQVENO,0),U)_" Taxonomy Members:",! D PAUSE S AMQQTX=0 F  S AMQQTX=$O(^ATXAX(AMQQVENO,21,AMQQTX)) Q:'AMQQTX!($D(AMQQQUIT))!(AMQQVENO=99999999)  D
  1.  .D PAUSE
  1.  .I $D(AMQQQUIT) Q
  1.  .N %,%A,%B
  1.  .S %=$P(^ATXAX(AMQQVENO,21,AMQQTX,0),U,2),%A=$P(^(0),U)
  1.  .I %]"",%?1N.N S %B=% D PTRVAL S %=%B
  1.  .I %A?1N.N S %B=%A D PTRVAL S %A=%B
  1.  .I %]"" W !,$S(%=%A:%,1:%A_"-"_%) I $P(^ATXAX(AMQQVENO,21,AMQQTX,0),U,3) W ?40,$$VAL^XBDIQ1(80.4,$P(^ATXAX(AMQQVENO,21,AMQQTX,0),U,3),.01)
  1.  .E  W !,%A I $P(^ATXAX(AMQQVENO,21,AMQQTX,0),U,3) W ?40,$$VAL^XBDIQ1(80.4,$P(^ATXAX(AMQQVENO,21,AMQQTX,0),U,3),.01)
  1.  .D PAUSE
  1.  W !! D PAUSE,PAUSE
  1.  Q
  1.  ;
  1. PTRVAL ; Change from ptr val to actual val
  1.  N X,G
  1.  I $P(^ATXAX(AMQQVENO,0),U,15) S G=^DIC($P(^(0),U,15),0,"GL")
  1. AGIN I $P(@(G_"0)"),U,2)["P" S G=^DIC(+$P($P(^DD(+$P(@(G_"0)"),U,2),.01,0),U,2),"P",2),0,"GL") G AGIN
  1.  Q:$P($G(@(G_%B_",0)")),U)=""
  1.  S %B=$P(@(G_%B_",0)"),U)
  1.  Q
  1.  ;
  1. TLS1 S X=@AMQQVG@(AMQQVENO,0)
  1.  D PAUSE
  1.  I $D(AMQQQUIT) Q
  1.  S %=$P(X,U)
  1.  S %=$E(%,1,31)
  1.  W @AMQQRV,%,@AMQQNV
  1.  D @(AMQQVTYP_"SET")
  1.  W !
  1.  S Z=$S($G(@AMQQVG@(AMQQVENO,AMQQVSS,1,0))="":"   No description entered",1:("    "_$E(^(0),1,75)))
  1.  I Z?1.P S Z=$S($G(@AMQQVG@(AMQQVENO,AMQQVSS,2,0))="":"  No description entered",1:("    "_$E(^(0),1,75)))
  1.  W Z,!
  1.  D PAUSE
  1.  W !
  1.  D PAUSE
  1.  Q
  1.  ;
  1. TAXSET S %=$P(X,U,9)
  1.  S Y=%
  1.  X ^DD("DD")
  1.  I Y'=% W ?32+AMQQVOFF,$P(Y,"@")
  1.  S %=$P(X,U,5)
  1.  I %'="" S %=$P($G(@AMQQ200(3)@(%,0)),U),%=$P(%,","),%=$E(%,1,15) W ?46+AMQQVOFF,%
  1.  S %=$P(X,U,15)
  1.  I %]"" S %=$P($G(^DIC(%,0)),U),%=$E(%,1,18-AMQQVOFF) W ?62+AMQQVOFF,%
  1.  Q
  1.  ;
  1. TMPSET S %=$P(X,U,2)
  1.  S Y=%
  1.  X ^DD("DD")
  1.  I Y'=% W ?32+AMQQVOFF,$P(Y,"@")
  1.  S %=$P(X,U,5)
  1.  I %'="" S %=$P($G(@AMQQ200(3)@(%,0)),U),%=$P(%,","),%=$E(%,1,15) W ?46+AMQQVOFF,%
  1.  S %=$P(X,U,$S(AMQQVTYP="TMP":4,1:15))
  1.  S %=$P($G(^DIC(%,0)),U)
  1.  S %=$E(%,1,18-AMQQVOFF)
  1.  W ?62+AMQQVOFF,%
  1.  Q
  1.  ;
  1. WPAUSE W !
  1. PAUSE S AMQQVNL=AMQQVNL+1
  1.  I AMQQVNL#(IOSL-4) Q
  1.  I $E(IOST,1,2)="P-" W @IOF Q
  1.  W !!,"<>"
  1.  R %:DTIME E  S %=U
  1.  I $E(%)=U S AMQQQUIT="",(AMQQVWP,AMQQVENO)=99999999,AMQQVENA="zzzzzzzz" Q
  1.  S $P(%,"-",79)=""
  1.  W @IOF,$C(13)
  1.  W $S(AMQQVTYP="TAX":"TAXONOMY",1:"TEMPLATE"),?32,"DATE",?46,"CREATOR",?62,"FILEMAN FILE"
  1.  W !,?4,"Narrative description of ",$S(AMQQVTYP="TAX":"taxonomy",1:"template")
  1.  W !,%,!
  1.  Q
  1.  ;