- PSNVCR2 ;BIR/RTR-VISTA COMPARISON REPORT CONTINUED ; 11 January 2017
- ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
- ;
- ;Reference to ^DIA supported by DBIA 2602
- ;
- ;
- START ;Print report
- N Y,DIR,DIROUT,DIRUT,DTOUT,DUOUT
- START1 ;Print report without queuing
- N PSNCH,PSNCRA2,PSNCRAT,PSNCROUT,PSNCRDEV,PSNCRLIN,PSNCRTOT,PSNCRPG,PSNCRBG,PSNCREN,PSNCRL2,PSNCRLC1,PSNCRLC2,PSNCRLC3,PSNCRLC4,PSNCRS7,PSNCRS8,PSNCRSUB,PSNFON,PSNCRLF,PSNCRS9,PSNCRSM9
- S Y=$E(PSNVRBEG,1,7) D DD^%DT S PSNCRBG=Y
- S Y=$E(PSNVREND,1,7) D DD^%DT S PSNCREN=Y
- S PSNFON=$S(PSNVRTYP="P":1,1:0)
- S PSNCRL2=PSNCRBG_" to "_PSNCREN I PSNVRPMI S PSNCRL2=PSNCRL2_" (Including PMI and Warning Labels)"
- S (PSNCROUT,PSNCRTOT,PSNCRLF)=0,PSNCRDEV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSNCRPG=1
- K PSNCRLIN S $P(PSNCRLIN,"-",78)="",PSNCRSUB=""
- I PSNFON D HD
- ;
- S PSNCH="" F S PSNCH=$O(PSNVRFIL(PSNCH)) Q:PSNCH=""!(PSNCROUT) D
- .I 'PSNFON,'PSNCRLF W !
- .D @$S(PSNCH=50.416:"DIN",PSNCH=50.6:"VAG",PSNCH=50.605:"VDC",PSNCH=50.606:"DFO",PSNCH=50.607:"DRU",PSNCH=50.608:"PAT",PSNCH=50.609:"PAS",PSNCH=50.64:"VAD",PSNCH=50.67:"NDC",PSNCH=50.68:"VAP",PSNCH=55.95:"DRM",1:"DRI")
- .I 'PSNFON S PSNCRLF=1
- I PSNCROUT G END
- I PSNVRPMI D PMIP^PSNVCR1
- ;
- END ;
- I 'PSNCROUT,'PSNCRTOT W !!,"No data to print.",!
- I PSNCRDEV="P" W !!,"End of Report.",!
- I 'PSNCROUT,PSNCRDEV="C" W !!,"End of Report.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- I PSNCRDEV="C" W !
- E W @IOF
- K PSNVRBEG,PSNVREND,PSNVRPMI,PSNVRTYP,PSNVRAR,PSNVRFIL,PSNVRSUM
- I 'PSNFON Q
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;
- ;
- HD ;Report Header
- I $G(PSNCRDEV)="C",$G(PSNCRPG)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSNCROUT=1 Q
- W @IOF
- W !,"UPDATE FILE CHANGE REPORT" W:PSNVRSUM="S" " (Summary)"
- W ?68,"PAGE: "_PSNCRPG,!,PSNCRL2_PSNCRSUB,!,PSNCRLIN S PSNCRPG=PSNCRPG+1
- Q
- ;
- ;
- MESS ;
- W !!,"Nothing queued to print.",!
- Q
- ;
- ;
- DIN ;print info for Drug Ingredient (#50.416) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.416,PSNCRLC3="DRUG INGREDIENTS"
- I PSNVRSUM="F" S PSNCRSUB=" (Drug Ingredient (#50.416) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.416,PSNCRA2)) Q:'PSNCRA2 I $G(^PS(50.416,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"DRUG INGREDIENT file (#50.416) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- VAG ;print info for VA Generic (#50.6) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.6,PSNCRLC3="VA GENERIC"
- I PSNVRSUM="F" S PSNCRSUB=" (VA Generic (#50.6) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PSNDF(50.6,PSNCRA2)) Q:'PSNCRA2 I $G(^PSNDF(50.6,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"VA GENERIC file (#50.6) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- VDC ;print info for VA Drug Class (#50.605) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.605,PSNCRLC3="VA DRUG CLASS"
- I PSNVRSUM="F" S PSNCRSUB=" (VA Drug Class (#50.605) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.605,PSNCRA2)) Q:'PSNCRA2 I $G(^PS(50.605,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"VA DRUG CLASS file (#50.605) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- DFO ;print info for Dosage Form (#50.606) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.606,PSNCRLC3="DOSAGE FORM"
- I PSNVRSUM="F" S PSNCRSUB=" (Dosage Form (#50.606) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.606,PSNCRA2)) Q:'PSNCRA2 I $G(^PS(50.606,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"DOSAGE FORM file (#50.606) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- DRU ;print info for Drug Units (#50.607) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.607,PSNCRLC3="DRUG UNITS"
- I PSNVRSUM="F" S PSNCRSUB=" (Drug Units (#50.607) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.607,PSNCRA2)) Q:'PSNCRA2 I $G(^PS(50.607,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"DRUG UNITS file (#50.607) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- PAT ;print info for Package Type (#50.608) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.608,PSNCRLC3="PACKAGE TYPE"
- I PSNVRSUM="F" S PSNCRSUB=" (Package Type (#50.608) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.608,PSNCRA2)) Q:'PSNCRA2 I $G(^PS(50.608,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"PACKAGE TYPE file (#50.608) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- PAS ;print info for Package Size (#50.609) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.609,PSNCRLC3="PACKAGE SIZE"
- I PSNVRSUM="F" S PSNCRSUB=" (Package Size (#50.609) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PS(50.609,PSNCRA2)) Q:'PSNCRA2 I $G(^PS(50.609,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"PACKAGE SIZE file (#50.609) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- VAD ;print info for VA Dispense Unit (#50.64) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.64,PSNCRLC3="VA DISPENSE UNIT"
- I PSNVRSUM="F" S PSNCRSUB=" (VA Dispense Unit (#50.64) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PSNDF(50.64,PSNCRA2)) Q:'PSNCRA2 I $G(^PSNDF(50.64,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"VA DISPENSE UNIT file (#50.64) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- NDC ;print info for NDC/UPN (#50.67) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.67,PSNCRLC3="NDC/UPN"
- I PSNVRSUM="F" S PSNCRSUB=" (NDC/UPN (#50.67) File cont.)"
- I PSNCRDEV="C",PSNFON W !
- F PSNCRA2=0:0 S PSNCRA2=$O(^PSNDF(50.67,PSNCRA2)) Q:'PSNCRA2 I $G(^PSNDF(50.67,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1 I PSNCRDEV="C",PSNFON,PSNCRAT#20000=0 W "."
- I PSNFON W !!,"NDC/UPN file (#50.67) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- VAP ;print info for VA Product (#50.68) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=50.68,PSNCRLC3="VA PRODUCT"
- I PSNVRSUM="F" S PSNCRSUB=" (VA Product (#50.68) File cont.)"
- I PSNCRDEV="C",PSNFON W !
- F PSNCRA2=0:0 S PSNCRA2=$O(^PSNDF(50.68,PSNCRA2)) Q:'PSNCRA2 I $G(^PSNDF(50.68,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1 I PSNCRDEV="C",PSNFON,PSNCRAT#5000=0 W "."
- I PSNFON W !!,"VA PRODUCT file (#50.68) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- DRM ;print info for Drug Manufacturer (#55.95) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=55.95,PSNCRLC3="DRUG MANUFACTURER"
- I PSNVRSUM="F" S PSNCRSUB=" (Drug Manufacturer (#55.95) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PS(55.95,PSNCRA2)) Q:'PSNCRA2 I $G(^PS(55.95,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"DRUG MANUFACTURER file (#55.95) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- DRI ;print info for Drug Interaction (#56) File
- S PSNCRTOT=1,PSNCRAT=0,PSNCRLC1=56,PSNCRLC3="DRUG INTERACTION"
- I PSNVRSUM="F" S PSNCRSUB=" (Drug Interaction (#56) File cont.)"
- F PSNCRA2=0:0 S PSNCRA2=$O(^PS(56,PSNCRA2)) Q:'PSNCRA2 I $G(^PS(56,PSNCRA2,0))'="" S PSNCRAT=PSNCRAT+1
- I PSNFON W !!,"DRUG INTERACTION file (#56) - "_PSNCRAT_" records"
- I PSNFON,($Y+5)>IOSL D HD Q:PSNCROUT
- D @$S(PSNVRSUM="F":"KLF",1:"KL")
- I $D(PSNVRAR(PSNCRLC1)) D
- .I PSNVRSUM="F" D PRT(PSNCRLC1) Q
- .D SUM(PSNCRLC1)
- I PSNVRSUM="F" D PFUL(PSNCRLC3,PSNCRAT),KLF Q
- D PSUM(PSNCRLC3,PSNCRAT)
- Q
- ;
- ;
- PRT(PSNCRS2) ;Print Audit File changes
- ;TMP("PSNFFILE",$J,.01 name, IEN, Field Name, Field Number, File or Subfile #, counter)=Old Value^New Value
- ;PSNCRLC2(File #, IEN, File or Subfile #, Field #)=Count
- N PSNCRSL1,PSNCRSL2,PSNCRSLF,PSNCRSLI,PSNCRSLN,PSNCRLAB,PSNCRNAM,PSNCROCT,PSNCRFN1,PSNCRFN2,PSNCRFN3,PSNCRFN4,PSNCRFN5,PSNCRPAS
- F PSNCRSL1=PSNVRBEG:0 S PSNCRSL1=$O(^DIA(PSNCRS2,"C",PSNCRSL1)) Q:'PSNCRSL1!(PSNVREND'>PSNCRSL1) D
- .F PSNCRSL2=0:0 S PSNCRSL2=$O(^DIA(PSNCRS2,"C",PSNCRSL1,PSNCRSL2)) Q:'PSNCRSL2 D
- ..S PSNCRSLN=$G(^DIA(PSNCRS2,PSNCRSL2,0)),PSNCRPAS=1
- ..S PSNCRSLI=+$P(PSNCRSLN,"^"),PSNCRSLF=$P(PSNCRSLN,"^",3) Q:'PSNCRSLI I 'PSNCRSLF S PSNCRPAS=0
- ..I PSNCRPAS D
- ...S PSNCRFN1=$P(PSNCRSLF,","),PSNCRFN2=$P(PSNCRSLF,",",2) D
- ....S PSNCRFN3=0 I 'PSNCRFN2,$D(PSNVRAR(PSNCRS2,PSNCRFN1)) S PSNCRFN3=PSNVRAR(PSNCRS2,PSNCRFN1) Q
- ....I 'PSNCRFN2 Q
- ....S PSNCRFN3=$G(PSNVRAR(PSNCRS2,PSNCRFN1,PSNCRFN2))
- ..I PSNCRPAS,'PSNCRFN3 Q
- ..I PSNCRPAS S PSNCRFN4=$S(PSNCRFN2:PSNCRFN3,1:PSNCRS2),PSNCRFN5=$S(PSNCRFN2:PSNCRFN2,1:PSNCRFN1)
- ..I PSNCRPAS,'PSNCRFN2 S PSNCRLAB=$$GET1^DID(PSNCRS2,PSNCRFN1,,"LABEL") I PSNCRLAB="" S PSNCRPAS=0
- ..I PSNCRPAS,PSNCRFN2 S PSNCRLAB=$$GET1^DID(PSNCRFN3,PSNCRFN2,,"LABEL") I PSNCRLAB="" S PSNCRPAS=0
- ..I 'PSNCRPAS S PSNCRFN4=9999999,PSNCRFN5=9999999,PSNCRLAB="UNKNOWN"
- ..S PSNCRNAM=$$GET1^DIQ(PSNCRS2,PSNCRSLI,.01) I PSNCRNAM="" S PSNCRNAM="ZZZZMISSING_("_PSNCRSLI_") File entry missing"
- ..S (PSNCRLC2(PSNCRS2,PSNCRSLI,PSNCRFN4,PSNCRFN5),PSNCROCT)=+$G(PSNCRLC2(PSNCRS2,PSNCRSLI,PSNCRFN4,PSNCRFN5))+1
- ..S ^TMP("PSNFFILE",$J,PSNCRNAM,PSNCRSLI,PSNCRLAB,PSNCRFN5,PSNCRFN4,PSNCROCT)=$P($G(^DIA(PSNCRS2,PSNCRSL2,2)),"^")_"^"_$P($G(^DIA(PSNCRS2,PSNCRSL2,3)),"^")
- ;
- Q
- ;
- ;
- SUM(PSNCRS6) ;Print Audit File summary changes
- ;PSNCRS7=Total records changed per file
- ;^TMP("PSNSFILE",$J,IEN)="" Used to indicate this record has already been added to the PSNCRS7 array
- ;PSNCRS8=Total number of Fields changed
- ;^TMP("PSNTFILE",$J,IEN)="" indicates already added to PSNCRS9 array, for missing PSN file entry
- ;PSNCRSM9=Total number of Fields changes for a missing entry
- N PSNCRSL1,PSNCRSL2,PSNCRSLF,PSNCRSLI,PSNCRSLN,PSNCRM1,PSNCRM2
- F PSNCRSL1=PSNVRBEG:0 S PSNCRSL1=$O(^DIA(PSNCRS6,"C",PSNCRSL1)) Q:'PSNCRSL1!(PSNVREND'>PSNCRSL1) D
- .F PSNCRSL2=0:0 S PSNCRSL2=$O(^DIA(PSNCRS6,"C",PSNCRSL1,PSNCRSL2)) Q:'PSNCRSL2 D
- ..S PSNCRSLN=$G(^DIA(PSNCRS6,PSNCRSL2,0))
- ..S PSNCRSLI=+$P(PSNCRSLN,"^"),PSNCRSLF=$P(PSNCRSLN,"^",3) Q:'PSNCRSLI!('PSNCRSLF)
- ..S PSNCRM1=$P(PSNCRSLF,","),PSNCRM2=$P(PSNCRSLF,",",2)
- ..I 'PSNCRM2,'$D(PSNVRAR(PSNCRS6,PSNCRSLF)) Q
- ..I PSNCRM2,'$D(PSNVRAR(PSNCRS6,PSNCRM1,PSNCRM2)) Q
- ..I $$GET1^DIQ(PSNCRS6,PSNCRSLI,.01)="" D Q
- ...S PSNCRS9=PSNCRS9+1
- ...I '$D(^TMP("PSNTFILE",$J,PSNCRSLI)) S ^TMP("PSNTFILE",$J,PSNCRSLI)="",PSNCRSM9=PSNCRSM9+1
- ..S PSNCRS8=PSNCRS8+1
- ..I '$D(^TMP("PSNSFILE",$J,PSNCRSLI)) S ^TMP("PSNSFILE",$J,PSNCRSLI)="",PSNCRS7=PSNCRS7+1
- Q
- ;
- ;
- PSUM(PSNCRFDN,PSNCRFTR) ;Print summary values
- I 'PSNFON D Q
- .W !,PSNCRFDN_"^"_PSNCRFTR_"^"_PSNCRS7_"^"_PSNCRS8
- .I PSNCRS9 W !,PSNCRFDN_" MISSING ENTRIES^"_PSNCRFTR_"^"_PSNCRSM9_"^"_PSNCRS9
- I 'PSNCRS7,'PSNCRS9 D D KL Q
- .W !?5,"No Change"
- .I ($Y+5)>IOSL D HD
- I PSNCRS7 D
- .W !?5,"Records Changed: "_PSNCRS7
- .I ($Y+5)>IOSL D HD I PSNCROUT D KL Q
- .W !?5,"Fields/Sub-fields Changed: "_PSNCRS8
- I PSNCRS9 D
- .W !,PSNCRFDN_" file MISSING ENTRIES:"
- .W !?5,"Records Changed: "_PSNCRSM9
- .I ($Y+5)>IOSL D HD I PSNCROUT D KL Q
- .W !?5,"Fields/Sub-fields Changed: "_PSNCRS9
- D KL
- I ($Y+5)>IOSL D HD
- Q
- ;
- ;
- PFUL(PSNPRHLA,PSNPRHLB) ;Print full values
- ;When printing, if 'File or Subfile#' changes within same field name, redisplay Field name because that means
- ;you have the same Field name for a top level and multiple field, and same for .01 name
- N PSNPR1,PSNPR2,PSNPR3,PSNPR4,PSNPR5,PSNPR6,PSNPR7,PSNPRHLD,PSNPRHLC,PSNPRHLN,PSNPRHLM,PSNPRHLO,PSNPRHL1,PSNPRHLH,PSNPRNDC,PSNPRNDM,PSNPRMS1,PSNPRMS2
- S PSNPRNDC=$S(PSNPRHLA="NDC/UPN":0,1:1) K PSNPRNDM
- I 'PSNFON W !,PSNPRHLA_"^Records - "_PSNPRHLB
- I '$D(^TMP("PSNFFILE",$J)) D Q
- .I PSNFON W !?5,"No Change" D:($Y+5)>IOSL HD Q
- .W !,PSNPRHLA_"^***No Changes***"
- S PSNPRHLD="",PSNPRHL1=0
- S PSNPR1="" F S PSNPR1=$O(^TMP("PSNFFILE",$J,PSNPR1)) Q:PSNPR1=""!(PSNCROUT) S PSNPRHLD="" D
- .I 'PSNPRNDC S PSNPRNDM=$S($P($G(^PSNDF(50.67,PSNPR1,0)),"^",2)'="":$P($G(^PSNDF(50.67,PSNPR1,0)),"^",2),1:"Missing NDC")
- .K PSNPRMS2 S PSNPRMS1=0 I $E(PSNPR1,1,11)="ZZZZMISSING" S PSNPRMS1=1,PSNPRMS2=$E(PSNPR1,12,$L(PSNPR1))
- .S PSNPRHLC=0 I PSNFON W !!,$S(PSNPRNDC:PSNPR1,PSNPRMS1:PSNPRMS2,1:PSNPRNDM) I ($Y+5)>IOSL D HD I PSNCROUT Q
- .I 'PSNFON S PSNPRHLH=PSNPRHLA_"^"_$S(PSNPRNDC:PSNPR1,PSNPRMS1:PSNPRMS2,1:PSNPRNDM)
- .F PSNPR2=0:0 S PSNPR2=$O(^TMP("PSNFFILE",$J,PSNPR1,PSNPR2)) D:PSNPRHLD'=""&(PSNPRHL1)&(PSNPR2)&(PSNPRHLD=PSNPR1)&(PSNPRHL1'=PSNPR2) CH1 S PSNPRHLD=PSNPR1,PSNPRHL1=PSNPR2 Q:'PSNPR2!(PSNCROUT) D
- ..S PSNPR3="" F S PSNPR3=$O(^TMP("PSNFFILE",$J,PSNPR1,PSNPR2,PSNPR3)) Q:PSNPR3=""!(PSNCROUT) S PSNPRHLN=0,PSNPRHLM="" D
- ...F PSNPR4=0:0 S PSNPR4=$O(^TMP("PSNFFILE",$J,PSNPR1,PSNPR2,PSNPR3,PSNPR4)) Q:'PSNPR4!(PSNCROUT) D
- ....F PSNPR5=0:0 S PSNPR5=$O(^TMP("PSNFFILE",$J,PSNPR1,PSNPR2,PSNPR3,PSNPR4,PSNPR5)) D CH2 Q:'PSNPR5!(PSNCROUT) D
- .....I PSNFON,($Y+5)>IOSL D HD I PSNCROUT Q
- .....F PSNPR6=0:0 S PSNPR6=$O(^TMP("PSNFFILE",$J,PSNPR1,PSNPR2,PSNPR3,PSNPR4,PSNPR5,PSNPR6)) Q:'PSNPR6!(PSNCROUT) D
- ......S PSNPR7=$G(^TMP("PSNFFILE",$J,PSNPR1,PSNPR2,PSNPR3,PSNPR4,PSNPR5,PSNPR6))
- ......I 'PSNFON S PSNPRHLH=PSNPRHLH_"^"_$P(PSNPR7,"^")_"^"_$P(PSNPR7,"^",2) Q
- ......W !?5,"Old Value: "_$P(PSNPR7,"^") I ($Y+5)>IOSL D HD I PSNCROUT Q
- ......W !?5,"New Value: "_$P(PSNPR7,"^",2) I ($Y+5)>IOSL D HD I PSNCROUT Q
- .....I 'PSNFON W !,PSNPRHLH S PSNPRHLH=$P(PSNPRHLH,"^")_"^"_$P(PSNPRHLH,"^",2)
- Q
- ;
- ;
- CH1 ;IEN change of the same name
- Q:PSNCROUT
- S PSNPRHLC=PSNPRHLC+1
- I PSNFON W !!,PSNPR1_" (Duplicate Name #"_PSNPRHLC_")" D:($Y+5)>IOSL HD Q
- S PSNPRHLH=PSNPRHLA_"^"_PSNPR1_" (Duplicate Name #"_PSNPRHLC_")"
- Q
- ;
- ;
- CH2 ;Subfile change of the same field name name
- Q:PSNCROUT!('PSNPR5)
- S:'PSNPRHLN PSNPRHLM=PSNPR4_"^"_PSNPR5
- I 'PSNPRHLN,'PSNFON S PSNPRHLH=PSNPRHLH_"^"_PSNPR3_"^"_PSNPR4 S PSNPRHLN=1 Q
- I 'PSNPRHLN W !!?5,PSNPR3_" ("_PSNPR4_")" S PSNPRHLN=PSNPRHLN+1 D:($Y+5)>IOSL HD Q
- S PSNPRHLO=PSNPR4_"^"_PSNPR5 I PSNPRHLO'=PSNPRHLM D S PSNPRHLM=PSNPRHLO,PSNPRHLN=1 Q
- .I PSNFON W !!?5,PSNPR3_" ("_PSNPR4_")"_" (Duplicate Field. SubFile #"_$P(PSNPRHLO,"^",2)_")" D:($Y+5)>IOSL HD Q
- .S PSNPRHLH=PSNPRHLH_"^"_PSNPR3_" (SubFile #"_$P(PSNPRHLO,"^",2)_")^"_PSNPR4
- Q
- ;
- ;
- KL ;Kill TMP global
- K ^TMP("PSNSFILE",$J),^TMP("PSNTFILE",$J) S (PSNCRS7,PSNCRS8,PSNCRS9,PSNCRSM9)=0
- Q
- ;
- ;
- KLF ;Kill TMP global
- K ^TMP("PSNFFILE",$J),PSNCRLC2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNVCR2 16298 printed Apr 23, 2025@18:39:27 Page 2
- PSNVCR2 ;BIR/RTR-VISTA COMPARISON REPORT CONTINUED ; 11 January 2017
- +1 ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
- +2 ;
- +3 ;Reference to ^DIA supported by DBIA 2602
- +4 ;
- +5 ;
- START ;Print report
- +1 NEW Y,DIR,DIROUT,DIRUT,DTOUT,DUOUT
- START1 ;Print report without queuing
- +1 NEW PSNCH,PSNCRA2,PSNCRAT,PSNCROUT,PSNCRDEV,PSNCRLIN,PSNCRTOT,PSNCRPG,PSNCRBG,PSNCREN,PSNCRL2,PSNCRLC1,PSNCRLC2,PSNCRLC3,PSNCRLC4,PSNCRS7,PSNCRS8,PSNCRSUB,PSNFON,PSNCRLF,PSNCRS9,PSNCRSM9
- +2 SET Y=$EXTRACT(PSNVRBEG,1,7)
- DO DD^%DT
- SET PSNCRBG=Y
- +3 SET Y=$EXTRACT(PSNVREND,1,7)
- DO DD^%DT
- SET PSNCREN=Y
- +4 SET PSNFON=$SELECT(PSNVRTYP="P":1,1:0)
- +5 SET PSNCRL2=PSNCRBG_" to "_PSNCREN
- IF PSNVRPMI
- SET PSNCRL2=PSNCRL2_" (Including PMI and Warning Labels)"
- +6 SET (PSNCROUT,PSNCRTOT,PSNCRLF)=0
- SET PSNCRDEV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
- SET PSNCRPG=1
- +7 KILL PSNCRLIN
- SET $PIECE(PSNCRLIN,"-",78)=""
- SET PSNCRSUB=""
- +8 IF PSNFON
- DO HD
- +9 ;
- +10 SET PSNCH=""
- FOR
- SET PSNCH=$ORDER(PSNVRFIL(PSNCH))
- if PSNCH=""!(PSNCROUT)
- QUIT
- Begin DoDot:1
- +11 IF 'PSNFON
- IF 'PSNCRLF
- WRITE !
- +12 DO @$SELECT(PSNCH=50.416:"DIN",PSNCH=50.6:"VAG",PSNCH=50.605:"VDC",PSNCH=50.606:"DFO",PSNCH=50.607:"DRU",PSNCH=50.608:"PAT",PSNCH=50.609:"PAS",PSNCH=50.64:"VAD",PSNCH=50.67:"NDC",PSNCH=50.68:"VAP",PSNCH=55.95:"DRM",1:"DRI")
- +13 IF 'PSNFON
- SET PSNCRLF=1
- End DoDot:1
- +14 IF PSNCROUT
- GOTO END
- +15 IF PSNVRPMI
- DO PMIP^PSNVCR1
- +16 ;
- END ;
- +1 IF 'PSNCROUT
- IF 'PSNCRTOT
- WRITE !!,"No data to print.",!
- +2 IF PSNCRDEV="P"
- WRITE !!,"End of Report.",!
- +3 IF 'PSNCROUT
- IF PSNCRDEV="C"
- WRITE !!,"End of Report.",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +4 IF PSNCRDEV="C"
- WRITE !
- +5 IF '$TEST
- WRITE @IOF
- +6 KILL PSNVRBEG,PSNVREND,PSNVRPMI,PSNVRTYP,PSNVRAR,PSNVRFIL,PSNVRSUM
- +7 IF 'PSNFON
- QUIT
- +8 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +9 QUIT
- +10 ;
- +11 ;
- HD ;Report Header
- +1 IF $GET(PSNCRDEV)="C"
- IF $GET(PSNCRPG)'=1
- WRITE !
- KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue, '^' to exit"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSNCROUT=1
- QUIT
- +2 WRITE @IOF
- +3 WRITE !,"UPDATE FILE CHANGE REPORT"
- if PSNVRSUM="S"
- WRITE " (Summary)"
- +4 WRITE ?68,"PAGE: "_PSNCRPG,!,PSNCRL2_PSNCRSUB,!,PSNCRLIN
- SET PSNCRPG=PSNCRPG+1
- +5 QUIT
- +6 ;
- +7 ;
- MESS ;
- +1 WRITE !!,"Nothing queued to print.",!
- +2 QUIT
- +3 ;
- +4 ;
- DIN ;print info for Drug Ingredient (#50.416) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.416
- SET PSNCRLC3="DRUG INGREDIENTS"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (Drug Ingredient (#50.416) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PS(50.416,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PS(50.416,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"DRUG INGREDIENT file (#50.416) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- VAG ;print info for VA Generic (#50.6) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.6
- SET PSNCRLC3="VA GENERIC"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (VA Generic (#50.6) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PSNDF(50.6,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PSNDF(50.6,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"VA GENERIC file (#50.6) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- VDC ;print info for VA Drug Class (#50.605) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.605
- SET PSNCRLC3="VA DRUG CLASS"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (VA Drug Class (#50.605) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PS(50.605,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PS(50.605,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"VA DRUG CLASS file (#50.605) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- DFO ;print info for Dosage Form (#50.606) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.606
- SET PSNCRLC3="DOSAGE FORM"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (Dosage Form (#50.606) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PS(50.606,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PS(50.606,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"DOSAGE FORM file (#50.606) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- DRU ;print info for Drug Units (#50.607) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.607
- SET PSNCRLC3="DRUG UNITS"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (Drug Units (#50.607) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PS(50.607,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PS(50.607,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"DRUG UNITS file (#50.607) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- PAT ;print info for Package Type (#50.608) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.608
- SET PSNCRLC3="PACKAGE TYPE"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (Package Type (#50.608) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PS(50.608,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PS(50.608,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"PACKAGE TYPE file (#50.608) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- PAS ;print info for Package Size (#50.609) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.609
- SET PSNCRLC3="PACKAGE SIZE"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (Package Size (#50.609) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PS(50.609,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PS(50.609,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"PACKAGE SIZE file (#50.609) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- VAD ;print info for VA Dispense Unit (#50.64) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.64
- SET PSNCRLC3="VA DISPENSE UNIT"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (VA Dispense Unit (#50.64) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PSNDF(50.64,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PSNDF(50.64,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"VA DISPENSE UNIT file (#50.64) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- NDC ;print info for NDC/UPN (#50.67) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.67
- SET PSNCRLC3="NDC/UPN"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (NDC/UPN (#50.67) File cont.)"
- +3 IF PSNCRDEV="C"
- IF PSNFON
- WRITE !
- +4 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PSNDF(50.67,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PSNDF(50.67,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- IF PSNCRDEV="C"
- IF PSNFON
- IF PSNCRAT#20000=0
- WRITE "."
- +5 IF PSNFON
- WRITE !!,"NDC/UPN file (#50.67) - "_PSNCRAT_" records"
- +6 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +7 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +8 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +9 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +10 DO SUM(PSNCRLC1)
- End DoDot:1
- +11 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +12 DO PSUM(PSNCRLC3,PSNCRAT)
- +13 QUIT
- +14 ;
- +15 ;
- VAP ;print info for VA Product (#50.68) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=50.68
- SET PSNCRLC3="VA PRODUCT"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (VA Product (#50.68) File cont.)"
- +3 IF PSNCRDEV="C"
- IF PSNFON
- WRITE !
- +4 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PSNDF(50.68,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PSNDF(50.68,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- IF PSNCRDEV="C"
- IF PSNFON
- IF PSNCRAT#5000=0
- WRITE "."
- +5 IF PSNFON
- WRITE !!,"VA PRODUCT file (#50.68) - "_PSNCRAT_" records"
- +6 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +7 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +8 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +9 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +10 DO SUM(PSNCRLC1)
- End DoDot:1
- +11 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +12 DO PSUM(PSNCRLC3,PSNCRAT)
- +13 QUIT
- +14 ;
- +15 ;
- DRM ;print info for Drug Manufacturer (#55.95) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=55.95
- SET PSNCRLC3="DRUG MANUFACTURER"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (Drug Manufacturer (#55.95) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PS(55.95,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PS(55.95,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"DRUG MANUFACTURER file (#55.95) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- DRI ;print info for Drug Interaction (#56) File
- +1 SET PSNCRTOT=1
- SET PSNCRAT=0
- SET PSNCRLC1=56
- SET PSNCRLC3="DRUG INTERACTION"
- +2 IF PSNVRSUM="F"
- SET PSNCRSUB=" (Drug Interaction (#56) File cont.)"
- +3 FOR PSNCRA2=0:0
- SET PSNCRA2=$ORDER(^PS(56,PSNCRA2))
- if 'PSNCRA2
- QUIT
- IF $GET(^PS(56,PSNCRA2,0))'=""
- SET PSNCRAT=PSNCRAT+1
- +4 IF PSNFON
- WRITE !!,"DRUG INTERACTION file (#56) - "_PSNCRAT_" records"
- +5 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- if PSNCROUT
- QUIT
- +6 DO @$SELECT(PSNVRSUM="F":"KLF",1:"KL")
- +7 IF $DATA(PSNVRAR(PSNCRLC1))
- Begin DoDot:1
- +8 IF PSNVRSUM="F"
- DO PRT(PSNCRLC1)
- QUIT
- +9 DO SUM(PSNCRLC1)
- End DoDot:1
- +10 IF PSNVRSUM="F"
- DO PFUL(PSNCRLC3,PSNCRAT)
- DO KLF
- QUIT
- +11 DO PSUM(PSNCRLC3,PSNCRAT)
- +12 QUIT
- +13 ;
- +14 ;
- PRT(PSNCRS2) ;Print Audit File changes
- +1 ;TMP("PSNFFILE",$J,.01 name, IEN, Field Name, Field Number, File or Subfile #, counter)=Old Value^New Value
- +2 ;PSNCRLC2(File #, IEN, File or Subfile #, Field #)=Count
- +3 NEW PSNCRSL1,PSNCRSL2,PSNCRSLF,PSNCRSLI,PSNCRSLN,PSNCRLAB,PSNCRNAM,PSNCROCT,PSNCRFN1,PSNCRFN2,PSNCRFN3,PSNCRFN4,PSNCRFN5,PSNCRPAS
- +4 FOR PSNCRSL1=PSNVRBEG:0
- SET PSNCRSL1=$ORDER(^DIA(PSNCRS2,"C",PSNCRSL1))
- if 'PSNCRSL1!(PSNVREND'>PSNCRSL1)
- QUIT
- Begin DoDot:1
- +5 FOR PSNCRSL2=0:0
- SET PSNCRSL2=$ORDER(^DIA(PSNCRS2,"C",PSNCRSL1,PSNCRSL2))
- if 'PSNCRSL2
- QUIT
- Begin DoDot:2
- +6 SET PSNCRSLN=$GET(^DIA(PSNCRS2,PSNCRSL2,0))
- SET PSNCRPAS=1
- +7 SET PSNCRSLI=+$PIECE(PSNCRSLN,"^")
- SET PSNCRSLF=$PIECE(PSNCRSLN,"^",3)
- if 'PSNCRSLI
- QUIT
- IF 'PSNCRSLF
- SET PSNCRPAS=0
- +8 IF PSNCRPAS
- Begin DoDot:3
- +9 SET PSNCRFN1=$PIECE(PSNCRSLF,",")
- SET PSNCRFN2=$PIECE(PSNCRSLF,",",2)
- Begin DoDot:4
- +10 SET PSNCRFN3=0
- IF 'PSNCRFN2
- IF $DATA(PSNVRAR(PSNCRS2,PSNCRFN1))
- SET PSNCRFN3=PSNVRAR(PSNCRS2,PSNCRFN1)
- QUIT
- +11 IF 'PSNCRFN2
- QUIT
- +12 SET PSNCRFN3=$GET(PSNVRAR(PSNCRS2,PSNCRFN1,PSNCRFN2))
- End DoDot:4
- End DoDot:3
- +13 IF PSNCRPAS
- IF 'PSNCRFN3
- QUIT
- +14 IF PSNCRPAS
- SET PSNCRFN4=$SELECT(PSNCRFN2:PSNCRFN3,1:PSNCRS2)
- SET PSNCRFN5=$SELECT(PSNCRFN2:PSNCRFN2,1:PSNCRFN1)
- +15 IF PSNCRPAS
- IF 'PSNCRFN2
- SET PSNCRLAB=$$GET1^DID(PSNCRS2,PSNCRFN1,,"LABEL")
- IF PSNCRLAB=""
- SET PSNCRPAS=0
- +16 IF PSNCRPAS
- IF PSNCRFN2
- SET PSNCRLAB=$$GET1^DID(PSNCRFN3,PSNCRFN2,,"LABEL")
- IF PSNCRLAB=""
- SET PSNCRPAS=0
- +17 IF 'PSNCRPAS
- SET PSNCRFN4=9999999
- SET PSNCRFN5=9999999
- SET PSNCRLAB="UNKNOWN"
- +18 SET PSNCRNAM=$$GET1^DIQ(PSNCRS2,PSNCRSLI,.01)
- IF PSNCRNAM=""
- SET PSNCRNAM="ZZZZMISSING_("_PSNCRSLI_") File entry missing"
- +19 SET (PSNCRLC2(PSNCRS2,PSNCRSLI,PSNCRFN4,PSNCRFN5),PSNCROCT)=+$GET(PSNCRLC2(PSNCRS2,PSNCRSLI,PSNCRFN4,PSNCRFN5))+1
- +20 SET ^TMP("PSNFFILE",$JOB,PSNCRNAM,PSNCRSLI,PSNCRLAB,PSNCRFN5,PSNCRFN4,PSNCROCT)=$PIECE($GET(^DIA(PSNCRS2,PSNCRSL2,2)),"^")_"^"_$PIECE($GET(^DIA(PSNCRS2,PSNCRSL2,3)),"^")
- End DoDot:2
- End DoDot:1
- +21 ;
- +22 QUIT
- +23 ;
- +24 ;
- SUM(PSNCRS6) ;Print Audit File summary changes
- +1 ;PSNCRS7=Total records changed per file
- +2 ;^TMP("PSNSFILE",$J,IEN)="" Used to indicate this record has already been added to the PSNCRS7 array
- +3 ;PSNCRS8=Total number of Fields changed
- +4 ;^TMP("PSNTFILE",$J,IEN)="" indicates already added to PSNCRS9 array, for missing PSN file entry
- +5 ;PSNCRSM9=Total number of Fields changes for a missing entry
- +6 NEW PSNCRSL1,PSNCRSL2,PSNCRSLF,PSNCRSLI,PSNCRSLN,PSNCRM1,PSNCRM2
- +7 FOR PSNCRSL1=PSNVRBEG:0
- SET PSNCRSL1=$ORDER(^DIA(PSNCRS6,"C",PSNCRSL1))
- if 'PSNCRSL1!(PSNVREND'>PSNCRSL1)
- QUIT
- Begin DoDot:1
- +8 FOR PSNCRSL2=0:0
- SET PSNCRSL2=$ORDER(^DIA(PSNCRS6,"C",PSNCRSL1,PSNCRSL2))
- if 'PSNCRSL2
- QUIT
- Begin DoDot:2
- +9 SET PSNCRSLN=$GET(^DIA(PSNCRS6,PSNCRSL2,0))
- +10 SET PSNCRSLI=+$PIECE(PSNCRSLN,"^")
- SET PSNCRSLF=$PIECE(PSNCRSLN,"^",3)
- if 'PSNCRSLI!('PSNCRSLF)
- QUIT
- +11 SET PSNCRM1=$PIECE(PSNCRSLF,",")
- SET PSNCRM2=$PIECE(PSNCRSLF,",",2)
- +12 IF 'PSNCRM2
- IF '$DATA(PSNVRAR(PSNCRS6,PSNCRSLF))
- QUIT
- +13 IF PSNCRM2
- IF '$DATA(PSNVRAR(PSNCRS6,PSNCRM1,PSNCRM2))
- QUIT
- +14 IF $$GET1^DIQ(PSNCRS6,PSNCRSLI,.01)=""
- Begin DoDot:3
- +15 SET PSNCRS9=PSNCRS9+1
- +16 IF '$DATA(^TMP("PSNTFILE",$JOB,PSNCRSLI))
- SET ^TMP("PSNTFILE",$JOB,PSNCRSLI)=""
- SET PSNCRSM9=PSNCRSM9+1
- End DoDot:3
- QUIT
- +17 SET PSNCRS8=PSNCRS8+1
- +18 IF '$DATA(^TMP("PSNSFILE",$JOB,PSNCRSLI))
- SET ^TMP("PSNSFILE",$JOB,PSNCRSLI)=""
- SET PSNCRS7=PSNCRS7+1
- End DoDot:2
- End DoDot:1
- +19 QUIT
- +20 ;
- +21 ;
- PSUM(PSNCRFDN,PSNCRFTR) ;Print summary values
- +1 IF 'PSNFON
- Begin DoDot:1
- +2 WRITE !,PSNCRFDN_"^"_PSNCRFTR_"^"_PSNCRS7_"^"_PSNCRS8
- +3 IF PSNCRS9
- WRITE !,PSNCRFDN_" MISSING ENTRIES^"_PSNCRFTR_"^"_PSNCRSM9_"^"_PSNCRS9
- End DoDot:1
- QUIT
- +4 IF 'PSNCRS7
- IF 'PSNCRS9
- Begin DoDot:1
- +5 WRITE !?5,"No Change"
- +6 IF ($Y+5)>IOSL
- DO HD
- End DoDot:1
- DO KL
- QUIT
- +7 IF PSNCRS7
- Begin DoDot:1
- +8 WRITE !?5,"Records Changed: "_PSNCRS7
- +9 IF ($Y+5)>IOSL
- DO HD
- IF PSNCROUT
- DO KL
- QUIT
- +10 WRITE !?5,"Fields/Sub-fields Changed: "_PSNCRS8
- End DoDot:1
- +11 IF PSNCRS9
- Begin DoDot:1
- +12 WRITE !,PSNCRFDN_" file MISSING ENTRIES:"
- +13 WRITE !?5,"Records Changed: "_PSNCRSM9
- +14 IF ($Y+5)>IOSL
- DO HD
- IF PSNCROUT
- DO KL
- QUIT
- +15 WRITE !?5,"Fields/Sub-fields Changed: "_PSNCRS9
- End DoDot:1
- +16 DO KL
- +17 IF ($Y+5)>IOSL
- DO HD
- +18 QUIT
- +19 ;
- +20 ;
- PFUL(PSNPRHLA,PSNPRHLB) ;Print full values
- +1 ;When printing, if 'File or Subfile#' changes within same field name, redisplay Field name because that means
- +2 ;you have the same Field name for a top level and multiple field, and same for .01 name
- +3 NEW PSNPR1,PSNPR2,PSNPR3,PSNPR4,PSNPR5,PSNPR6,PSNPR7,PSNPRHLD,PSNPRHLC,PSNPRHLN,PSNPRHLM,PSNPRHLO,PSNPRHL1,PSNPRHLH,PSNPRNDC,PSNPRNDM,PSNPRMS1,PSNPRMS2
- +4 SET PSNPRNDC=$SELECT(PSNPRHLA="NDC/UPN":0,1:1)
- KILL PSNPRNDM
- +5 IF 'PSNFON
- WRITE !,PSNPRHLA_"^Records - "_PSNPRHLB
- +6 IF '$DATA(^TMP("PSNFFILE",$JOB))
- Begin DoDot:1
- +7 IF PSNFON
- WRITE !?5,"No Change"
- if ($Y+5)>IOSL
- DO HD
- QUIT
- +8 WRITE !,PSNPRHLA_"^***No Changes***"
- End DoDot:1
- QUIT
- +9 SET PSNPRHLD=""
- SET PSNPRHL1=0
- +10 SET PSNPR1=""
- FOR
- SET PSNPR1=$ORDER(^TMP("PSNFFILE",$JOB,PSNPR1))
- if PSNPR1=""!(PSNCROUT)
- QUIT
- SET PSNPRHLD=""
- Begin DoDot:1
- +11 IF 'PSNPRNDC
- SET PSNPRNDM=$SELECT($PIECE($GET(^PSNDF(50.67,PSNPR1,0)),"^",2)'="":$PIECE($GET(^PSNDF(50.67,PSNPR1,0)),"^",2),1:"Missing NDC")
- +12 KILL PSNPRMS2
- SET PSNPRMS1=0
- IF $EXTRACT(PSNPR1,1,11)="ZZZZMISSING"
- SET PSNPRMS1=1
- SET PSNPRMS2=$EXTRACT(PSNPR1,12,$LENGTH(PSNPR1))
- +13 SET PSNPRHLC=0
- IF PSNFON
- WRITE !!,$SELECT(PSNPRNDC:PSNPR1,PSNPRMS1:PSNPRMS2,1:PSNPRNDM)
- IF ($Y+5)>IOSL
- DO HD
- IF PSNCROUT
- QUIT
- +14 IF 'PSNFON
- SET PSNPRHLH=PSNPRHLA_"^"_$SELECT(PSNPRNDC:PSNPR1,PSNPRMS1:PSNPRMS2,1:PSNPRNDM)
- +15 FOR PSNPR2=0:0
- SET PSNPR2=$ORDER(^TMP("PSNFFILE",$JOB,PSNPR1,PSNPR2))
- if PSNPRHLD'=""&(PSNPRHL1)&(PSNPR2)&(PSNPRHLD=PSNPR1)&(PSNPRHL1'=PSNPR2)
- DO CH1
- SET PSNPRHLD=PSNPR1
- SET PSNPRHL1=PSNPR2
- if 'PSNPR2!(PSNCROUT)
- QUIT
- Begin DoDot:2
- +16 SET PSNPR3=""
- FOR
- SET PSNPR3=$ORDER(^TMP("PSNFFILE",$JOB,PSNPR1,PSNPR2,PSNPR3))
- if PSNPR3=""!(PSNCROUT)
- QUIT
- SET PSNPRHLN=0
- SET PSNPRHLM=""
- Begin DoDot:3
- +17 FOR PSNPR4=0:0
- SET PSNPR4=$ORDER(^TMP("PSNFFILE",$JOB,PSNPR1,PSNPR2,PSNPR3,PSNPR4))
- if 'PSNPR4!(PSNCROUT)
- QUIT
- Begin DoDot:4
- +18 FOR PSNPR5=0:0
- SET PSNPR5=$ORDER(^TMP("PSNFFILE",$JOB,PSNPR1,PSNPR2,PSNPR3,PSNPR4,PSNPR5))
- DO CH2
- if 'PSNPR5!(PSNCROUT)
- QUIT
- Begin DoDot:5
- +19 IF PSNFON
- IF ($Y+5)>IOSL
- DO HD
- IF PSNCROUT
- QUIT
- +20 FOR PSNPR6=0:0
- SET PSNPR6=$ORDER(^TMP("PSNFFILE",$JOB,PSNPR1,PSNPR2,PSNPR3,PSNPR4,PSNPR5,PSNPR6))
- if 'PSNPR6!(PSNCROUT)
- QUIT
- Begin DoDot:6
- +21 SET PSNPR7=$GET(^TMP("PSNFFILE",$JOB,PSNPR1,PSNPR2,PSNPR3,PSNPR4,PSNPR5,PSNPR6))
- +22 IF 'PSNFON
- SET PSNPRHLH=PSNPRHLH_"^"_$PIECE(PSNPR7,"^")_"^"_$PIECE(PSNPR7,"^",2)
- QUIT
- +23 WRITE !?5,"Old Value: "_$PIECE(PSNPR7,"^")
- IF ($Y+5)>IOSL
- DO HD
- IF PSNCROUT
- QUIT
- +24 WRITE !?5,"New Value: "_$PIECE(PSNPR7,"^",2)
- IF ($Y+5)>IOSL
- DO HD
- IF PSNCROUT
- QUIT
- End DoDot:6
- +25 IF 'PSNFON
- WRITE !,PSNPRHLH
- SET PSNPRHLH=$PIECE(PSNPRHLH,"^")_"^"_$PIECE(PSNPRHLH,"^",2)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +26 QUIT
- +27 ;
- +28 ;
- CH1 ;IEN change of the same name
- +1 if PSNCROUT
- QUIT
- +2 SET PSNPRHLC=PSNPRHLC+1
- +3 IF PSNFON
- WRITE !!,PSNPR1_" (Duplicate Name #"_PSNPRHLC_")"
- if ($Y+5)>IOSL
- DO HD
- QUIT
- +4 SET PSNPRHLH=PSNPRHLA_"^"_PSNPR1_" (Duplicate Name #"_PSNPRHLC_")"
- +5 QUIT
- +6 ;
- +7 ;
- CH2 ;Subfile change of the same field name name
- +1 if PSNCROUT!('PSNPR5)
- QUIT
- +2 if 'PSNPRHLN
- SET PSNPRHLM=PSNPR4_"^"_PSNPR5
- +3 IF 'PSNPRHLN
- IF 'PSNFON
- SET PSNPRHLH=PSNPRHLH_"^"_PSNPR3_"^"_PSNPR4
- SET PSNPRHLN=1
- QUIT
- +4 IF 'PSNPRHLN
- WRITE !!?5,PSNPR3_" ("_PSNPR4_")"
- SET PSNPRHLN=PSNPRHLN+1
- if ($Y+5)>IOSL
- DO HD
- QUIT
- +5 SET PSNPRHLO=PSNPR4_"^"_PSNPR5
- IF PSNPRHLO'=PSNPRHLM
- Begin DoDot:1
- +6 IF PSNFON
- WRITE !!?5,PSNPR3_" ("_PSNPR4_")"_" (Duplicate Field. SubFile #"_$PIECE(PSNPRHLO,"^",2)_")"
- if ($Y+5)>IOSL
- DO HD
- QUIT
- +7 SET PSNPRHLH=PSNPRHLH_"^"_PSNPR3_" (SubFile #"_$PIECE(PSNPRHLO,"^",2)_")^"_PSNPR4
- End DoDot:1
- SET PSNPRHLM=PSNPRHLO
- SET PSNPRHLN=1
- QUIT
- +8 QUIT
- +9 ;
- +10 ;
- KL ;Kill TMP global
- +1 KILL ^TMP("PSNSFILE",$JOB),^TMP("PSNTFILE",$JOB)
- SET (PSNCRS7,PSNCRS8,PSNCRS9,PSNCRSM9)=0
- +2 QUIT
- +3 ;
- +4 ;
- KLF ;Kill TMP global
- +1 KILL ^TMP("PSNFFILE",$JOB),PSNCRLC2
- +2 QUIT
