PSNVUID.m

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 ---PSNVUID   1899     printed  Apr 09, 2024@21:21:23                                                                                                                                                                                                     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