- 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 Feb 18, 2025@23:51:30 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