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 ---[H[J[2J[HPSNVCR 14430 printed Dec 13, 2024@02:25:07 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
SET PSNVRSTR=50.606
SET PSNVRSQ1=$SELECT(PSNVRSL1=50.6069:9,PSNVRSL1=50.6061:1,PSNVRSL1=50.6066:6,PSNVRSL1=50.6068:8,1:PSNVRSL2)
if PSNVRSL1'=50.606
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.606,50.6069,50.6061,50.6066,50.6068
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")_$$DFONM
+11 SET PSNVRSQ2=""
SET PSNVRSTR=50.606
SET PSNVRSQ1=$SELECT(PSNVRSL1=50.6069:9,PSNVRSL1=50.6061:1,PSNVRSL1=50.6066:6,PSNVRSL1=50.6068:8,1:PSNVRSL2)
if PSNVRSL1'=50.606
SET PSNVRSQ2=PSNVRSL2
+12 SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2
End DoDot:2
End DoDot:1
DFON ;Redisplay for selection
+1 WRITE @IOF
+2 WRITE !?5,"Audited fields from the Dosage Form (#50.606) 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 DFON
+7 QUIT
DFONM() ;
+1 QUIT $SELECT(+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:"")
+2 ;
+3 ;
DRU ;Set Fields for Drug Units (#50.607) File
+1 IF PSNVRSL="A"
Begin DoDot:1
+2 SET PSNVRSL1=50.607
Begin DoDot:2
+3 FOR PSNVRSL2=0:0
SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))
if 'PSNVRSL2
QUIT
Begin DoDot:3
+4 SET PSNVRAR(50.607,PSNVRSL2)=PSNVRSL1
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+5 KILL PSNVRDAT
SET PSNVRCN=0
SET PSNVRSL1=50.607
+6 FOR PSNVRSL2=0:0
SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))
if 'PSNVRSL2
QUIT
Begin DoDot:1
+7 SET PSNVRCN=PSNVRCN+1
SET PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2
+8 SET PSNVRSUB=PSNVRDAT(PSNVRCN)
SET $PIECE(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($PIECE(PSNVRSUB,"^"),$PIECE(PSNVRSUB,"^",2),,"LABEL")
+9 SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=50.607_";;"_PSNVRSL2
End DoDot:1
DRUN ;Redisplay for selection
+1 WRITE @IOF
+2 WRITE !?5,"Audited fields from the Drug Units (#50.607) 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 DRUN
+7 QUIT
+8 ;
+9 ;
PAT ;Set Fields for Package Type (#50.608) File
+1 IF PSNVRSL="A"
Begin DoDot:1
+2 SET PSNVRSL1=50.608
Begin DoDot:2
+3 FOR PSNVRSL2=0:0
SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))
if 'PSNVRSL2
QUIT
Begin DoDot:3
+4 SET PSNVRAR(50.608,PSNVRSL2)=PSNVRSL1
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+5 KILL PSNVRDAT
SET PSNVRCN=0
SET PSNVRSL1=50.608
+6 FOR PSNVRSL2=0:0
SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))
if 'PSNVRSL2
QUIT
Begin DoDot:1
+7 SET PSNVRCN=PSNVRCN+1
SET PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2
+8 SET PSNVRSUB=PSNVRDAT(PSNVRCN)
SET $PIECE(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($PIECE(PSNVRSUB,"^"),$PIECE(PSNVRSUB,"^",2),,"LABEL")
+9 SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=50.608_";;"_PSNVRSL2
End DoDot:1
PATN ;Redisplay for selection
+1 WRITE @IOF
+2 WRITE !?5,"Audited fields from the Package Type (#50.608) 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 PATN
+7 QUIT
+8 ;
+9 ;
PAS ;Set Fields for Package Size (#50.609) File
+1 IF PSNVRSL="A"
Begin DoDot:1
+2 SET PSNVRSL1=50.609
Begin DoDot:2
+3 FOR PSNVRSL2=0:0
SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))
if 'PSNVRSL2
QUIT
Begin DoDot:3
+4 SET PSNVRAR(50.609,PSNVRSL2)=PSNVRSL1
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+5 KILL PSNVRDAT
SET PSNVRCN=0
SET PSNVRSL1=50.609
+6 FOR PSNVRSL2=0:0
SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))
if 'PSNVRSL2
QUIT
Begin DoDot:1
+7 SET PSNVRCN=PSNVRCN+1
SET PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2
+8 SET PSNVRSUB=PSNVRDAT(PSNVRCN)
SET $PIECE(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($PIECE(PSNVRSUB,"^"),$PIECE(PSNVRSUB,"^",2),,"LABEL")
+9 SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=50.609_";;"_PSNVRSL2
End DoDot:1
PASN ;Redisplay for selection
+1 WRITE @IOF
+2 WRITE !?5,"Audited fields from the Package Size (#50.609) 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 PASN
+7 QUIT
+8 ;
+9 ;
VAD ;Set Fields for VA Dispense Unit (#50.64) File
+1 IF PSNVRSL="A"
Begin DoDot:1
+2 SET PSNVRSL1=50.64
Begin DoDot:2
+3 FOR PSNVRSL2=0:0
SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))
if 'PSNVRSL2
QUIT
Begin DoDot:3
+4 SET PSNVRAR(50.64,PSNVRSL2)=PSNVRSL1
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+5 KILL PSNVRDAT
SET PSNVRCN=0
SET PSNVRSL1=50.64
+6 FOR PSNVRSL2=0:0
SET PSNVRSL2=$ORDER(^DD(PSNVRSL1,"AUDIT",PSNVRSL2))
if 'PSNVRSL2
QUIT
Begin DoDot:1
+7 SET PSNVRCN=PSNVRCN+1
SET PSNVRDAT(PSNVRCN)=PSNVRSL1_"^"_PSNVRSL2
+8 SET PSNVRSUB=PSNVRDAT(PSNVRCN)
SET $PIECE(PSNVRDAT(PSNVRCN),"^",3)=$$GET1^DID($PIECE(PSNVRSUB,"^"),$PIECE(PSNVRSUB,"^",2),,"LABEL")
+9 SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=50.64_";;"_PSNVRSL2
End DoDot:1
VADN ;Redisplay for selection
+1 WRITE @IOF
+2 WRITE !?5,"Audited fields from the VA Dispense Unit (#50.64) 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 VADN
+7 QUIT
+8 ;
+9 ;
NDC ;Set Fields for NDC/UPN (#50.67) File
+1 IF PSNVRSL="A"
Begin DoDot:1
+2 FOR PSNVRSL1=50.67,50.676,50.6711,50.6712
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.67
SET PSNVRSQ1=$SELECT(PSNVRSL1=50.676:6,PSNVRSL1=50.6711:11,PSNVRSL1=50.6712:12,1:PSNVRSL2)
if PSNVRSL1'=50.67
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.67,50.676,50.6711,50.6712
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")_$$NDCNM
+11 SET PSNVRSQ2=""
SET PSNVRSTR=50.67
SET PSNVRSQ1=$SELECT(PSNVRSL1=50.676:6,PSNVRSL1=50.6711:11,PSNVRSL1=50.6712:12,1:PSNVRSL2)
if PSNVRSL1'=50.67
SET PSNVRSQ2=PSNVRSL2
+12 SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2
End DoDot:2
End DoDot:1
NDCN ;Redisplay for selection
+1 WRITE @IOF
+2 WRITE !?5,"Audited fields from the NDC/UPN (#50.67) 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 NDCN
+7 QUIT
NDCNM() ;
+1 QUIT $SELECT(+PSNVRSUB=50.676:" (ROUTE OF ADMINISTRATION SubFile)",+PSNVRSUB=50.6711:" (PREVIOUS NDC Subfile)",+PSNVRSUB=50.6712:" (PREVIOUS UPN Subfile)",1:"")
+2 ;
+3 ;
VAP ;Set Fields for VA Product (#50.68) File
+1 IF PSNVRSL="A"
Begin DoDot:1
+2 FOR PSNVRSL1=50.68,50.6814,50.6816,50.6818,50.6845,50.6899
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.68
SET PSNVRSQ1=$SELECT(PSNVRSL1=50.6814:14,PSNVRSL1=50.6816:16,PSNVRSL1=50.6818:18,PSNVRSL1=50.6845:45,PSNVRSL1=50.6899:99.991,1:PSNVRSL2)
if PSNVRSL1'=50.68
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.68,50.6814,50.6816,50.6818,50.6845,50.6899
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")_$$VAPNM
+11 SET PSNVRSQ2=""
SET PSNVRSTR=50.68
SET PSNVRSQ1=$SELECT(PSNVRSL1=50.6814:14,PSNVRSL1=50.6816:16,PSNVRSL1=50.6818:18,PSNVRSL1=50.6845:45,PSNVRSL1=50.6899:99.991,1:PSNVRSL2)
if PSNVRSL1'=50.68
SET PSNVRSQ2=PSNVRSL2
+12 SET $PIECE(PSNVRDAT(PSNVRCN),"^",4)=PSNVRSTR_";;"_PSNVRSQ1_";;"_PSNVRSQ2
End DoDot:2
End DoDot:1
VAPN ;Redisplay for selection
+1 WRITE @IOF
+2 WRITE !?5,"Audited fields from the VA PRODUCT (#50.68) 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 VAPN
+7 QUIT
VAPNM() ;
+1 IF +PSNVRSUB=50.6814
QUIT " (ACTIVE INGREDIENTS SubFile)"
+2 QUIT $SELECT(+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:"")
+3 ;
+4 ;
AUDF ;Show audited fields
+1 FOR PSNVRSL1=1:1
if '$DATA(PSNVRDAT(PSNVRSL1))!(PSNVROUT)
QUIT
Begin DoDot:1
+2 IF ($Y+5)>IOSL
DO YN
if PSNVROUT
QUIT
WRITE @IOF
+3 SET PSNVRSUB=PSNVRDAT(PSNVRSL1)
+4 WRITE !?2,PSNVRSL1_") "_$PIECE(PSNVRDAT(PSNVRSL1),"^",3)
SET PSNVRFL=1
End DoDot:1
+5 QUIT
+6 ;
+7 ;
MESS ;Write Message
+1 WRITE !,"***No Audited fields for this file.***"
+2 QUIT
+3 ;
+4 ;
YN ;yes or no prompt if no audited fields found for a file
+1 WRITE !
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
+2 IF $DATA(DTOUT)!($DATA(DUOUT))!('Y)
SET PSNVROUT=1
+3 QUIT
