PSNVUID ;BHM/DB - Populate VUIDs at site; 07/14/05 8:31
;;4.0; NATIONAL DRUG FILE;**101**; 30 Oct 98
;Reference to SETSTAT^HDISVF01 supported by DBIA #4640
K ^XTMP($J)
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
G Q
;Move data from PSNFILE, 50.416, 50.605 & 50.6 to transport global
1 S PSN1=$O(@PSNRT@(PSNFILE,PSN1)) Q:PSN1'>0 S PSNSUB="PSN"_PSNFILE_"TRM"
S @XPDGREF@(PSNSUB,PSN1)=$G(@PSNRT@(PSNFILE,PSN1,"VUID")),PSN2=0
2 S PSN2=$O(@PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2)) G 1:PSN2'>0
S PSNDATA=$G(@PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2,0)) S @XPDGREF@(PSNSUB,PSN1,PSN2)=PSNDATA
G 2
Q K PSN1,PSN2,PSNSUB,PSNDATA,PSNFILE Q
PSNUNLD ;Unload transport global and set data
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
G Q
UN1 S PSN1=$O(@XPDGREF@(PSNSUB,PSN1)) G DONE:PSN1'>0 S PSN2=0
S PSNDATA=@XPDGREF@(PSNSUB,PSN1),@PSNRT@(PSNFILE,PSN1,"VUID")=PSNDATA
S @PSNRT@(PSNFILE,"AVUID",$P(PSNDATA,"^",1),PSN1)=""
S PSNVUID=PSNDATA
K @PSNRT@(PSNFILE,PSN1,"TERMSTATUS")
UN2 S PSN2=$O(@XPDGREF@(PSNSUB,PSN1,PSN2)) G UN1:PSN2'>0 S PSNDATA=$G(@XPDGREF@(PSNSUB,PSN1,PSN2))
S @PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2,0)=PSNDATA
S @PSNRT@(PSNFILE,"AMASTERVUID",$P(PSNVUID,"^",1),PSN2,PSN1)=""
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")
S @PSNRT@(PSNFILE,PSN1,"TERMSTATUS","B",$P(PSNDATA,"^",1),PSN2)=""
G UN2
DONE Q
SEED S X="HDISVF01" X ^%ZOSF("TEST") I D SEED1
Q
SEED1 D SETSTAT^HDISVF01(50.68,.01,6,DT)
D SETSTAT^HDISVF01(50.6,.01,6,DT)
D SETSTAT^HDISVF01(50.605,.01,6,DT)
D SETSTAT^HDISVF01(50.416,.01,6,DT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNVUID 1899 printed Dec 13, 2024@02:25:13 Page 2
PSNVUID ;BHM/DB - Populate VUIDs at site; 07/14/05 8:31
+1 ;;4.0; NATIONAL DRUG FILE;**101**; 30 Oct 98
+2 ;Reference to SETSTAT^HDISVF01 supported by DBIA #4640
+3 KILL ^XTMP($JOB)
+4 FOR PSNFILE=50.68,50.416,50.605,50.6
SET PSN1=0
SET PSNRT=$SELECT(PSNFILE=50.68:"^PSNDF",PSNFILE=50.6:"^PSNDF",1:"^PS")
DO 1
+5 GOTO Q
+6 ;Move data from PSNFILE, 50.416, 50.605 & 50.6 to transport global
1 SET PSN1=$ORDER(@PSNRT@(PSNFILE,PSN1))
if PSN1'>0
QUIT
SET PSNSUB="PSN"_PSNFILE_"TRM"
+1 SET @XPDGREF@(PSNSUB,PSN1)=$GET(@PSNRT@(PSNFILE,PSN1,"VUID"))
SET PSN2=0
2 SET PSN2=$ORDER(@PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2))
if PSN2'>0
GOTO 1
+1 SET PSNDATA=$GET(@PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2,0))
SET @XPDGREF@(PSNSUB,PSN1,PSN2)=PSNDATA
+2 GOTO 2
Q KILL PSN1,PSN2,PSNSUB,PSNDATA,PSNFILE
QUIT
PSNUNLD ;Unload transport global and set data
+1 DO SEED
FOR PSNFILE=50.68,50.416,50.605,50.6
SET PSN1=0
SET PSNSUB="PSN"_PSNFILE_"TRM"
SET PSNRT=$SELECT(PSNFILE=50.68:"^PSNDF",PSNFILE=50.6:"^PSNDF",1:"^PS")
KILL @PSNRT@(PSNFILE,"AMASTERVUID"),@PSNRT@(PSNFILE,"AVUID")
DO UN1
+2 GOTO Q
UN1 SET PSN1=$ORDER(@XPDGREF@(PSNSUB,PSN1))
if PSN1'>0
GOTO DONE
SET PSN2=0
+1 SET PSNDATA=@XPDGREF@(PSNSUB,PSN1)
SET @PSNRT@(PSNFILE,PSN1,"VUID")=PSNDATA
+2 SET @PSNRT@(PSNFILE,"AVUID",$PIECE(PSNDATA,"^",1),PSN1)=""
+3 SET PSNVUID=PSNDATA
+4 KILL @PSNRT@(PSNFILE,PSN1,"TERMSTATUS")
UN2 SET PSN2=$ORDER(@XPDGREF@(PSNSUB,PSN1,PSN2))
if PSN2'>0
GOTO UN1
SET PSNDATA=$GET(@XPDGREF@(PSNSUB,PSN1,PSN2))
+1 SET @PSNRT@(PSNFILE,PSN1,"TERMSTATUS",PSN2,0)=PSNDATA
+2 SET @PSNRT@(PSNFILE,"AMASTERVUID",$PIECE(PSNVUID,"^",1),PSN2,PSN1)=""
+3 SET @PSNRT@(PSNFILE,PSN1,"TERMSTATUS",0)=$SELECT(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")
+4 SET @PSNRT@(PSNFILE,PSN1,"TERMSTATUS","B",$PIECE(PSNDATA,"^",1),PSN2)=""
+5 GOTO UN2
DONE QUIT
SEED SET X="HDISVF01"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO SEED1
+1 QUIT
SEED1 DO SETSTAT^HDISVF01(50.68,.01,6,DT)
+1 DO SETSTAT^HDISVF01(50.6,.01,6,DT)
+2 DO SETSTAT^HDISVF01(50.605,.01,6,DT)
+3 DO SETSTAT^HDISVF01(50.416,.01,6,DT)
+4 QUIT
