PSNVCR1.m

PSNVCR1 ;BIR/RTR-VISTA COMPARISON REPORT CONTINUED ; 10 January 2017

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

 ;

 ;

FILE ;File Selection

 ;Sets selected file in PSNVRFIL array as PSNVRFIL(#)=File Name

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

 S DIR("?",1)="Enter 'A' to see changes made in all of the audited National Drug File files,"

 S DIR("?")="enter 'S' to select specific National Drug File files to see changes."

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

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

 S PSNVRANS=Y D SELFILE(PSNVRANS) I PSNVROUT Q

 I PSNVRANS="A" W !!,"Since all files were selected, all audited fields will be shown on the report." S PSNVRSEE="A"

 Q

 ;

 ;

SELFILE(PSNVRSET) ; Set File array

 N PSNVRLP,PSNVRLPC,PSNVRLAR,PSNVRLST,PSNVRLTH,PSNVRNUM

 S PSNVRLAR(1)="50.416^DRUG INGREDIENTS"

 S PSNVRLAR(2)="50.6^VA GENERIC"

 S PSNVRLAR(3)="50.605^VA DRUG CLASS"

 S PSNVRLAR(4)="50.606^DOSAGE FORM"

 S PSNVRLAR(5)="50.607^DRUG UNITS"

 S PSNVRLAR(6)="50.608^PACKAGE TYPE"

 S PSNVRLAR(7)="50.609^PACKAGE SIZE"

 S PSNVRLAR(8)="50.64^VA DISPENSE UNIT"

 S PSNVRLAR(9)="50.67^NDC/UPN"

 S PSNVRLAR(10)="50.68^VA PRODUCT"

 S PSNVRLAR(11)="55.95^DRUG MANUFACTURER"

 S PSNVRLAR(12)="56^DRUG INTERACTION"

 I PSNVRSET="A" D  Q

 .S PSNVRLP="" F  S PSNVRLP=$O(PSNVRLAR(PSNVRLP)) Q:'PSNVRLP  S PSNVRFIL($P(PSNVRLAR(PSNVRLP),"^"))=($P(PSNVRLAR(PSNVRLP),"^",2))

AGAIN ;Re-prompt file selection

 W !!?4,"1)  "_$P(PSNVRLAR(1),"^")_"   "_$P(PSNVRLAR(1),"^",2)

 W !?4,"2)  "_$P(PSNVRLAR(2),"^")_"     "_$P(PSNVRLAR(2),"^",2)

 W !?4,"3)  "_$P(PSNVRLAR(3),"^")_"   "_$P(PSNVRLAR(3),"^",2)

 W !?4,"4)  "_$P(PSNVRLAR(4),"^")_"   "_$P(PSNVRLAR(4),"^",2)

 W !?4,"5)  "_$P(PSNVRLAR(5),"^")_"   "_$P(PSNVRLAR(5),"^",2)

 W !?4,"6)  "_$P(PSNVRLAR(6),"^")_"   "_$P(PSNVRLAR(6),"^",2)

 W !?4,"7)  "_$P(PSNVRLAR(7),"^")_"   "_$P(PSNVRLAR(7),"^",2)

 W !?4,"8)  "_$P(PSNVRLAR(8),"^")_"    "_$P(PSNVRLAR(8),"^",2)

 W !?4,"9)  "_$P(PSNVRLAR(9),"^")_"    "_$P(PSNVRLAR(9),"^",2)

 W !?3,"10)  "_$P(PSNVRLAR(10),"^")_"    "_$P(PSNVRLAR(10),"^",2)

 W !?3,"11)  "_$P(PSNVRLAR(11),"^")_"    "_$P(PSNVRLAR(11),"^",2)

 W !?3,"12)  "_$P(PSNVRLAR(12),"^")_"       "_$P(PSNVRLAR(12),"^",2),!

 K DIR,Y S DIR(0)="LA^1:12"

 S DIR("A")="Select from the above list of files: "

 S DIR("?",1)="Select from entries 1 through 12. Multiple entries can be selected by using"

 S DIR("?")="commas and dashes, such as 1,2,5-7 to select entries 1, 2, 5, 6, and 7."

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

 S PSNVRLST=Y

 S PSNVRLPC=0 F PSNVRLP=1:1:$L(PSNVRLST) I $E(PSNVRLST,PSNVRLP)="," S PSNVRLPC=PSNVRLPC+1

 W !!,"You have selected the following files:",!

 F PSNVRLP=1:1:PSNVRLPC D

 .S PSNVRNUM=$P(PSNVRLST,",",PSNVRLP)

 .S PSNVRFIL($P(PSNVRLAR(PSNVRNUM),"^"))=$P(PSNVRLAR(PSNVRNUM),"^",2),PSNVRLTH=$L($P(PSNVRLAR(PSNVRNUM),"^"))

 .W !?3,$P(PSNVRLAR(PSNVRNUM),"^")_$S(PSNVRLTH=6:"  ",PSNVRLTH=5:"   ",PSNVRLTH=4:"    ",1:"      ")_$P(PSNVRLAR(PSNVRNUM),"^",2)

 W ! K DIR,Y S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR

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

 I Y'=1 K PSNVRFIL G AGAIN

 Q

 ;

 ;

DATE ;Date selection

 N %DT,X,X1,X2,%H,PSNVR90

 S X1=DT,X2=-90 D C^%DTC S PSNVR90=X

 W ! S %DT="AEPTX",%DT("A")="Enter Start Date: ",%DT(0)=PSNVR90 D ^%DT I $D(DTOUT)!(Y<0) S PSNVROUT=1 Q

 S PSNVRBEG=Y S X1=PSNVRBEG,X2=-1 D C^%DTC S PSNVRBEG=X_.9999

 K %DT,X S (PSNVRBEG,%DT(0))=Y

 S %DT="AEPTX",%DT("A")="Enter End Date: " D ^%DT I $D(DTOUT)!(Y<0) S PSNVROUT=1 Q

 S PSNVREND=Y I '$P(PSNVREND,".",2) S PSNVREND=PSNVREND_.9999

 Q

 ;

 ;

SUMM ;Prompt for full listing or summary

 W ! K DIR,Y S DIR(0)="SA^F:Full Listing;S:Summary totals"

 S DIR("?",1)="Enter 'F' to see old and new values of all of the audited fields,"

 S DIR("?")="enter 'S' to only see total numbers of records changed."

 S DIR("A")="Select (F)ull Listing or (S)ummary totals: "

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

 S PSNVRSUM=Y

 Q

 ;

 ;

PMI ;Prompt for PMI and Warning Lablels if summary was selected in prior prompt

 W ! K DIR,Y S DIR(0)="Y",DIR("A")="Include counts for PMI and Warning Labels",DIR("B")="Y"

 S DIR("?",1)="Enter 'Y' to include PMI and Warning Label counts,"

 S DIR("?")="enter 'N' to not include these counts."

 D ^DIR

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

 I Y=1 S PSNVRPMI=1

 Q

 ;

 ;

TYPE ;Prompt for report format or delimited list

 W ! K DIR,Y S DIR(0)="SA^P:Print List;D:Delimited File"

 S DIR("?",1)="Enter 'P' to see the output in a report format,"

 S DIR("?")="enter 'D' for a delimited list that can be exported to excel."

 S DIR("A")="Select (P)rint List or (D)elimited File: "

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

 S PSNVRTYP=Y

 Q

 ;

 ;

SELECT(PSNVRNM) ;Select fields from each file selected

 N PSNVRSHO,PSNVRHPC,PSNVRHPL,PSNVRHNM,PSNVRAB1,PSNVRAB2,PSNVRAB3,PSNVRABN

 S PSNVRAGN=0 W ! K DIR,Y S DIR(0)="LA^1:"_PSNVRNM

 S DIR("A")="Select from the above list of fields: "

 S DIR("?",1)="Select from entries 1 through "_PSNVRNM_". Multiple entries can be selected by using"

 S DIR("?")="commas and dashes."

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

 S PSNVRSHO=Y

 S PSNVRHPC=0 F PSNVRHPL=1:1:$L(PSNVRSHO) I $E(PSNVRSHO,PSNVRHPL)="," S PSNVRHPC=PSNVRHPC+1

 W !!,"You have selected the following fields:",!

 F PSNVRHPL=1:1:PSNVRHPC Q:PSNVROUT  D

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

 .S PSNVRHNM=$P(PSNVRSHO,",",PSNVRHPL)

 .W !?3,$P(PSNVRDAT(PSNVRHNM),"^",3)

 Q:PSNVROUT

 W ! K DIR,Y S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR

 I $D(DTOUT)!($D(DUOUT)) S PSNVROUT=1 K PSNVRAR Q

 I Y'=1 S PSNVRAGN=1 Q

 F PSNVRHPL=1:1:PSNVRHPC D

 .S PSNVRHNM=$P(PSNVRSHO,",",PSNVRHPL)

 .S PSNVRABN=$P(PSNVRDAT(PSNVRHNM),"^",4)

 .S PSNVRAB1=$P(PSNVRABN,";;"),PSNVRAB2=$P(PSNVRABN,";;",2),PSNVRAB3=$P(PSNVRABN,";;",3)

 .I 'PSNVRAB3 S PSNVRAR(PSNVRAB1,PSNVRAB2)=$P(PSNVRDAT(PSNVRHNM),"^") Q

 .S PSNVRAR(PSNVRAB1,PSNVRAB2,PSNVRAB3)=$P(PSNVRDAT(PSNVRHNM),"^")

 Q

 ;

 ;

DRM ;Set Fields for Drug Manufacturer (#55.95) File

 I PSNVRSL="A" D  Q

 .S PSNVRSL1=55.95 D

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

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

 K PSNVRDAT S PSNVRCN=0,PSNVRSL1=55.95

 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)=55.95_";;"_PSNVRSL2

DRMN ;Redisplay for selection

 W @IOF

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

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT(PSNVRCN) I PSNVRAGN G DRMN

 Q

 ;

 ;

DRI ;Set Fields for Drug Interaction (#56) File

 I PSNVRSL="A" D  Q

 .S PSNVRSL1=56 D

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

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

 K PSNVRDAT S PSNVRCN=0,PSNVRSL1=56

 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)=56_";;"_PSNVRSL2

DRIN ;Redisplay for selection

 W @IOF

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

 D AUDF

 Q:PSNVROUT

 I 'PSNVRFL D MESS,YN Q

 D SELECT(PSNVRCN) I PSNVRAGN G DRIN

 Q

 ;

 ;

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

 ;

 ;

DL ;Delimited File message

 ;

 W !!,"You have selected the delimited file output." D YN Q:PSNVROUT

 W @IOF

 W !,"The report output will be displayed on the screen in a delimited format, so"

 W !,"it can be captured and exported. If you are using Reflections, you can turn"

 W !,"logging on by selecting 'File' on the top left corner of the screen, then"

 W !,"select 'Logging' and capture to your desired location."

 W !!,"The format of the output is as follows, using '^' as the delimiter:"

 I PSNVRSUM="S" D  D YN Q

 .W !!,"File Name^Number of Records^Records Changed^Fields/Sub-fields Changed" Q:'PSNVRPMI

 .W !!,"**note** - the output for the PMI and Warning label Files"

 .W !,"           will only contain File Name and Number of Records.",!

 W !!,"File Name^Records - #####"

 W !,"File Name^Entry Name^Field Name^Field Number^Old Value^New Value"

 W !!,"**notes** - the Old Value and New Value will repeat as often as necessary."

 W !,"            duplicate Entry Names will have (duplicate #) appended."

 W !,"            duplicate Field Names will have the subfile number appended."

 W !,"            File Name^***No Changes** will print if there were no changes."

 D YN

 Q

 ;

 ;

PMIP ;Print PMI and Warning label totals

 ;

 I PSNFON,($Y+5)>IOSL D HD^PSNVCR2 Q:PSNCROUT

 I PSNFON W !

 I PSNFON,($Y+5)>IOSL D HD^PSNVCR2 Q:PSNCROUT

 I PSNFON W !,"PMI and Warning Label counts",!

 I PSNFON,($Y+5)>IOSL D HD^PSNVCR2 Q:PSNCROUT

 S PSNCRAT=0 F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.621,PSNCRA2)) Q:'PSNCRA2  I $G(^PS(50.621,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1 I PSNCRDEV="C",PSNFON,PSNCRAT#500=0 W "."

 I PSNFON W !?5,"PMI-ENGLISH FILE (#50.621) - "_PSNCRAT_" records"

 I 'PSNFON W !,"PMI-ENGLISH FILE^"_PSNCRAT_"^0^0"

 ;

 I PSNFON,($Y+5)>IOSL D HD^PSNVCR2 Q:PSNCROUT

 S PSNCRAT=0 F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.622,PSNCRA2)) Q:'PSNCRA2  I $G(^PS(50.622,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1 I PSNCRDEV="C",PSNFON,PSNCRAT#500=0 W "."

 I PSNFON W !!?5,"PMI-SPANISH FILE (#50.622) - "_PSNCRAT_" records"

 I 'PSNFON W !,"PMI-SPANISH FILE^"_PSNCRAT_"^0^0"

 ;

 I PSNFON,($Y+5)>IOSL D HD^PSNVCR2 Q:PSNCROUT

 S PSNCRAT=0 F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.623,PSNCRA2)) Q:'PSNCRA2  I $G(^PS(50.623,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1 I PSNCRDEV="C",PSNFON,PSNCRAT#500=0 W "."

 I PSNFON W !!?5,"PMI MAP-ENGLISH FILE (#50.623) - "_PSNCRAT_" records"

 I 'PSNFON W !,"PMI MAP-ENGLISH FILE^"_PSNCRAT_"^0^0"

 ;

 I PSNFON,($Y+5)>IOSL D HD^PSNVCR2 Q:PSNCROUT

 S PSNCRAT=0 F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.624,PSNCRA2)) Q:'PSNCRA2  I $G(^PS(50.624,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1 I PSNCRDEV="C",PSNFON,PSNCRAT#500=0 W "."

 I PSNFON W !!?5,"PMI MAP-SPANISH FILE (#50.624) - "_PSNCRAT_" records"

 I 'PSNFON W !,"PMI MAP-SPANISH FILE^"_PSNCRAT_"^0^0"

 I PSNFON,($Y+5)>IOSL D HD^PSNVCR2

 ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSNVCR1   10835     printed  Mar 13, 2025@21:29:52                                                                                                                                                                                                    Page 2

