DVBCLOG2 ;ALB/GTS-LOG A 2507 REQUEST CONT; 11/17/94 1:30 PM
;;2.7;AMIE;;Apr 10, 1995
;
CLINSF ;** Reset 2507 when priority changed from Insufficient
S DA=REQDA,DIE="^DVB(396.3,",DR="44///@;45///@"
D ^DIE
K DA,DIE,DR,Y
Q
;
INSUF ;** Enter Insuffient 2507 info
W @IOF
S DVBADFN=$P(^DVB(396.3,REQDA,0),"^",1),DVBADA="",DVBASTAT="C"
D REQARY^DVBCUTL5 ;**Set up ^TMP of 2507's
I $D(^TMP("DVBC",$J)) DO REQSEL^DVBCUTL5 S DVBASEL=+Y ;** Select 2507
I '$D(^TMP("DVBC",$J)) S DVBASEL=0
I +DVBASEL>0 DO ;** Update ORIGINAL 2507 REQUEST
.S DVBAORD=""
.D FINDDA^DVBCUTL5 ;** Loop through ^TMP and get selected DA
.K DA,DIE,DR,Y
.S DA=REQDA,DIE="^DVB(396.3,",DR="44////"_DVBADA D ^DIE
K DA,DIE,DR,Y,DIR,X,^TMP("DVBC",$J),DVBAORD,DVBAMORE,DVBACNT,DVBALP
K DVBAPNAM,DVBASEL,DVBAOUT,DVBADA,DVBADFN,DVBADT,DVBADTOT
;
;** If 2507 not linked to completed 2507 and not time or '^' out
;** when selecting 2507, enter 2507 PROCESSING TIME
;** NOTE: I '$D(DVBAOUT) removed 2/3/95 because killed above
I $D(^DVB(396.3,REQDA,5)),(+$P(^DVB(396.3,REQDA,5),U,1)'>0) DO
.K DTOUT,DUOUT,Y
.S DA=REQDA,DIE="^DVB(396.3,"
.S DR="45"
.D ^DIE
.S:$D(DTOUT) DVBADTOT=""
.I $D(DTOUT)!($D(Y)) S DVBAOUT=""
I '$D(^DVB(396.3,REQDA,5)) DO
.K DTOUT,DUOUT,Y
.S DA=REQDA,DIE="^DVB(396.3,"
.S DR="45"
.D ^DIE
.S:$D(DTOUT) DVBADTOT=""
.I $D(DTOUT)!($D(Y)) S DVBAOUT=""
K DIE,DR,DA
S DA=REQDA
;
;**If 2507 not linked and 2507 Processing Time not entered
I '$D(DVBADTOT) DO
.I $D(^DVB(396.3,REQDA,5)),((+$P(^DVB(396.3,REQDA,5),U,1)'>0)&($P(^DVB(396.3,REQDA,5),U,2)="")) D PASS1
.I '$D(^DVB(396.3,REQDA,5)) D PASS1
K DVBADTOT
Q
;
PASS1 ;** Insufficient 2507 selection error on edit of newly created 2507
S TVAR(1,0)="0,0,0,1,0^You must either select a request to link or enter the 2507 Processing Time."
S TVAR(2,0)="0,0,0,1,0^Enter 0 if you don't know the processing time of the original request."
D WR^DVBAUTL4("TVAR")
K TVAR
S DVBAOUT=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCLOG2 2007 printed Dec 13, 2024@01:44:44 Page 2
DVBCLOG2 ;ALB/GTS-LOG A 2507 REQUEST CONT; 11/17/94 1:30 PM
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
CLINSF ;** Reset 2507 when priority changed from Insufficient
+1 SET DA=REQDA
SET DIE="^DVB(396.3,"
SET DR="44///@;45///@"
+2 DO ^DIE
+3 KILL DA,DIE,DR,Y
+4 QUIT
+5 ;
INSUF ;** Enter Insuffient 2507 info
+1 WRITE @IOF
+2 SET DVBADFN=$PIECE(^DVB(396.3,REQDA,0),"^",1)
SET DVBADA=""
SET DVBASTAT="C"
+3 ;**Set up ^TMP of 2507's
DO REQARY^DVBCUTL5
+4 ;** Select 2507
IF $DATA(^TMP("DVBC",$JOB))
DO REQSEL^DVBCUTL5
SET DVBASEL=+Y
+5 IF '$DATA(^TMP("DVBC",$JOB))
SET DVBASEL=0
+6 ;** Update ORIGINAL 2507 REQUEST
IF +DVBASEL>0
Begin DoDot:1
+7 SET DVBAORD=""
+8 ;** Loop through ^TMP and get selected DA
DO FINDDA^DVBCUTL5
+9 KILL DA,DIE,DR,Y
+10 SET DA=REQDA
SET DIE="^DVB(396.3,"
SET DR="44////"_DVBADA
DO ^DIE
End DoDot:1
+11 KILL DA,DIE,DR,Y,DIR,X,^TMP("DVBC",$JOB),DVBAORD,DVBAMORE,DVBACNT,DVBALP
+12 KILL DVBAPNAM,DVBASEL,DVBAOUT,DVBADA,DVBADFN,DVBADT,DVBADTOT
+13 ;
+14 ;** If 2507 not linked to completed 2507 and not time or '^' out
+15 ;** when selecting 2507, enter 2507 PROCESSING TIME
+16 ;** NOTE: I '$D(DVBAOUT) removed 2/3/95 because killed above
+17 IF $DATA(^DVB(396.3,REQDA,5))
IF (+$PIECE(^DVB(396.3,REQDA,5),U,1)'>0)
Begin DoDot:1
+18 KILL DTOUT,DUOUT,Y
+19 SET DA=REQDA
SET DIE="^DVB(396.3,"
+20 SET DR="45"
+21 DO ^DIE
+22 if $DATA(DTOUT)
SET DVBADTOT=""
+23 IF $DATA(DTOUT)!($DATA(Y))
SET DVBAOUT=""
End DoDot:1
+24 IF '$DATA(^DVB(396.3,REQDA,5))
Begin DoDot:1
+25 KILL DTOUT,DUOUT,Y
+26 SET DA=REQDA
SET DIE="^DVB(396.3,"
+27 SET DR="45"
+28 DO ^DIE
+29 if $DATA(DTOUT)
SET DVBADTOT=""
+30 IF $DATA(DTOUT)!($DATA(Y))
SET DVBAOUT=""
End DoDot:1
+31 KILL DIE,DR,DA
+32 SET DA=REQDA
+33 ;
+34 ;**If 2507 not linked and 2507 Processing Time not entered
+35 IF '$DATA(DVBADTOT)
Begin DoDot:1
+36 IF $DATA(^DVB(396.3,REQDA,5))
IF ((+$PIECE(^DVB(396.3,REQDA,5),U,1)'>0)&($PIECE(^DVB(396.3,REQDA,5),U,2)=""))
DO PASS1
+37 IF '$DATA(^DVB(396.3,REQDA,5))
DO PASS1
End DoDot:1
+38 KILL DVBADTOT
+39 QUIT
+40 ;
PASS1 ;** Insufficient 2507 selection error on edit of newly created 2507
+1 SET TVAR(1,0)="0,0,0,1,0^You must either select a request to link or enter the 2507 Processing Time."
+2 SET TVAR(2,0)="0,0,0,1,0^Enter 0 if you don't know the processing time of the original request."
+3 DO WR^DVBAUTL4("TVAR")
+4 KILL TVAR
+5 SET DVBAOUT=""
+6 QUIT
