ACDPFACE ;IHS/ADC/EDE/KML - DISPLAY PATIENT VISIT;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
; This routine displays a patient's CDMIS INITIAL, REOPEN, or
; TRANS/DISCH/CLOSE visit with subordinate file entry to use as a
; face sheet in the chart.
;
START ;
W !
F D PATLOOP Q:ACDQ
D EOJ
Q
;
PATLOOP ; DISPLAY PATIENTS UNTIL DONE
D GETPAT
Q:ACDQ
D GETVSITS^ACDDEU ; gather all visits for patient
Q:ACDQ
D SELECT ; select visit to display
I ACDQ S ACDQ=0 Q
D DISPLAY ; display selected visit
I '$D(ACDSLAVE),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU
D DEV^ACDDEU Q:ACDQ ; select device
I $D(ACDSLAVE)!(IO'=IO(0)) D DISPLAY
K ACDSLAVE S IO=IO(0)
Q
;
GETPAT ; GET PATIENT
S ACDQ=1
S AUPNLK("ALL")=1
S DIC="^AUPNPAT(",DIC(0)="AEMQ",DIC("S")="I $D(^ACDVIS(""D"",+Y))" D DIC^ACDFMC
K AUPNLK("ALL")
Q:Y<0
S ACDDFNP=+Y,ACDDFN=$P(^DPT(ACDDFNP,0),U)
S ACDQ=0
Q
;
SELECT ; SELECT A CDMIS INITIAL/REOPEN/TDC VISIT
S ACDQ=1
W !
S ACDVIEN=0
K ACDVLST
I $O(^TMP("ACD",$J,"VISITS",0))="" W !,"----------",!,"No CDMIS visits!",!,"----------",! Q
S (ACDLC,ACDX,ACDY)=0
F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:ACDX="" S ACDY=0 F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY D
. S ACDTC=$P(^ACDVIS(ACDY,0),U,4)
. Q:ACDTC'="IN"&(ACDTC'="RE")&(ACDTC'="TD")
. S ACDLC=ACDLC+1
. S ACDVLST(ACDLC)=ACDY
. S DIC="9002172.1",DA=ACDY,DR=".01;1;3;5",DIQ="ACDPDD("
. D DIQ1^ACDFMC
. W ACDLC,?5,ACDPDD(9002172.1,ACDY,.01),?18," - ",ACDPDD(9002172.1,ACDY,1),"/",ACDPDD(9002172.1,ACDY,5)," ",ACDPDD(9002172.1,ACDY,3),!
. K ACDPDD
. Q
I 'ACDLC W !,"----------",!,"No type IN, RE, or TD visits!",!,"----------",! Q
S DIR(0)="NO^1:"_ACDLC,DIR("A")="Select one of the listed visits" K DA D ^DIR K DIR
S:Y ACDVIEN=ACDVLST(Y)
K ACDLC,ACDVLST
Q:'ACDVIEN
S ACDQ=0
Q
;
DISPLAY ; EP - DISPLAY VISIT AND SUBORDINATE FILE ENTRY
;//^ACDDE3
I $D(IO("Q")) D Q
. S ZTRTN="DISPLAYQ^ACDPFACE",ZTDESC="CDMIS FACE SHEET",ZTDTH=$H,ZTSAVE("ACD*")=""
. D ^%ZTLOAD
. Q
D DISPLAYQ
Q
;
DISPLAYQ ; EP - FOR TASKMAN
I $D(ACDSLAVE) S IOP=ACDSLAVE D ^%ZIS
U IO
;W:IO'=IO(0) @IOF
D:$E(IOST,1,2)="P-" CONF^ACDDEU
NEW ACDCOMC,ACDCOMCL,ACDCOMT,ACDCOMTL,ACDCONT,ACDCONTL,ACDDFN,ACDDFNP,ACDPROV,ACDPROVP
S ACDDA=ACDVIEN,ACDWSTAF(1)=1 D ^ACDWVIS K ACDWSTAF
S ACDTC=$P(^ACDVIS(ACDVIEN,0),U,4)
I ACDTC="TD" S ACDDA=$O(^ACDTDC("C",ACDVIEN,0)) I 1
E S ACDDA=$O(^ACDIIF("C",ACDVIEN,0))
I 'ACDDA W !!,"No '"_ACDTC_"' attached to this visit.",!
D @("^ACDW"_$S(ACDTC="TD":"TDC",1:"IIF"))
S ACDPFACE=1
D P1^ACDWCD1
K ACDPFACE
W:IO'=IO(0) @IOF
;I $D(ACDSLAVE) W @IOF D ^%ZISC
I $D(ACDSLAVE) D ^%ZISC
I $D(ZTQUEUED) D EOJ S ZTREQ="@"
U 0
Q
;
EOJ ;
D ^%ZISC
D ^ACDKILL
Q
ACDPFACE ;IHS/ADC/EDE/KML - DISPLAY PATIENT VISIT;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ; This routine displays a patient's CDMIS INITIAL, REOPEN, or
+4 ; TRANS/DISCH/CLOSE visit with subordinate file entry to use as a
+5 ; face sheet in the chart.
+6 ;
START ;
+1 WRITE !
+2 FOR
DO PATLOOP
IF ACDQ
QUIT
+3 DO EOJ
+4 QUIT
+5 ;
PATLOOP ; DISPLAY PATIENTS UNTIL DONE
+1 DO GETPAT
+2 IF ACDQ
QUIT
+3 ; gather all visits for patient
DO GETVSITS^ACDDEU
+4 IF ACDQ
QUIT
+5 ; select visit to display
DO SELECT
+6 IF ACDQ
SET ACDQ=0
QUIT
+7 ; display selected visit
DO DISPLAY
+8 IF '$DATA(ACDSLAVE)
IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^ACDDEU
+9 ; select device
DO DEV^ACDDEU
IF ACDQ
QUIT
+10 IF $DATA(ACDSLAVE)!(IO'=IO(0))
DO DISPLAY
+11 KILL ACDSLAVE
SET IO=IO(0)
+12 QUIT
+13 ;
GETPAT ; GET PATIENT
+1 SET ACDQ=1
+2 SET AUPNLK("ALL")=1
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
SET DIC("S")="I $D(^ACDVIS(""D"",+Y))"
DO DIC^ACDFMC
+4 KILL AUPNLK("ALL")
+5 IF Y<0
QUIT
+6 SET ACDDFNP=+Y
SET ACDDFN=$PIECE(^DPT(ACDDFNP,0),U)
+7 SET ACDQ=0
+8 QUIT
+9 ;
SELECT ; SELECT A CDMIS INITIAL/REOPEN/TDC VISIT
+1 SET ACDQ=1
+2 WRITE !
+3 SET ACDVIEN=0
+4 KILL ACDVLST
+5 IF $ORDER(^TMP("ACD",$JOB,"VISITS",0))=""
WRITE !,"----------",!,"No CDMIS visits!",!,"----------",!
QUIT
+6 SET (ACDLC,ACDX,ACDY)=0
+7 FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))
IF ACDX=""
QUIT
SET ACDY=0
FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))
IF 'ACDY
QUIT
Begin DoDot:1
+8 SET ACDTC=$PIECE(^ACDVIS(ACDY,0),U,4)
+9 IF ACDTC'="IN"&(ACDTC'="RE")&(ACDTC'="TD")
QUIT
+10 SET ACDLC=ACDLC+1
+11 SET ACDVLST(ACDLC)=ACDY
+12 SET DIC="9002172.1"
SET DA=ACDY
SET DR=".01;1;3;5"
SET DIQ="ACDPDD("
+13 DO DIQ1^ACDFMC
+14 WRITE ACDLC,?5,ACDPDD(9002172.1,ACDY,.01),?18," - ",ACDPDD(9002172.1,ACDY,1),"/",ACDPDD(9002172.1,ACDY,5)," ",ACDPDD(9002172.1,ACDY,3),!
+15 KILL ACDPDD
+16 QUIT
End DoDot:1
+17 IF 'ACDLC
WRITE !,"----------",!,"No type IN, RE, or TD visits!",!,"----------",!
QUIT
+18 SET DIR(0)="NO^1:"_ACDLC
SET DIR("A")="Select one of the listed visits"
KILL DA
DO ^DIR
KILL DIR
+19 IF Y
SET ACDVIEN=ACDVLST(Y)
+20 KILL ACDLC,ACDVLST
+21 IF 'ACDVIEN
QUIT
+22 SET ACDQ=0
+23 QUIT
+24 ;
DISPLAY ; EP - DISPLAY VISIT AND SUBORDINATE FILE ENTRY
+1 ;//^ACDDE3
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTRTN="DISPLAYQ^ACDPFACE"
SET ZTDESC="CDMIS FACE SHEET"
SET ZTDTH=$HOROLOG
SET ZTSAVE("ACD*")=""
+4 DO ^%ZTLOAD
+5 QUIT
End DoDot:1
QUIT
+6 DO DISPLAYQ
+7 QUIT
+8 ;
DISPLAYQ ; EP - FOR TASKMAN
+1 IF $DATA(ACDSLAVE)
SET IOP=ACDSLAVE
DO ^%ZIS
+2 USE IO
+3 ;W:IO'=IO(0) @IOF
+4 IF $EXTRACT(IOST,1,2)="P-"
DO CONF^ACDDEU
+5 NEW ACDCOMC,ACDCOMCL,ACDCOMT,ACDCOMTL,ACDCONT,ACDCONTL,ACDDFN,ACDDFNP,ACDPROV,ACDPROVP
+6 SET ACDDA=ACDVIEN
SET ACDWSTAF(1)=1
DO ^ACDWVIS
KILL ACDWSTAF
+7 SET ACDTC=$PIECE(^ACDVIS(ACDVIEN,0),U,4)
+8 IF ACDTC="TD"
SET ACDDA=$ORDER(^ACDTDC("C",ACDVIEN,0))
IF 1
+9 IF '$TEST
SET ACDDA=$ORDER(^ACDIIF("C",ACDVIEN,0))
+10 IF 'ACDDA
WRITE !!,"No '"_ACDTC_"' attached to this visit.",!
+11 DO @("^ACDW"_$SELECT(ACDTC="TD":"TDC",1:"IIF"))
+12 SET ACDPFACE=1
+13 DO P1^ACDWCD1
+14 KILL ACDPFACE
+15 IF IO'=IO(0)
WRITE @IOF
+16 ;I $D(ACDSLAVE) W @IOF D ^%ZISC
+17 IF $DATA(ACDSLAVE)
DO ^%ZISC
+18 IF $DATA(ZTQUEUED)
DO EOJ
SET ZTREQ="@"
+19 USE 0
+20 QUIT
+21 ;
EOJ ;
+1 DO ^%ZISC
+2 DO ^ACDKILL
+3 QUIT