PSNVCR1   ;BIR/RTR-VISTA COMPARISON REPORT CONTINUED ; 10 January 2017

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

 +2       ;

 +3       ;

FILE      ;File Selection

 +1       ;Sets selected file in PSNVRFIL array as PSNVRFIL(#)=File Name

 +2        KILL DIR,Y

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

 +3        SET DIR("?",1)="Enter 'A' to see changes made in all of the audited National Drug File files,"

 +4        SET DIR("?")="enter 'S' to select specific National Drug File files to see changes."

 +5        SET DIR("A")="Select (A)ll or (S)pecific Files: "

 +6        DO ^DIR

           IF $DATA(DIRUT)

               SET PSNVROUT=1

               QUIT 

 +7        SET PSNVRANS=Y

           DO SELFILE(PSNVRANS)

           IF PSNVROUT

               QUIT 

 +8        IF PSNVRANS="A"

               WRITE !!,"Since all files were selected, all audited fields will be shown on the report."

               SET PSNVRSEE="A"

 +9        QUIT 

 +10      ;

 +11      ;

SELFILE(PSNVRSET) ; Set File array

 +1        NEW PSNVRLP,PSNVRLPC,PSNVRLAR,PSNVRLST,PSNVRLTH,PSNVRNUM

 +2        SET PSNVRLAR(1)="50.416^DRUG INGREDIENTS"

 +3        SET PSNVRLAR(2)="50.6^VA GENERIC"

 +4        SET PSNVRLAR(3)="50.605^VA DRUG CLASS"

 +5        SET PSNVRLAR(4)="50.606^DOSAGE FORM"

 +6        SET PSNVRLAR(5)="50.607^DRUG UNITS"

 +7        SET PSNVRLAR(6)="50.608^PACKAGE TYPE"

 +8        SET PSNVRLAR(7)="50.609^PACKAGE SIZE"

 +9        SET PSNVRLAR(8)="50.64^VA DISPENSE UNIT"

 +10       SET PSNVRLAR(9)="50.67^NDC/UPN"

 +11       SET PSNVRLAR(10)="50.68^VA PRODUCT"

 +12       SET PSNVRLAR(11)="55.95^DRUG MANUFACTURER"

 +13       SET PSNVRLAR(12)="56^DRUG INTERACTION"

 +14       IF PSNVRSET="A"

               Begin DoDot:1

 +15               SET PSNVRLP=""

                   FOR 

                       SET PSNVRLP=$ORDER(PSNVRLAR(PSNVRLP))

                       if 'PSNVRLP

                           QUIT 

                       SET PSNVRFIL($PIECE(PSNVRLAR(PSNVRLP),"^"))=($PIECE(PSNVRLAR(PSNVRLP),"^",2))

               End DoDot:1

               QUIT 

AGAIN     ;Re-prompt file selection

 +1        WRITE !!?4,"1)  "_$PIECE(PSNVRLAR(1),"^")_"   "_$PIECE(PSNVRLAR(1),"^",2)

 +2        WRITE !?4,"2)  "_$PIECE(PSNVRLAR(2),"^")_"     "_$PIECE(PSNVRLAR(2),"^",2)

 +3        WRITE !?4,"3)  "_$PIECE(PSNVRLAR(3),"^")_"   "_$PIECE(PSNVRLAR(3),"^",2)

 +4        WRITE !?4,"4)  "_$PIECE(PSNVRLAR(4),"^")_"   "_$PIECE(PSNVRLAR(4),"^",2)

 +5        WRITE !?4,"5)  "_$PIECE(PSNVRLAR(5),"^")_"   "_$PIECE(PSNVRLAR(5),"^",2)

 +6        WRITE !?4,"6)  "_$PIECE(PSNVRLAR(6),"^")_"   "_$PIECE(PSNVRLAR(6),"^",2)

 +7        WRITE !?4,"7)  "_$PIECE(PSNVRLAR(7),"^")_"   "_$PIECE(PSNVRLAR(7),"^",2)

 +8        WRITE !?4,"8)  "_$PIECE(PSNVRLAR(8),"^")_"    "_$PIECE(PSNVRLAR(8),"^",2)

 +9        WRITE !?4,"9)  "_$PIECE(PSNVRLAR(9),"^")_"    "_$PIECE(PSNVRLAR(9),"^",2)

 +10       WRITE !?3,"10)  "_$PIECE(PSNVRLAR(10),"^")_"    "_$PIECE(PSNVRLAR(10),"^",2)

 +11       WRITE !?3,"11)  "_$PIECE(PSNVRLAR(11),"^")_"    "_$PIECE(PSNVRLAR(11),"^",2)

 +12       WRITE !?3,"12)  "_$PIECE(PSNVRLAR(12),"^")_"       "_$PIECE(PSNVRLAR(12),"^",2),!

 +13       KILL DIR,Y

           SET DIR(0)="LA^1:12"

 +14       SET DIR("A")="Select from the above list of files: "

 +15       SET DIR("?",1)="Select from entries 1 through 12. Multiple entries can be selected by using"

 +16       SET DIR("?")="commas and dashes, such as 1,2,5-7 to select entries 1, 2, 5, 6, and 7."

 +17       DO ^DIR

           IF $DATA(DIRUT)

               SET PSNVROUT=1

               QUIT 

 +18       SET PSNVRLST=Y

 +19       SET PSNVRLPC=0

           FOR PSNVRLP=1:1:$LENGTH(PSNVRLST)

               IF $EXTRACT(PSNVRLST,PSNVRLP)=","

                   SET PSNVRLPC=PSNVRLPC+1

 +20       WRITE !!,"You have selected the following files:",!

 +21       FOR PSNVRLP=1:1:PSNVRLPC

               Begin DoDot:1

 +22               SET PSNVRNUM=$PIECE(PSNVRLST,",",PSNVRLP)

 +23               SET PSNVRFIL($PIECE(PSNVRLAR(PSNVRNUM),"^"))=$PIECE(PSNVRLAR(PSNVRNUM),"^",2)

                   SET PSNVRLTH=$LENGTH($PIECE(PSNVRLAR(PSNVRNUM),"^"))

 +24               WRITE !?3,$PIECE(PSNVRLAR(PSNVRNUM),"^")_$SELECT(PSNVRLTH=6:"  ",PSNVRLTH=5:"   ",PSNVRLTH=4:"    ",1:"      ")_$PIECE(PSNVRLAR(PSNVRNUM),"^",2)

               End DoDot:1

 +25       WRITE !

           KILL DIR,Y

           SET DIR(0)="Y"

           SET DIR("A")="Is this correct"

           SET DIR("B")="Y"

           DO ^DIR

 +26       IF $DATA(DTOUT)!($DATA(DUOUT))

               SET PSNVROUT=1

               QUIT 

 +27       IF Y'=1

               KILL PSNVRFIL

               GOTO AGAIN

 +28       QUIT 

 +29      ;

 +30      ;

DATE      ;Date selection

 +1        NEW %DT,X,X1,X2,%H,PSNVR90

 +2        SET X1=DT

           SET X2=-90

           DO C^%DTC

           SET PSNVR90=X

 +3        WRITE !

           SET %DT="AEPTX"

           SET %DT("A")="Enter Start Date: "

           SET %DT(0)=PSNVR90

           DO ^%DT

           IF $DATA(DTOUT)!(Y<0)

               SET PSNVROUT=1

               QUIT 

 +4        SET PSNVRBEG=Y

           SET X1=PSNVRBEG

           SET X2=-1

           DO C^%DTC

           SET PSNVRBEG=X_.9999

 +5        KILL %DT,X

           SET (PSNVRBEG,%DT(0))=Y

 +6        SET %DT="AEPTX"

           SET %DT("A")="Enter End Date: "

           DO ^%DT

           IF $DATA(DTOUT)!(Y<0)

               SET PSNVROUT=1

               QUIT 

 +7        SET PSNVREND=Y

           IF '$PIECE(PSNVREND,".",2)

               SET PSNVREND=PSNVREND_.9999

 +8        QUIT 

 +9       ;

 +10      ;

SUMM      ;Prompt for full listing or summary

 +1        WRITE !

           KILL DIR,Y

           SET DIR(0)="SA^F:Full Listing;S:Summary totals"

 +2        SET DIR("?",1)="Enter 'F' to see old and new values of all of the audited fields,"

 +3        SET DIR("?")="enter 'S' to only see total numbers of records changed."

 +4        SET DIR("A")="Select (F)ull Listing or (S)ummary totals: "

 +5        DO ^DIR

           IF $DATA(DIRUT)

               SET PSNVROUT=1

               QUIT 

 +6        SET PSNVRSUM=Y

 +7        QUIT 

 +8       ;

 +9       ;

PMI       ;Prompt for PMI and Warning Lablels if summary was selected in prior prompt

 +1        WRITE !

           KILL DIR,Y

           SET DIR(0)="Y"

           SET DIR("A")="Include counts for PMI and Warning Labels"

           SET DIR("B")="Y"

 +2        SET DIR("?",1)="Enter 'Y' to include PMI and Warning Label counts,"

 +3        SET DIR("?")="enter 'N' to not include these counts."

 +4        DO ^DIR

 +5        IF $DATA(DTOUT)!($DATA(DUOUT))

               SET PSNVROUT=1

               QUIT 

 +6        IF Y=1

               SET PSNVRPMI=1

 +7        QUIT 

 +8       ;

 +9       ;

TYPE      ;Prompt for report format or delimited list

 +1        WRITE !

           KILL DIR,Y

           SET DIR(0)="SA^P:Print List;D:Delimited File"

 +2        SET DIR("?",1)="Enter 'P' to see the output in a report format,"

 +3        SET DIR("?")="enter 'D' for a delimited list that can be exported to excel."

 +4        SET DIR("A")="Select (P)rint List or (D)elimited File: "

 +5        DO ^DIR

           IF $DATA(DIRUT)

               SET PSNVROUT=1

               QUIT 

 +6        SET PSNVRTYP=Y

 +7        QUIT 

 +8       ;

 +9       ;

SELECT(PSNVRNM) ;Select fields from each file selected

 +1        NEW PSNVRSHO,PSNVRHPC,PSNVRHPL,PSNVRHNM,PSNVRAB1,PSNVRAB2,PSNVRAB3,PSNVRABN

 +2        SET PSNVRAGN=0

           WRITE !

           KILL DIR,Y

           SET DIR(0)="LA^1:"_PSNVRNM

 +3        SET DIR("A")="Select from the above list of fields: "

 +4        SET DIR("?",1)="Select from entries 1 through "_PSNVRNM_". Multiple entries can be selected by using"

 +5        SET DIR("?")="commas and dashes."

 +6        DO ^DIR

           IF $DATA(DIRUT)

               SET PSNVROUT=1

               QUIT 

 +7        SET PSNVRSHO=Y

 +8        SET PSNVRHPC=0

           FOR PSNVRHPL=1:1:$LENGTH(PSNVRSHO)

               IF $EXTRACT(PSNVRSHO,PSNVRHPL)=","

                   SET PSNVRHPC=PSNVRHPC+1

 +9        WRITE !!,"You have selected the following fields:",!

 +10       FOR PSNVRHPL=1:1:PSNVRHPC

               if PSNVROUT

                   QUIT 

               Begin DoDot:1

 +11               IF ($Y+5)>IOSL

                       DO YN^PSNVCR

                       if PSNVROUT

                           QUIT 

                       WRITE @IOF

 +12               SET PSNVRHNM=$PIECE(PSNVRSHO,",",PSNVRHPL)

 +13               WRITE !?3,$PIECE(PSNVRDAT(PSNVRHNM),"^",3)

               End DoDot:1

 +14       if PSNVROUT

               QUIT 

 +15       WRITE !

           KILL DIR,Y

           SET DIR(0)="Y"

           SET DIR("A")="Is this correct"

           SET DIR("B")="Y"

           DO ^DIR

 +16       IF $DATA(DTOUT)!($DATA(DUOUT))

               SET PSNVROUT=1

               KILL PSNVRAR

               QUIT 

 +17       IF Y'=1

               SET PSNVRAGN=1

               QUIT 

 +18       FOR PSNVRHPL=1:1:PSNVRHPC

               Begin DoDot:1

 +19               SET PSNVRHNM=$PIECE(PSNVRSHO,",",PSNVRHPL)

 +20               SET PSNVRABN=$PIECE(PSNVRDAT(PSNVRHNM),"^",4)

 +21               SET PSNVRAB1=$PIECE(PSNVRABN,";;")

                   SET PSNVRAB2=$PIECE(PSNVRABN,";;",2)

                   SET PSNVRAB3=$PIECE(PSNVRABN,";;",3)

 +22               IF 'PSNVRAB3

                       SET PSNVRAR(PSNVRAB1,PSNVRAB2)=$PIECE(PSNVRDAT(PSNVRHNM),"^")

                       QUIT 

 +23               SET PSNVRAR(PSNVRAB1,PSNVRAB2,PSNVRAB3)=$PIECE(PSNVRDAT(PSNVRHNM),"^")

               End DoDot:1

 +24       QUIT 

 +25      ;

 +26      ;

DRM       ;Set Fields for Drug Manufacturer (#55.95) File

 +1        IF PSNVRSL="A"

               Begin DoDot:1

 +2                SET PSNVRSL1=55.95

                   Begin DoDot:2

 +3                    FOR PSNVRSL2=0:0

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

                           if 'PSNVRSL2

                               QUIT 

                           Begin DoDot:3

 +4                            SET PSNVRAR(55.95,PSNVRSL2)=PSNVRSL1

                           End DoDot:3

                   End DoDot:2

               End DoDot:1

               QUIT 

 +5        KILL PSNVRDAT

           SET PSNVRCN=0

           SET PSNVRSL1=55.95

 +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)=55.95_";;"_PSNVRSL2

               End DoDot:1

DRMN      ;Redisplay for selection

 +1        WRITE @IOF

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

           SET PSNVRFL=0

 +3        DO AUDF

 +4        if PSNVROUT

               QUIT 

 +5        IF 'PSNVRFL

               DO MESS

               DO YN

               QUIT 

 +6        DO SELECT(PSNVRCN)

           IF PSNVRAGN

               GOTO DRMN

 +7        QUIT 

 +8       ;

 +9       ;

DRI       ;Set Fields for Drug Interaction (#56) File

 +1        IF PSNVRSL="A"

               Begin DoDot:1

 +2                SET PSNVRSL1=56

                   Begin DoDot:2

 +3                    FOR PSNVRSL2=0:0

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

                           if 'PSNVRSL2

                               QUIT 

                           Begin DoDot:3

 +4                            SET PSNVRAR(56,PSNVRSL2)=PSNVRSL1

                           End DoDot:3

                   End DoDot:2

               End DoDot:1

               QUIT 

 +5        KILL PSNVRDAT

           SET PSNVRCN=0

           SET PSNVRSL1=56

 +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)=56_";;"_PSNVRSL2

               End DoDot:1

DRIN      ;Redisplay for selection

 +1        WRITE @IOF

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

           SET PSNVRFL=0

 +3        DO AUDF

 +4        if PSNVROUT

               QUIT 

 +5        IF 'PSNVRFL

               DO MESS

               DO YN

               QUIT 

 +6        DO SELECT(PSNVRCN)

           IF PSNVRAGN

               GOTO DRIN

 +7        QUIT 

 +8       ;

 +9       ;

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 

 +4       ;

 +5       ;

DL        ;Delimited File message

 +1       ;

 +2        WRITE !!,"You have selected the delimited file output."

           DO YN

           if PSNVROUT

               QUIT 

 +3        WRITE @IOF

 +4        WRITE !,"The report output will be displayed on the screen in a delimited format, so"

 +5        WRITE !,"it can be captured and exported. If you are using Reflections, you can turn"

 +6        WRITE !,"logging on by selecting 'File' on the top left corner of the screen, then"

 +7        WRITE !,"select 'Logging' and capture to your desired location."

 +8        WRITE !!,"The format of the output is as follows, using '^' as the delimiter:"

 +9        IF PSNVRSUM="S"

               Begin DoDot:1

 +10               WRITE !!,"File Name^Number of Records^Records Changed^Fields/Sub-fields Changed"

                   if 'PSNVRPMI

                       QUIT 

 +11               WRITE !!,"**note** - the output for the PMI and Warning label Files"

 +12               WRITE !,"           will only contain File Name and Number of Records.",!

               End DoDot:1

               DO YN

               QUIT 

 +13       WRITE !!,"File Name^Records - #####"

 +14       WRITE !,"File Name^Entry Name^Field Name^Field Number^Old Value^New Value"

 +15       WRITE !!,"**notes** - the Old Value and New Value will repeat as often as necessary."

 +16       WRITE !,"            duplicate Entry Names will have (duplicate #) appended."

 +17       WRITE !,"            duplicate Field Names will have the subfile number appended."

 +18       WRITE !,"            File Name^***No Changes** will print if there were no changes."

 +19       DO YN

 +20       QUIT 

 +21      ;

 +22      ;

PMIP      ;Print PMI and Warning label totals

 +1       ;

 +2        IF PSNFON

               IF ($Y+5)>IOSL

                   DO HD^PSNVCR2

                   if PSNCROUT

                       QUIT 

 +3        IF PSNFON

               WRITE !

 +4        IF PSNFON

               IF ($Y+5)>IOSL

                   DO HD^PSNVCR2

                   if PSNCROUT

                       QUIT 

 +5        IF PSNFON

               WRITE !,"PMI and Warning Label counts",!

 +6        IF PSNFON

               IF ($Y+5)>IOSL

                   DO HD^PSNVCR2

                   if PSNCROUT

                       QUIT 

 +7        SET PSNCRAT=0

           FOR PSNCRA2=0:0

               SET PSNCRA2=$ORDER(^PS(50.621,PSNCRA2))

               if 'PSNCRA2

                   QUIT 

               IF $GET(^PS(50.621,PSNCRA2,0))'=""

                   SET PSNCRAT=PSNCRAT+1

                   IF PSNCRDEV="C"

                       IF PSNFON

                           IF PSNCRAT#500=0

                               WRITE "."

 +8        IF PSNFON

               WRITE !?5,"PMI-ENGLISH FILE (#50.621) - "_PSNCRAT_" records"

 +9        IF 'PSNFON

               WRITE !,"PMI-ENGLISH FILE^"_PSNCRAT_"^0^0"

 +10      ;

 +11       IF PSNFON

               IF ($Y+5)>IOSL

                   DO HD^PSNVCR2

                   if PSNCROUT