| 1 | DVBCUTA4 ;ALB/GTS-AMIE C&P UTILITY ROUTINE A-4 ; 2/13/95  11:30 AM
 | 
|---|
| 2 |  ;;2.7;AMIE;;Apr 10, 1995
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;** Version Changes
 | 
|---|
| 5 |  ;   2.7 - New routine (Enhc 13)
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | REFRSH(TMPDA) ;** Refresh the screen with the current appt's
 | 
|---|
| 8 |  W @IOF
 | 
|---|
| 9 |  N LPDA
 | 
|---|
| 10 |  W !!!,"Select an appointment to link to the 2507 request",!
 | 
|---|
| 11 |  W !,?1,"1",?4,"Display Current C&P Appointment Links"
 | 
|---|
| 12 |  F LPDA=2:1:TMPDA Q:'$D(^TMP("DVBC",$J,LPDA))  DO
 | 
|---|
| 13 |  .W !,?1,LPDA,?4,$P(^TMP("DVBC",$J,LPDA),U,1)
 | 
|---|
| 14 |  .W ?23,$E($P(^TMP("DVBC",$J,LPDA),U,2),1,22)
 | 
|---|
| 15 |  .W:$D(^DVB(396.95,"AB",REQDA,$P(^TMP("DVBC",$J,LPDA),U,4))) ?47,"*CL"
 | 
|---|
| 16 |  .W ?51,$E($P(^TMP("DVBC",$J,LPDA),U,3),1,27)
 | 
|---|
| 17 |  Q
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 | ENHNC() ;**Return event drvr dialogue mode
 | 
|---|
| 20 |  N ENHCMODE,PARAMDA
 | 
|---|
| 21 |  S PARAMDA=0
 | 
|---|
| 22 |  S PARAMDA=$O(^DVB(396.1,PARAMDA))
 | 
|---|
| 23 |  S ENHCMODE=$P(^DVB(396.1,PARAMDA,0),U,18)
 | 
|---|
| 24 |  Q ENHCMODE
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 | EXAMLST(EXAMDA,EXAMSTAT) ;** Output exam
 | 
|---|
| 27 |  I $Y>(IOSL-5) DO
 | 
|---|
| 28 |  .S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue."
 | 
|---|
| 29 |  .S DIR("A",1)=" " D ^DIR K DIR,X,Y
 | 
|---|
| 30 |  .D:'$D(DTOUT)&('$D(DUOUT)) EXMHD^DVBCUTL6
 | 
|---|
| 31 |  I '$D(DTOUT),('$D(DUOUT)) DO
 | 
|---|
| 32 |  .S:EXAMSTAT="C" EXAMSTAT="Completed"
 | 
|---|
| 33 |  .S:EXAMSTAT="O" EXAMSTAT="Open"
 | 
|---|
| 34 |  .S:EXAMSTAT="X" EXAMSTAT="Canceled by MAS"
 | 
|---|
| 35 |  .S:EXAMSTAT="RX" EXAMSTAT="Canceled by RO"
 | 
|---|
| 36 |  .S:EXAMSTAT="T" EXAMSTAT="Transferred Out"
 | 
|---|
| 37 |  .W !,?1,$P(^DVB(396.6,$P(^DVB(396.4,EXAMDA,0),U,3),0),U,2),?41,EXAMSTAT
 | 
|---|
| 38 |  Q
 | 
|---|
| 39 |  ;
 | 
|---|
| 40 | TRANCHK(REQDA) ;**Check for 2507 completly x-fered
 | 
|---|
| 41 |  N TRANVAL,XFRD
 | 
|---|
| 42 |  S TRANVAL=0
 | 
|---|
| 43 |  I $D(^DVB(396.3,REQDA,4)),($P(^DVB(396.3,REQDA,4),U,1)="y") DO
 | 
|---|
| 44 |  .S XFRD=""
 | 
|---|
| 45 |  .N XMDA
 | 
|---|
| 46 |  .F XMDA=0:0 S XMDA=$O(^DVB(396.4,"C",REQDA,XMDA)) Q:(XMDA=""!'$D(XFRD))  DO
 | 
|---|
| 47 |  ..I $P(^DVB(396.4,XMDA,0),U,4)'="T" K XFRD
 | 
|---|
| 48 |  S:$D(XFRD) TRANVAL=1
 | 
|---|
| 49 |  Q TRANVAL
 | 
|---|