- 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 Feb 18, 2025@23:15:35 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