DVBCUTA4 ;ALB/GTS-AMIE C&P UTILITY ROUTINE A-4 ; 2/13/95 11:30 AM
;;2.7;AMIE;;Apr 10, 1995
;
;** Version Changes
; 2.7 - New routine (Enhc 13)
;
REFRSH(TMPDA) ;** Refresh the screen with the current appt's
W @IOF
N LPDA
W !!!,"Select an appointment to link to the 2507 request",!
W !,?1,"1",?4,"Display Current C&P Appointment Links"
F LPDA=2:1:TMPDA Q:'$D(^TMP("DVBC",$J,LPDA)) DO
.W !,?1,LPDA,?4,$P(^TMP("DVBC",$J,LPDA),U,1)
.W ?23,$E($P(^TMP("DVBC",$J,LPDA),U,2),1,22)
.W:$D(^DVB(396.95,"AB",REQDA,$P(^TMP("DVBC",$J,LPDA),U,4))) ?47,"*CL"
.W ?51,$E($P(^TMP("DVBC",$J,LPDA),U,3),1,27)
Q
;
ENHNC() ;**Return event drvr dialogue mode
N ENHCMODE,PARAMDA
S PARAMDA=0
S PARAMDA=$O(^DVB(396.1,PARAMDA))
S ENHCMODE=$P(^DVB(396.1,PARAMDA,0),U,18)
Q ENHCMODE
;
EXAMLST(EXAMDA,EXAMSTAT) ;** Output exam
I $Y>(IOSL-5) DO
.S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue."
.S DIR("A",1)=" " D ^DIR K DIR,X,Y
.D:'$D(DTOUT)&('$D(DUOUT)) EXMHD^DVBCUTL6
I '$D(DTOUT),('$D(DUOUT)) DO
.S:EXAMSTAT="C" EXAMSTAT="Completed"
.S:EXAMSTAT="O" EXAMSTAT="Open"
.S:EXAMSTAT="X" EXAMSTAT="Canceled by MAS"
.S:EXAMSTAT="RX" EXAMSTAT="Canceled by RO"
.S:EXAMSTAT="T" EXAMSTAT="Transferred Out"
.W !,?1,$P(^DVB(396.6,$P(^DVB(396.4,EXAMDA,0),U,3),0),U,2),?41,EXAMSTAT
Q
;
TRANCHK(REQDA) ;**Check for 2507 completly x-fered
N TRANVAL,XFRD
S TRANVAL=0
I $D(^DVB(396.3,REQDA,4)),($P(^DVB(396.3,REQDA,4),U,1)="y") DO
.S XFRD=""
.N XMDA
.F XMDA=0:0 S XMDA=$O(^DVB(396.4,"C",REQDA,XMDA)) Q:(XMDA=""!'$D(XFRD)) DO
..I $P(^DVB(396.4,XMDA,0),U,4)'="T" K XFRD
S:$D(XFRD) TRANVAL=1
Q TRANVAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCUTA4 1654 printed Apr 09, 2024@20:54:59 Page 2
DVBCUTA4 ;ALB/GTS-AMIE C&P UTILITY ROUTINE A-4 ; 2/13/95 11:30 AM
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
+3 ;** Version Changes
+4 ; 2.7 - New routine (Enhc 13)
+5 ;
REFRSH(TMPDA) ;** Refresh the screen with the current appt's
+1 WRITE @IOF
+2 NEW LPDA
+3 WRITE !!!,"Select an appointment to link to the 2507 request",!
+4 WRITE !,?1,"1",?4,"Display Current C&P Appointment Links"
+5 FOR LPDA=2:1:TMPDA
if '$DATA(^TMP("DVBC",$JOB,LPDA))
QUIT
Begin DoDot:1
+6 WRITE !,?1,LPDA,?4,$PIECE(^TMP("DVBC",$JOB,LPDA),U,1)
+7 WRITE ?23,$EXTRACT($PIECE(^TMP("DVBC",$JOB,LPDA),U,2),1,22)
+8 if $DATA(^DVB(396.95,"AB",REQDA,$PIECE(^TMP("DVBC",$JOB,LPDA),U,4)))
WRITE ?47,"*CL"
+9 WRITE ?51,$EXTRACT($PIECE(^TMP("DVBC",$JOB,LPDA),U,3),1,27)
End DoDot:1
+10 QUIT
+11 ;
ENHNC() ;**Return event drvr dialogue mode
+1 NEW ENHCMODE,PARAMDA
+2 SET PARAMDA=0
+3 SET PARAMDA=$ORDER(^DVB(396.1,PARAMDA))
+4 SET ENHCMODE=$PIECE(^DVB(396.1,PARAMDA,0),U,18)
+5 QUIT ENHCMODE
+6 ;
EXAMLST(EXAMDA,EXAMSTAT) ;** Output exam
+1 IF $Y>(IOSL-5)
Begin DoDot:1
+2 SET DIR(0)="FAO^1:1"
SET DIR("A")="Hit Return to continue."
+3 SET DIR("A",1)=" "
DO ^DIR
KILL DIR,X,Y
+4 if '$DATA(DTOUT)&('$DATA(DUOUT))
DO EXMHD^DVBCUTL6
End DoDot:1
+5 IF '$DATA(DTOUT)
IF ('$DATA(DUOUT))
Begin DoDot:1
+6 if EXAMSTAT="C"
SET EXAMSTAT="Completed"
+7 if EXAMSTAT="O"
SET EXAMSTAT="Open"
+8 if EXAMSTAT="X"
SET EXAMSTAT="Canceled by MAS"
+9 if EXAMSTAT="RX"
SET EXAMSTAT="Canceled by RO"
+10 if EXAMSTAT="T"
SET EXAMSTAT="Transferred Out"
+11 WRITE !,?1,$PIECE(^DVB(396.6,$PIECE(^DVB(396.4,EXAMDA,0),U,3),0),U,2),?41,EXAMSTAT
End DoDot:1
+12 QUIT
+13 ;
TRANCHK(REQDA) ;**Check for 2507 completly x-fered
+1 NEW TRANVAL,XFRD
+2 SET TRANVAL=0
+3 IF $DATA(^DVB(396.3,REQDA,4))
IF ($PIECE(^DVB(396.3,REQDA,4),U,1)="y")
Begin DoDot:1
+4 SET XFRD=""
+5 NEW XMDA
+6 FOR XMDA=0:0
SET XMDA=$ORDER(^DVB(396.4,"C",REQDA,XMDA))
if (XMDA=""!'$DATA(XFRD))
QUIT
Begin DoDot:2
+7 IF $PIECE(^DVB(396.4,XMDA,0),U,4)'="T"
KILL XFRD
End DoDot:2
End DoDot:1
+8 if $DATA(XFRD)
SET TRANVAL=1
+9 QUIT TRANVAL
