PSNVCR.m

PSNVCR ;BIR/RTR-VISTA COMPARISON REPORT ; 11 December 2016

 ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53

 ;

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK

 N PSNVRANS,PSNVRAR,PSNVRBEG,PSNVREND,PSNVRFIL,PSNVROUT,PSNVRPMI,PSNVRSEE,PSNVRSUM,PSNVRTYP

 S (PSNVROUT,PSNVRPMI)=0

 ;

 ;

 W !!,?5,"Update File Change Report",!

 ;

 ;

 D FILE^PSNVCR1 I PSNVROUT D END Q

 D FIELD I PSNVROUT D END Q

 I '$D(PSNVRAR) W !!?5,"No fields selected to print.",! D END Q

 D DATE^PSNVCR1 I PSNVROUT D END Q

 D SUMM^PSNVCR1 I PSNVROUT D END Q

 I PSNVRSUM="S" D PMI^PSNVCR1 I PSNVROUT D END Q

 D TYPE^PSNVCR1 I PSNVROUT D END Q

 I PSNVRTYP="D" D DL^PSNVCR1 I PSNVROUT D END Q

 I PSNVRTYP="D" D START1^PSNVCR2 Q

 ;

 K IOP,%ZIS,POP W ! S %ZIS="QM" D ^%ZIS I $G(POP)>0 D END Q

 I $D(IO("Q")) S ZTRTN="START^PSNVCR2",ZTDESC="Update File Change Report" D  Q

 .S ZTSAVE("PSNVRAR(")="",ZTSAVE("PSNVRBEG")="",ZTSAVE("PSNVREND")="",ZTSAVE("PSNVRSUM")="",ZTSAVE("PSNVRPMI")="",ZTSAVE("PSNVRTYP")="",ZTSAVE("PSNVRFIL(")=""

 .D ^%ZTLOAD K %ZIS W !!,"Report queued to print.",!

 .K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR

 U IO D START1^PSNVCR2

 Q

 ;

 ;

