Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBCLOG2

DVBCLOG2.m

Go to the documentation of this file.
  1. DVBCLOG2 ;ALB/GTS-LOG A 2507 REQUEST CONT; 11/17/94 1:30 PM
  1. ;;2.7;AMIE;;Apr 10, 1995
  1. ;
  1. CLINSF ;** Reset 2507 when priority changed from Insufficient
  1. S DA=REQDA,DIE="^DVB(396.3,",DR="44///@;45///@"
  1. D ^DIE
  1. K DA,DIE,DR,Y
  1. Q
  1. ;
  1. INSUF ;** Enter Insuffient 2507 info
  1. W @IOF
  1. S DVBADFN=$P(^DVB(396.3,REQDA,0),"^",1),DVBADA="",DVBASTAT="C"
  1. D REQARY^DVBCUTL5 ;**Set up ^TMP of 2507's
  1. I $D(^TMP("DVBC",$J)) DO REQSEL^DVBCUTL5 S DVBASEL=+Y ;** Select 2507
  1. I '$D(^TMP("DVBC",$J)) S DVBASEL=0
  1. I +DVBASEL>0 DO ;** Update ORIGINAL 2507 REQUEST
  1. .S DVBAORD=""
  1. .D FINDDA^DVBCUTL5 ;** Loop through ^TMP and get selected DA
  1. .K DA,DIE,DR,Y
  1. .S DA=REQDA,DIE="^DVB(396.3,",DR="44////"_DVBADA D ^DIE
  1. K DA,DIE,DR,Y,DIR,X,^TMP("DVBC",$J),DVBAORD,DVBAMORE,DVBACNT,DVBALP
  1. K DVBAPNAM,DVBASEL,DVBAOUT,DVBADA,DVBADFN,DVBADT,DVBADTOT
  1. ;
  1. ;** If 2507 not linked to completed 2507 and not time or '^' out
  1. ;** when selecting 2507, enter 2507 PROCESSING TIME
  1. ;** NOTE: I '$D(DVBAOUT) removed 2/3/95 because killed above
  1. I $D(^DVB(396.3,REQDA,5)),(+$P(^DVB(396.3,REQDA,5),U,1)'>0) DO
  1. .K DTOUT,DUOUT,Y
  1. .S DA=REQDA,DIE="^DVB(396.3,"
  1. .S DR="45"
  1. .D ^DIE
  1. .S:$D(DTOUT) DVBADTOT=""
  1. .I $D(DTOUT)!($D(Y)) S DVBAOUT=""
  1. I '$D(^DVB(396.3,REQDA,5)) DO
  1. .K DTOUT,DUOUT,Y
  1. .S DA=REQDA,DIE="^DVB(396.3,"
  1. .S DR="45"
  1. .D ^DIE
  1. .S:$D(DTOUT) DVBADTOT=""
  1. .I $D(DTOUT)!($D(Y)) S DVBAOUT=""
  1. K DIE,DR,DA
  1. S DA=REQDA
  1. ;
  1. ;**If 2507 not linked and 2507 Processing Time not entered
  1. I '$D(DVBADTOT) DO
  1. .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
  1. .I '$D(^DVB(396.3,REQDA,5)) D PASS1
  1. K DVBADTOT
  1. Q
  1. ;
  1. PASS1 ;** Insufficient 2507 selection error on edit of newly created 2507
  1. S TVAR(1,0)="0,0,0,1,0^You must either select a request to link or enter the 2507 Processing Time."
  1. S TVAR(2,0)="0,0,0,1,0^Enter 0 if you don't know the processing time of the original request."
  1. D WR^DVBAUTL4("TVAR")
  1. K TVAR
  1. S DVBAOUT=""
  1. Q