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

DVBAB89.m

Go to the documentation of this file.
  1. DVBAB89 ;GT-CAPRI FULL ;05/10/02
  1. ;;2.7;AMIE;**42**;Apr 10, 1995
  1. ;
  1. ;
  1. START(MSG,DFN) ;CALLED BY REMOTE PROCEDURE DVBAB SURGERY CASE
  1. ;Parameters
  1. ;=============
  1. ; MSG : Output - data global ^TMP("SURGERY")
  1. ; DFN : Patient Identification Number
  1. ;
  1. K ^TMP("DVBSURGERY",$J)
  1. N COUNT,VAR S VAR="",COUNT=0
  1. I '$D(^DPT(DFN,0)) S ^TMP("DVBSURGERY",$J,COUNT)="Not a valid patient" Q
  1. I $D(^SRF("B",DFN)) D
  1. . F S VAR=$O(^SRF("B",DFN,VAR)) Q:VAR="" D
  1. . . S DVBSROP=$P(^SRF(VAR,"OP"),"^",1)
  1. . . D ^DVBASRP1
  1. . . S ^TMP("DVBSURGERY",$J,COUNT)=VAR_"^"_$P(^SRF(VAR,0),"^",9)_"^"_DVBSROP_$C(13)
  1. . . S COUNT=COUNT+1
  1. S MSG=$NA(^TMP("DVBSURGERY",$J))
  1. Q
  1. ;
  1. XDA(MSG,DFN) ;CALLED BY REMOTE PROCEDURE DVBAB ORIGINAL PROCESSING DATE
  1. K ^TMP("REPRINT",$J)
  1. N VAR,COUNT
  1. I '$D(DFN) S ^TMP("REPRINT",$J,COUNT)="0^Undefined Patient IEN" Q
  1. S DIC=2,DIC(0)="NZX",X=DFN D ^DIC I Y<0 D
  1. . S ^TMP("REPRINT",$J,COUNT)="0^Invalid Patient Name." Q
  1. S VAR="",COUNT=0
  1. I $D(^DVB(396,"B",DFN)) D
  1. . F S VAR=$O(^DVB(396,"B",DFN,VAR)) Q:VAR="" D
  1. . . I $D(^DVB(396,VAR,4)),$P(^DVB(396,VAR,4),U,4)]"",$D(^DVB(396,VAR,2)),$P(^DVB(396,VAR,2),U,10)'="L",$D(^DPT($P(^DVB(396,VAR,0),U,1),0)) D
  1. . . . S ^TMP("REPRINT",$J,COUNT)=VAR_"^"_$P(^DVB(396,VAR,4),"^",2)_$C(13)
  1. . . . S COUNT=COUNT+1
  1. S MSG=$NA(^TMP("REPRINT",$J))
  1. Q