FIELD ;Field selection

 ;Sets fields in PSNVRAR(#,#)

 I $G(PSNVRSEE)="A" G SFLD

 W ! K DIR,Y S DIR(0)="SA^A:ALL;S:SPECIFIC"

 S DIR("?",1)="Enter 'A' to see changes made to all of the audited fields,"

 S DIR("?")="enter 'S' to select specific fields to see changes."

 S DIR("A")="Select (A)ll Audited or (S)pecific Fields: "

 D ^DIR I $D(DIRUT) S PSNVROUT=1 Q

 S PSNVRSEE=Y

SFLD ;

 D SELFIELD(PSNVRSEE)

 Q

 ;

 ;

END ;

 K DIR w !!,"No report to print.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR W !

 Q

 ;

 ;

SELFIELD(PSNVRSL) ; Set Field array as PSNVRAR(#,#)=""

 ;Where first subscript is File number, and remaining subscripts are field numbers

 N PSNVRSL1,PSNVRSL2,PSNVRSL3,PSNVL,PSNVRAGN,PSNVRDAT,PSNVRCN,PSNVRFL,PSNVRSUB,PSNVRSTR,PSNVRSQ1,PSNVRSQ2

 F PSNVL=0:0 S PSNVL=$O(PSNVRFIL(PSNVL)) Q:'PSNVL!(PSNVROUT)  D

 .I PSNVL=50.416 D DIN Q

 .D @$S(PSNVL=50.6:"VAG",PSNVL=50.605:"VDC",PSNVL=50.606:"DFO",PSNVL=50.607:"DRU",PSNVL=50.608:"PAT",PSNVL=50.609:"PAS",PSNVL=50.64:"VAD",PSNVL=50.67:"NDC",PSNVL=50.68:"VAP",PSNVL=55.95:"DRM^PSNVCR1",1:"DRI^PSNVCR1")

 Q

 ;

 ;

DIN ;Set Fields for Drug Ingredients (#50.416) File

 I PSNVRSL="A" D  Q

 .F PSNVRSL1=50.416,50.4161,50.4169 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRSQ2=0 S PSNVRSTR=50.416 S PSNVRSQ1=$S(PSNVRSL1=50.4161:1,PSNVRSL1=50.4169:99.991,1:PSNVRSL2) S:PSNVRSL1'=50.416 PSNVRSQ2=PSNVRSL2

 ...I 'PSNVRSQ2 S PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1 Q

 ...S PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0  F PSNVRSL1=50.416,50.4161,50.4169 D

 .F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ..S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 ..S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")_$$DINNM

 ..S PSNVRSQ2="" S PSNVRSTR=50.416 S PSNVRSQ1=$S(PSNVRSL1=50.4161:1,PSNVRSL1=50.4169:99.9991,1:PSNVRSL2) S:PSNVRSL1'=50.416 PSNVRSQ2=PSNVRSL2

 ..S $P(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

DINN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the Drug Ingredients (#50.416) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G DINN

 Q

DINNM() ;

 Q $S(+PSNVRSUB=50.4161:"  (DRUG IDENTIFIER SubFile)",+PSNVRSUB=50.4169:"   (EFFECTIVE DATE/TIME Subfile)",1:"")

 ;

 ;

VAG ;Set Fields for VA Generic (#50.6) File

 I PSNVRSL="A" D  Q

 .F PSNVRSL1=50.6,50.6009 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRSQ2=0 S PSNVRSTR=50.6 S PSNVRSQ1=$S(PSNVRSL1=50.6009:99.991,1:PSNVRSL2) S:PSNVRSL1'=50.6 PSNVRSQ2=PSNVRSL2

 ...I 'PSNVRSQ2 S PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1 Q

 ...S PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

  K PSNVRDAT S PSNVRCN=0  F PSNVRSL1=50.6,50.6009 D

 .F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ..S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 ..S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")_$$VAGNM

 ..S PSNVRSQ2="" S PSNVRSTR=50.6 S PSNVRSQ1=$S(PSNVRSL1=50.6009:99.991,1:PSNVRSL2) S:PSNVRSL1'=50.6 PSNVRSQ2=PSNVRSL2

 ..S $P(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

VAGN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the VA Generic (#50.6) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G VAGN

 Q

VAGNM() ;

 Q $S(+PSNVRSUB=50.6009:"  (EFFECTIVE DATE TIME SubFile)",1:"")

 ;

 ;

VDC ;Set Fields for VA Drug Class (#50.605) File

 I PSNVRSL="A" D  Q

 .F PSNVRSL1=50.605,50.615,50.60509 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRSQ2=0 S PSNVRSTR=50.605 S PSNVRSQ1=$S(PSNVRSL1=50.60509:99.991,PSNVRSL1=50.615:4,1:PSNVRSL2) S:PSNVRSL1'=50.605 PSNVRSQ2=PSNVRSL2

 ...I 'PSNVRSQ2 S PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1 Q

 ...S PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0  F PSNVRSL1=50.605,50.615,50.60509 D

 .F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ..S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 ..S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")_$$VDCNM

 ..S PSNVRSQ2="" S PSNVRSTR=50.605 S PSNVRSQ1=$S(PSNVRSL1=50.60509:99.991,PSNVRSL1=50.615:4,1:PSNVRSL2) S:PSNVRSL1'=50.605 PSNVRSQ2=PSNVRSL2

 ..S $P(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

VDCN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the VA Drug Class (#50.605) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G VDCN

 Q

VDCNM() ;

 Q $S(+PSNVRSUB=50.615:"  (DESCRIPTION SubFile)",+PSNVRSUB=50.60509:"  (EFFECTIVE DATE/TIME SubFile)",1:"")

 ;

 ;

DFO ;Set Fields for Dosage Form (#50.606) File

 I PSNVRSL="A" D  Q

 .F PSNVRSL1=50.606,50.6069,50.6061,50.6066,50.6068 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRSQ2=0 S PSNVRSTR=50.606 S PSNVRSQ1=$S(PSNVRSL1=50.6069:9,PSNVRSL1=50.6061:1,PSNVRSL1=50.6066:6,PSNVRSL1=50.6068:8,1:PSNVRSL2) S:PSNVRSL1'=50.606 PSNVRSQ2=PSNVRSL2

 ...I 'PSNVRSQ2 S PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1 Q

 ...S PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0  F PSNVRSL1=50.606,50.6069,50.6061,50.6066,50.6068 D

 .F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ..S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 ..S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")_$$DFONM

 ..S PSNVRSQ2="" S PSNVRSTR=50.606 S PSNVRSQ1=$S(PSNVRSL1=50.6069:9,PSNVRSL1=50.6061:1,PSNVRSL1=50.6066:6,PSNVRSL1=50.6068:8,1:PSNVRSL2) S:PSNVRSL1'=50.606 PSNVRSQ2=PSNVRSL2

 ..S $P(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

DFON ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the Dosage Form (#50.606) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G DFON

 Q

DFONM() ;

 Q $S(+PSNVRSUB=50.6069:"  (DISPENSE UNITS PER DOSE SubFile)",+PSNVRSUB=50.6061:"  (MED ROUTE FOR DOSAGE FORM SubFile)",+PSNVRSUB=50.6066:"  (NOUN SubFile)",+PSNVRSUB=50.6068:"  (UNITS SubFile)",1:"")

 ;

 ;

DRU ;Set Fields for Drug Units (#50.607) File

 I PSNVRSL="A" D  Q

 .S PSNVRSL1=50.607 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRAR(50.607,PSNVRSL2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0,PSNVRSL1=50.607

 F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 .S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 .S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")

 .S $P(PSNVRDAT(PSNVRCN),"^",4)=50.607_";;"_PSNVRSL2

DRUN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the Drug Units (#50.607) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G DRUN

 Q

 ;

 ;

PAT ;Set Fields for Package Type (#50.608) File

 I PSNVRSL="A" D  Q

 .S PSNVRSL1=50.608 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRAR(50.608,PSNVRSL2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0,PSNVRSL1=50.608

 F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 .S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 .S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")

 .S $P(PSNVRDAT(PSNVRCN),"^",4)=50.608_";;"_PSNVRSL2

PATN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the Package Type (#50.608) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G PATN

 Q

 ;

 ;

PAS ;Set Fields for Package Size (#50.609) File

 I PSNVRSL="A" D  Q

 .S PSNVRSL1=50.609 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRAR(50.609,PSNVRSL2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0,PSNVRSL1=50.609

 F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 .S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 .S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")

 .S $P(PSNVRDAT(PSNVRCN),"^",4)=50.609_";;"_PSNVRSL2

PASN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the Package Size (#50.609) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G PASN

 Q

 ;

 ;

VAD ;Set Fields for VA Dispense Unit (#50.64) File

 I PSNVRSL="A" D  Q

 .S PSNVRSL1=50.64 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRAR(50.64,PSNVRSL2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0,PSNVRSL1=50.64

 F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 .S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 .S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")

 .S $P(PSNVRDAT(PSNVRCN),"^",4)=50.64_";;"_PSNVRSL2

VADN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the VA Dispense Unit (#50.64) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G VADN

 Q

 ;

 ;

NDC ;Set Fields for NDC/UPN (#50.67) File

 I PSNVRSL="A" D  Q

 .F PSNVRSL1=50.67,50.676,50.6711,50.6712 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRSQ2=0 S PSNVRSTR=50.67 S PSNVRSQ1=$S(PSNVRSL1=50.676:6,PSNVRSL1=50.6711:11,PSNVRSL1=50.6712:12,1:PSNVRSL2) S:PSNVRSL1'=50.67 PSNVRSQ2=PSNVRSL2

 ...I 'PSNVRSQ2 S PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1 Q

 ...S PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0  F PSNVRSL1=50.67,50.676,50.6711,50.6712 D

 .F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ..S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 ..S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")_$$NDCNM

 ..S PSNVRSQ2="" S PSNVRSTR=50.67 S PSNVRSQ1=$S(PSNVRSL1=50.676:6,PSNVRSL1=50.6711:11,PSNVRSL1=50.6712:12,1:PSNVRSL2) S:PSNVRSL1'=50.67 PSNVRSQ2=PSNVRSL2

 ..S $P(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

NDCN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the NDC/UPN (#50.67) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G NDCN

 Q

NDCNM() ;

 Q $S(+PSNVRSUB=50.676:"  (ROUTE OF ADMINISTRATION SubFile)",+PSNVRSUB=50.6711:"   (PREVIOUS NDC Subfile)",+PSNVRSUB=50.6712:"   (PREVIOUS UPN Subfile)",1:"")

 ;

 ;

VAP ;Set Fields for VA Product (#50.68) File

 I PSNVRSL="A" D  Q

 .F PSNVRSL1=50.68,50.6814,50.6816,50.6818,50.6845,50.6899 D

 ..F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ...S PSNVRSQ2=0 S PSNVRSTR=50.68 S PSNVRSQ1=$S(PSNVRSL1=50.6814:14,PSNVRSL1=50.6816:16,PSNVRSL1=50.6818:18,PSNVRSL1=50.6845:45,PSNVRSL1=50.6899:99.991,1:PSNVRSL2) S:PSNVRSL1'=50.68 PSNVRSQ2=PSNVRSL2

 ...I 'PSNVRSQ2 S PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1 Q

 ...S PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

 K PSNVRDAT S PSNVRCN=0  F PSNVRSL1=50.68,50.6814,50.6816,50.6818,50.6845,50.6899 D

 .F PSNVRSL2=0:0 S PSNVRSL2=$O(^DD(PSNVRSL1,"AUDIT",PSNVRSL2)) Q:'PSNVRSL2  D

 ..S PSNVRCN=PSNVRCN+1,PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 ..S PSNVRSUB=PSNVRDAT(PSNVRCN),$P(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($P(PSNVRSUB,"^"),$P(PSNVRSUB,"^",2),,"LABEL")_$$VAPNM

 ..S PSNVRSQ2="" S PSNVRSTR=50.68 S PSNVRSQ1=$S(PSNVRSL1=50.6814:14,PSNVRSL1=50.6816:16,PSNVRSL1=50.6818:18,PSNVRSL1=50.6845:45,PSNVRSL1=50.6899:99.991,1:PSNVRSL2) S:PSNVRSL1'=50.68 PSNVRSQ2=PSNVRSL2

 ..S $P(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

VAPN ;Redisplay for selection

 W @IOF

 W !?5,"Audited fields from the VA PRODUCT (#50.68) File:",! S PSNVRFL=0

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT^PSNVCR1(PSNVRCN) I PSNVRAGN G VAPN

 Q

VAPNM() ;

 I +PSNVRSUB=50.6814 Q "  (ACTIVE INGREDIENTS SubFile)"

 Q $S(+PSNVRSUB=50.6816:"   (SECONDARY VA DRUG CLASS Subfile)",+PSNVRSUB=50.6818:"   (NATIONAL FORMULARY RESTRICTION Subfile)",+PSNVRSUB=50.6845:"   (COPAY TIER Subfile)",+PSNVRSUB=50.6899:"   (EFFECTIVE DATE/TIME Subfile)",1:"")

 ;

 ;

AUDF ;Show audited fields

 F PSNVRSL1=1:1 Q:'$D(PSNVRDAT(PSNVRSL1))!(PSNVROUT)  D

 .I ($Y+5)>IOSL D YN Q:PSNVROUT  W @IOF

 .S PSNVRSUB=PSNVRDAT(PSNVRSL1)

 .W !?2,PSNVRSL1_")  "_$P(PSNVRDAT(PSNVRSL1),"^",3) S PSNVRFL=1

 Q

 ;

 ;

MESS ;Write Message

 W !,"***No Audited fields for this file.***"

 Q

 ;

 ;

YN ;yes or no prompt if no audited fields found for a file

 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR

 I $D(DTOUT)!($D(DUOUT))!('Y) S PSNVROUT=1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSNVCR   14430     printed  Mar 13, 2025@21:29:51                                                                                                                                                                                                     Page 2

PSNVCR    ;BIR/RTR-VISTA COMPARISON REPORT ; 11 December 2016

 +1       ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53

 +2       ;

 +3        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK

 +4        NEW PSNVRANS,PSNVRAR,PSNVRBEG,PSNVREND,PSNVRFIL,PSNVROUT,PSNVRPMI,PSNVRSEE,PSNVRSUM,PSNVRTYP

 +5        SET (PSNVROUT,PSNVRPMI)=0

 +6       ;

 +7       ;

 +8        WRITE !!,?5,"Update File Change Report",!

 +9       ;

 +10      ;

 +11       DO FILE^PSNVCR1

           IF PSNVROUT

               DO END

               QUIT 

 +12       DO FIELD

           IF PSNVROUT

               DO END

               QUIT 

 +13       IF '$DATA(PSNVRAR)

               WRITE !!?5,"No fields selected to print.",!

               DO END

               QUIT 

 +14       DO DATE^PSNVCR1

           IF PSNVROUT

               DO END

               QUIT 

 +15       DO SUMM^PSNVCR1

           IF PSNVROUT

               DO END

               QUIT 

 +16       IF PSNVRSUM="S"

               DO PMI^PSNVCR1

               IF PSNVROUT

                   DO END

                   QUIT 

 +17       DO TYPE^PSNVCR1

           IF PSNVROUT

               DO END

               QUIT 

 +18       IF PSNVRTYP="D"

               DO DL^PSNVCR1

               IF PSNVROUT

                   DO END

                   QUIT 

 +19       IF PSNVRTYP="D"

               DO START1^PSNVCR2

               QUIT 

 +20      ;

 +21       KILL IOP,%ZIS,POP

           WRITE !

           SET %ZIS="QM"

           DO ^%ZIS

           IF $GET(POP)>0

               DO END

               QUIT 

 +22       IF $DATA(IO("Q"))

               SET ZTRTN="START^PSNVCR2"

               SET ZTDESC="Update File Change Report"

               Begin DoDot:1

 +23               SET ZTSAVE("PSNVRAR(")=""

                   SET ZTSAVE("PSNVRBEG")=""

                   SET ZTSAVE("PSNVREND")=""

                   SET ZTSAVE("PSNVRSUM")=""

                   SET ZTSAVE("PSNVRPMI")=""

                   SET ZTSAVE("PSNVRTYP")=""

                   SET ZTSAVE("PSNVRFIL(")=""

 +24               DO ^%ZTLOAD

                   KILL %ZIS

                   WRITE !!,"Report queued to print.",!

 +25               KILL DIR,Y

                   SET DIR(0)="E"

                   SET DIR("A")="Press Return to continue"

                   DO ^DIR

                   KILL DIR

               End DoDot:1

               QUIT 

 +26       USE IO

           DO START1^PSNVCR2

 +27       QUIT 

 +28      ;

 +29      ;

FIELD     ;Field selection

 +1       ;Sets fields in PSNVRAR(#,#)

 +2        IF $GET(PSNVRSEE)="A"

               GOTO SFLD

 +3        WRITE !

           KILL DIR,Y

           SET DIR(0)="SA^A:ALL;S:SPECIFIC"

 +4        SET DIR("?",1)="Enter 'A' to see changes made to all of the audited fields,"

 +5        SET DIR("?")="enter 'S' to select specific fields to see changes."

 +6        SET DIR("A")="Select (A)ll Audited or (S)pecific Fields: "

 +7        DO ^DIR

           IF $DATA(DIRUT)

               SET PSNVROUT=1

               QUIT 

 +8        SET PSNVRSEE=Y

SFLD      ;

 +1        DO SELFIELD(PSNVRSEE)

 +2        QUIT 

 +3       ;

 +4       ;

END       ;

 +1        KILL DIR

           WRITE !!,"No report to print.",!

           KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press Return to continue"

           DO ^DIR

           WRITE !

 +2        QUIT 

 +3       ;

 +4       ;

SELFIELD(PSNVRSL) ; Set Field array as PSNVRAR(#,#)=""

 +1       ;Where first subscript is File number, and remaining subscripts are field numbers

 +2        NEW PSNVRSL1,PSNVRSL2,PSNVRSL3,PSNVL,PSNVRAGN,PSNVRDAT,PSNVRCN,PSNVRFL,PSNVRSUB,PSNVRSTR,PSNVRSQ1,PSNVRSQ2

 +3        FOR PSNVL=0:0

               SET PSNVL=$ORDER(PSNVRFIL(PSNVL))

               if 'PSNVL!(PSNVROUT)

                   QUIT 

               Begin DoDot:1

 +4                IF PSNVL=50.416

                       DO DIN

                       QUIT 

 +5                DO @$SELECT(PSNVL=50.6:"VAG",PSNVL=50.605:"VDC",PSNVL=50.606:"DFO",PSNVL=50.607:"DRU",PSNVL=50.608:"PAT",PSNVL=50.609:"PAS",PSNVL=50.64:"VAD",PSNVL=50.67:"NDC",PSNVL=50.68:"VAP",PSNVL=55.95:"DRM^PSNVCR1",1:"DRI^PSNVCR1")

               End DoDot:1

 +6        QUIT 

 +7       ;

 +8       ;

DIN       ;Set Fields for Drug Ingredients (#50.416) File

 +1        IF PSNVRSL="A"

               Begin DoDot:1

 +2                FOR PSNVRSL1=50.416,50.4161,50.4169

                       Begin DoDot:2

 +3                        FOR PSNVRSL2=0:0

                               SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))

                               if 'PSNVRSL2

                                   QUIT 

                               Begin DoDot:3

 +4                                SET PSNVRSQ2=0

                                   SET PSNVRSTR=50.416

                                   SET PSNVRSQ1=$SELECT(PSNVRSL1=50.4161:1,PSNVRSL1=50.4169:99.991,1:PSNVRSL2)

                                   if PSNVRSL1'=50.416

                                       SET PSNVRSQ2=PSNVRSL2

 +5                                IF 'PSNVRSQ2

                                       SET PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1

                                       QUIT 

 +6                                SET PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

               QUIT 

 +7        KILL PSNVRDAT

           SET PSNVRCN=0

           FOR PSNVRSL1=50.416,50.4161,50.4169

               Begin DoDot:1

 +8                FOR PSNVRSL2=0:0

                       SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))

                       if 'PSNVRSL2

                           QUIT 

                       Begin DoDot:2

 +9                        SET PSNVRCN=PSNVRCN+1

                           SET PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 +10                       SET PSNVRSUB=PSNVRDAT(PSNVRCN)

                           SET $PIECE(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($PIECE(PSNVRSUB,"^"),$PIECE(PSNVRSUB,"^",2),,"LABEL")_$$DINNM

 +11                       SET PSNVRSQ2=""

                           SET PSNVRSTR=50.416

                           SET PSNVRSQ1=$SELECT(PSNVRSL1=50.4161:1,PSNVRSL1=50.4169:99.9991,1:PSNVRSL2)

                           if PSNVRSL1'=50.416

                               SET PSNVRSQ2=PSNVRSL2

 +12                       SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

                       End DoDot:2

               End DoDot:1

DINN      ;Redisplay for selection

 +1        WRITE @IOF

 +2        WRITE !?5,"Audited fields from the Drug Ingredients (#50.416) File:",!

           SET PSNVRFL=0

 +3        DO AUDF

 +4        if PSNVROUT

               QUIT 

 +5        IF 'PSNVRFL

               DO MESS

               DO YN

               QUIT 

 +6        DO SELECT^PSNVCR1(PSNVRCN)

           IF PSNVRAGN

               GOTO DINN

 +7        QUIT 

DINNM()   ;

 +1        QUIT $SELECT(+PSNVRSUB=50.4161:"  (DRUG IDENTIFIER SubFile)",+PSNVRSUB=50.4169:"   (EFFECTIVE DATE/TIME Subfile)",1:"")

 +2       ;

 +3       ;

VAG       ;Set Fields for VA Generic (#50.6) File

 +1        IF PSNVRSL="A"

               Begin DoDot:1

 +2                FOR PSNVRSL1=50.6,50.6009

                       Begin DoDot:2

 +3                        FOR PSNVRSL2=0:0

                               SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))

                               if 'PSNVRSL2

                                   QUIT 

                               Begin DoDot:3

 +4                                SET PSNVRSQ2=0

                                   SET PSNVRSTR=50.6

                                   SET PSNVRSQ1=$SELECT(PSNVRSL1=50.6009:99.991,1:PSNVRSL2)

                                   if PSNVRSL1'=50.6

                                       SET PSNVRSQ2=PSNVRSL2

 +5                                IF 'PSNVRSQ2

                                       SET PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1

                                       QUIT 

 +6                                SET PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

               QUIT 

 +7        KILL PSNVRDAT

           SET PSNVRCN=0

           FOR PSNVRSL1=50.6,50.6009

               Begin DoDot:1

 +8                FOR PSNVRSL2=0:0

                       SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))

                       if 'PSNVRSL2

                           QUIT 

                       Begin DoDot:2

 +9                        SET PSNVRCN=PSNVRCN+1

                           SET PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 +10                       SET PSNVRSUB=PSNVRDAT(PSNVRCN)

                           SET $PIECE(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($PIECE(PSNVRSUB,"^"),$PIECE(PSNVRSUB,"^",2),,"LABEL")_$$VAGNM

 +11                       SET PSNVRSQ2=""

                           SET PSNVRSTR=50.6

                           SET PSNVRSQ1=$SELECT(PSNVRSL1=50.6009:99.991,1:PSNVRSL2)

                           if PSNVRSL1'=50.6

                               SET PSNVRSQ2=PSNVRSL2

 +12                       SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

                       End DoDot:2

               End DoDot:1

VAGN      ;Redisplay for selection

 +1        WRITE @IOF

 +2        WRITE !?5,"Audited fields from the VA Generic (#50.6) File:",!

           SET PSNVRFL=0

 +3        DO AUDF

 +4        if PSNVROUT

               QUIT 

 +5        IF 'PSNVRFL

               DO MESS

               DO YN

               QUIT 

 +6        DO SELECT^PSNVCR1(PSNVRCN)

           IF PSNVRAGN

               GOTO VAGN

 +7        QUIT 

VAGNM()   ;

 +1        QUIT $SELECT(+PSNVRSUB=50.6009:"  (EFFECTIVE DATE TIME SubFile)",1:"")

 +2       ;

 +3       ;

VDC       ;Set Fields for VA Drug Class (#50.605) File

 +1        IF PSNVRSL="A"

               Begin DoDot:1

 +2                FOR PSNVRSL1=50.605,50.615,50.60509

                       Begin DoDot:2

 +3                        FOR PSNVRSL2=0:0

                               SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))

                               if 'PSNVRSL2

                                   QUIT 

                               Begin DoDot:3

 +4                                SET PSNVRSQ2=0

                                   SET PSNVRSTR=50.605

                                   SET PSNVRSQ1=$SELECT(PSNVRSL1=50.60509:99.991,PSNVRSL1=50.615:4,1:PSNVRSL2)

                                   if PSNVRSL1'=50.605

                                       SET PSNVRSQ2=PSNVRSL2

 +5                                IF 'PSNVRSQ2

                                       SET PSNVRAR(PSNVRSTR,PSNVRSQ1)=PSNVRSL1

                                       QUIT 

 +6                                SET PSNVRAR(PSNVRSTR,PSNVRSQ1,PSNVRSQ2)=PSNVRSL1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

               QUIT 

 +7        KILL PSNVRDAT

           SET PSNVRCN=0

           FOR PSNVRSL1=50.605,50.615,50.60509

               Begin DoDot:1

 +8                FOR PSNVRSL2=0:0

                       SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))

                       if 'PSNVRSL2

                           QUIT 

                       Begin DoDot:2

 +9                        SET PSNVRCN=PSNVRCN+1

                           SET PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2

 +10                       SET PSNVRSUB=PSNVRDAT(PSNVRCN)

                           SET $PIECE(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($PIECE(PSNVRSUB,"^"),$PIECE(PSNVRSUB,"^",2),,"LABEL")_$$VDCNM

 +11                       SET PSNVRSQ2=""

                           SET PSNVRSTR=50.605

                           SET PSNVRSQ1=$SELECT(PSNVRSL1=50.60509:99.991,PSNVRSL1=50.615:4,1:PSNVRSL2)

                           if PSNVRSL1'=50.605

                               SET PSNVRSQ2=PSNVRSL2

 +12                       SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2

                       End DoDot:2

               End DoDot:1

VDCN      ;Redisplay for selection

 +1        WRITE @IOF

 +2        WRITE !?5,"Audited fields from the VA Drug Class (#50.605) File:",!

           SET PSNVRFL=0

 +3        DO AUDF

 +4        if PSNVROUT

               QUIT 

 +5        IF 'PSNVRFL

               DO MESS

               DO YN

               QUIT 

 +6        DO SELECT^PSNVCR1(PSNVRCN)

           IF PSNVRAGN

               GOTO VDCN

 +7        QUIT 

VDCNM()   ;

 +1        QUIT $SELECT(+PSNVRSUB=50.615:"  (DESCRIPTION SubFile)",+PSNVRSUB=50.60509:"  (EFFECTIVE DATE/TIME SubFile)",1:"")

 +2       ;

 +3       ;

DFO       ;Set Fields for Dosage Form (#50.606) File

 +1        IF PSNVRSL="A"

               Begin DoDot:1

 +2                FOR PSNVRSL1=50.606,50.6069,50.6061,50.6066,50.6068

                       Begin DoDot:2

 +3                        FOR PSNVRSL2=0:0

                               SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))

                               if 'PSNVRSL2

                                   QUIT 

                               Begin DoDot:3

 +4                                SET PSNVRSQ2=0