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

DVBCUTA4.m

Go to the documentation of this file.
  1. DVBCUTA4 ;ALB/GTS-AMIE C&P UTILITY ROUTINE A-4 ; 2/13/95 11:30 AM
  1. ;;2.7;AMIE;;Apr 10, 1995
  1. ;
  1. ;** Version Changes
  1. ; 2.7 - New routine (Enhc 13)
  1. ;
  1. REFRSH(TMPDA) ;** Refresh the screen with the current appt's
  1. W @IOF
  1. N LPDA
  1. W !!!,"Select an appointment to link to the 2507 request",!
  1. W !,?1,"1",?4,"Display Current C&P Appointment Links"
  1. F LPDA=2:1:TMPDA Q:'$D(^TMP("DVBC",$J,LPDA)) DO
  1. .W !,?1,LPDA,?4,$P(^TMP("DVBC",$J,LPDA),U,1)
  1. .W ?23,$E($P(^TMP("DVBC",$J,LPDA),U,2),1,22)
  1. .W:$D(^DVB(396.95,"AB",REQDA,$P(^TMP("DVBC",$J,LPDA),U,4))) ?47,"*CL"
  1. .W ?51,$E($P(^TMP("DVBC",$J,LPDA),U,3),1,27)
  1. Q
  1. ;
  1. ENHNC() ;**Return event drvr dialogue mode
  1. N ENHCMODE,PARAMDA
  1. S PARAMDA=0
  1. S PARAMDA=$O(^DVB(396.1,PARAMDA))
  1. S ENHCMODE=$P(^DVB(396.1,PARAMDA,0),U,18)
  1. Q ENHCMODE
  1. ;
  1. EXAMLST(EXAMDA,EXAMSTAT) ;** Output exam
  1. I $Y>(IOSL-5) DO
  1. .S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue."
  1. .S DIR("A",1)=" " D ^DIR K DIR,X,Y
  1. .D:'$D(DTOUT)&('$D(DUOUT)) EXMHD^DVBCUTL6
  1. I '$D(DTOUT),('$D(DUOUT)) DO
  1. .S:EXAMSTAT="C" EXAMSTAT="Completed"
  1. .S:EXAMSTAT="O" EXAMSTAT="Open"
  1. .S:EXAMSTAT="X" EXAMSTAT="Canceled by MAS"
  1. .S:EXAMSTAT="RX" EXAMSTAT="Canceled by RO"
  1. .S:EXAMSTAT="T" EXAMSTAT="Transferred Out"
  1. .W !,?1,$P(^DVB(396.6,$P(^DVB(396.4,EXAMDA,0),U,3),0),U,2),?41,EXAMSTAT
  1. Q
  1. ;
  1. TRANCHK(REQDA) ;**Check for 2507 completly x-fered
  1. N TRANVAL,XFRD
  1. S TRANVAL=0
  1. I $D(^DVB(396.3,REQDA,4)),($P(^DVB(396.3,REQDA,4),U,1)="y") DO
  1. .S XFRD=""
  1. .N XMDA
  1. .F XMDA=0:0 S XMDA=$O(^DVB(396.4,"C",REQDA,XMDA)) Q:(XMDA=""!'$D(XFRD)) DO
  1. ..I $P(^DVB(396.4,XMDA,0),U,4)'="T" K XFRD
  1. S:$D(XFRD) TRANVAL=1
  1. Q TRANVAL