- 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 Jan 18, 2025@02:45:57 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