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

PSNVUID.m

Go to the documentation of this file.
  1. PSNVUID ;BHM/DB - Populate VUIDs at site; 07/14/05 8:31
  1. ;;4.0; NATIONAL DRUG FILE;**101**; 30 Oct 98
  1. ;Reference to SETSTAT^HDISVF01 supported by DBIA #4640
  1. K ^XTMP($J)
  1. F PSNFILE=50.68,50.416,50.605,50.6 S PSN1=0 S PSNRT=$S(PSNFILE=50.68:"^PSNDF",PSNFILE=50.6:"^PSNDF",1:"^PS") D 1
  1. G Q
  1. ;Move data from PSNFILE, 50.416, 50.605 & 50.6 to transport global
  1. 1 S PSN1=$O(@PSNRT@(PSNFILE,PSN1)) Q:PSN1'>0 S PSNSUB="PSN"_PSNFILE_"TRM"
  1. S @XPDGREF@(PSNSUB,PSN1)=$G(@PSNRT@(PSNFILE,PSN1,"VUID")),PSN2=0
  1. 2 S PSN2=$O(@PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2)) G 1:PSN2'>0
  1. S PSNDATA=$G(@PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2,0)) S @XPDGREF@(PSNSUB,PSN1,PSN2)=PSNDATA
  1. G 2
  1. Q K PSN1,PSN2,PSNSUB,PSNDATA,PSNFILE Q
  1. PSNUNLD ;Unload transport global and set data
  1. D SEED F PSNFILE=50.68,50.416,50.605,50.6 S PSN1=0,PSNSUB="PSN"_PSNFILE_"TRM",PSNRT=$S(PSNFILE=50.68:"^PSNDF",PSNFILE=50.6:"^PSNDF",1:"^PS") K @PSNRT@(PSNFILE,"AMASTERVUID"),@PSNRT@(PSNFILE,"AVUID") D UN1
  1. G Q
  1. UN1 S PSN1=$O(@XPDGREF@(PSNSUB,PSN1)) G DONE:PSN1'>0 S PSN2=0
  1. S PSNDATA=@XPDGREF@(PSNSUB,PSN1),@PSNRT@(PSNFILE,PSN1,"VUID")=PSNDATA
  1. S @PSNRT@(PSNFILE,"AVUID",$P(PSNDATA,"^",1),PSN1)=""
  1. S PSNVUID=PSNDATA
  1. K @PSNRT@(PSNFILE,PSN1,"TERMSTATUS")
  1. UN2 S PSN2=$O(@XPDGREF@(PSNSUB,PSN1,PSN2)) G UN1:PSN2'>0 S PSNDATA=$G(@XPDGREF@(PSNSUB,PSN1,PSN2))
  1. S @PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2,0)=PSNDATA
  1. S @PSNRT@(PSNFILE,"AMASTERVUID",$P(PSNVUID,"^",1),PSN2,PSN1)=""
  1. S @PSNRT@(PSNFILE,PSN1,"TERMSTATUS",0)=$S(PSNFILE=50.68:"^50.6899DA^1^1",PSNFILE=50.416:"^50.4169DA^1^1",PSNFILE=50.605:"^50.60509DA^1^1",1:"^50.6009^1^1")
  1. S @PSNRT@(PSNFILE,PSN1,"TERMSTATUS","B",$P(PSNDATA,"^",1),PSN2)=""
  1. G UN2
  1. DONE Q
  1. SEED S X="HDISVF01" X ^%ZOSF("TEST") I D SEED1
  1. Q
  1. SEED1 D SETSTAT^HDISVF01(50.68,.01,6,DT)
  1. D SETSTAT^HDISVF01(50.6,.01,6,DT)
  1. D SETSTAT^HDISVF01(50.605,.01,6,DT)
  1. D SETSTAT^HDISVF01(50.416,.01,6,DT)
  1. Q