[613] | 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
|
---|