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